;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; mcl-color-draw-3.lisp #| A simple graphics window utility for Macintosh Common Lisp. Lee Spector, 1997-1998 To use: - evaluate or load this file - call init-draw-window to create a drawing window - call draw-color-rectangle to paint colored rectangles - call draw-color-oval to paint colored ovals - call draw-color-line to paint colored lines A function, show-drawing, is also provided to bring the drawing window to the front. Note, however, that drawn shapes 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 version 3: added lines, changed clear-drawing to make it white instead of black, added close-draw-window |# (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 draw-color-line (x1 y1 x2 y2 red green blue) "Paints a color line from to 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) (move-to *draw-window* x1 y1) (line-to *draw-window* x2 y2)))) (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) 65535 ;; R, G, B all max 65535 65535))) (defun show-drawing () "Brings the drawing window to the front." (window-select *draw-window*) (event-dispatch)) (defun close-draw-window () (window-close *draw-window*)) #| ;; 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)))) ;; lines example (init-draw-window "Some Lines" 255 255) (draw-color-line 0 255 255 0 65535 0 0) ; a red line (dotimes (i 20) ; a bunch of green lines (draw-color-line 20 150 (* 10 i) (* 10 i) 0 65535 0)) (draw-color-line 5 5 100 200 0 0 65535) ; a blue line (draw-color-line 25 35 150 250 65535 0 65535) ; a purple line ;; random lines (init-draw-window "Random Lines" 400 400) (dotimes (i 1000) (draw-color-line (random 401) (random 401) (random 401) (random 401) (random 65536) (random 65536) (random 65536))) |#