;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mcl-color-draw.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 windo
 - 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.

|#

(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)
      (fast-paint-rect x y (+ x xsize) (+ y ysize)))))

(defun fast-paint-rect (left &optional top right bot)
  "A version of PAINT-RECT that does not focus the view --  should only
be called within a WITH-FOCUSED-VIEW."
  (ccl::with-rectangle-arg (r left top right bot) (#_PaintRect r)))

(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)


;; 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))))

|#