;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mcl-color-draw-2.lisp


#|

A simple graphics window package based loosely on Mark Watson's code in
COMMON LISP MODULES, Springer-Verlag, 1991.

Lee Spector, 1997


To use:
 
 - evaluate or load this file
 - call init-draw-window to create a drawing window
 - call draw-color-rectangle to paint colored rectangles

A function, show-drawing, is also provided to bring the drawing window to the
front. Note, however, that drawn rectangles are not buffered or saved anywhere,
so they will be erased if anything else is layered over the drawing window. See
the MCL manual for ways to avoid this.


version info:
version 2: removed some low-level traps calls & added ovals

|#

(require :quickdraw) ;; quickdraw must be loaded

(defvar *draw-window* nil "The window in which draw-color-rectangle will draw.")

(defun init-draw-window (&optional (title "Drawing") 
                                   (xsize 250) (ysize 250))
  "Create a new plot window and put it in the special 
variable *draw-window*"
  (setq *draw-window* (make-instance 'window
                        :window-title title
                        :view-size (make-point xsize ysize)
                        :window-type :document-with-zoom
                        :color-p t))
  (event-dispatch))

(defun draw-color-rectangle (x y xsize ysize red green blue)
  "Paints a color rectangle in the drawing window. Red, green, and blue
should each be integers in the range 0-65535."
  (with-focused-view *draw-window*
    (with-fore-color (make-color red green blue)
      (paint-rect *draw-window* x y (+ x xsize) (+ y ysize)))))

(defun draw-color-oval (x y xsize ysize red green blue)
  "Paints a color oval in the drawing window. Red, green, and blue
should each be integers in the range 0-65535."
  (with-focused-view *draw-window*
    (with-fore-color (make-color red green blue)
      (paint-oval *draw-window* x y (+ x xsize) (+ y ysize)))))

(defun clear-drawing  ()
  "Clears the drawing window by painting it white."
  (let ((size (view-size *draw-window*)))
    (draw-color-rectangle 0 ;; starts at upper corner
                          0 
                          (point-h size) ;; covers whole window
                          (point-v size)
                          0 ;; R, G, B all zero
                          0
                          0)))

(defun show-drawing ()
  "Brings the drawing window to the front."
  (window-select *draw-window*)
  (event-dispatch))



#|
;; Examples


;; a long window with some colored squares
(init-draw-window "color squares" 200 400)
(draw-color-rectangle 0 0 20 20 65535 0 0)
(draw-color-rectangle 40 30 50 50 0 65535 0)
(draw-color-rectangle 20 90 150 150 0 0 65535)
(draw-color-rectangle 10 250 180 100 0 65535 65535)

;; some ovals
(init-draw-window "color ovals" 200 400)
(draw-color-oval 0 0 20 20 65535 0 0)
(draw-color-oval 40 30 50 50 0 65535 0)
(draw-color-oval 20 90 150 150 0 0 65535)
(draw-color-oval 10 250 180 100 0 65535 65535)


;; an window with a bunch of colors
(init-draw-window "varies R&G, B=32767" 255 255)
(let ((size 8))
  (do ((r 0 (incf r size)))
      ((>= r 255))
    (do ((g 0 (incf g size)))
        ((>= g 255))
      (draw-color-rectangle r g size size (* r 256) (* g 256) 32767))))

;; the same thing with blue=0
(init-draw-window "varies R&G, B=0" 255 255)
(let ((size 8))
  (do ((r 0 (incf r size)))
      ((>= r 255))
    (do ((g 0 (incf g size)))
        ((>= g 255))
      (draw-color-rectangle r g size size (* r 256) (* g 256) 0))))




|#