#|

A simple graphics window package approximating Lee Spector's code located
at http://hamp.hampshire.edu/lspector for Allegro Common Lisp Lite

Adam W. Schwartz, 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

A function, show-drawing, is also provided to bring the drawing window to the
front.

version info:

version 1.0 functions to duplicate Lee Spectors mcl_color_draw2.lisp
version 2.0 added (draw-color-line) function

|#

(in-package :common-lisp-user)

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

(defun init-draw-window (&optional (title "Drawing") (xsize 250) (ysize 250))
   (setq *draw-window* (open-stream
                         'bitmap-window
                         *lisp-main-window*
                         :io
                         :title title
                         :font (make-font :swiss :system 16 '(:bold)) 
                         :window-state :shrunk 
                         :window-border :frame 
                         :left-attachment nil 
                         :top-attachment nil 
                         :right-attachment nil 
                         :bottom-attachment nil 
                         :user-movable t 
                         :user-resizable nil 
                         :user-closable t 
                         :user-shrinkable nil 
                         :user-scrollable nil
                         :overlapped nil 
                         :background-color white
                         :pop-up-p nil
                         :window-interior (make-box 50 50 xsize ysize)))
   (show-window *draw-window* nil)
   
(defun rgb (rd grn blu)
   (make-rgb 
     :red (truncate (/ rd 256))
     :green (truncate (/ grn 256))
     :blue (truncate (/ blu 256))))

(defun draw-color-rectangle (x y xsize ysize rd grn blu)
   "Paints a color rectangle in the drawing window. Red, green, and blue
   should each be integers in the range 0-65535."
   (set-foreground-color *draw-window* (rgb rd grn blu))
   (set-fill-texture *draw-window* :foreground)
   (fill-box (frame-child *draw-window*) (make-box x y (+ x xsize) (+ y ysize))))

(defun draw-color-oval (x y xsize ysize rd grn blu)
  "Paints a color oval in the drawing window. Red, green, and blue
   should each be integers in the range 0-65535."
   (let ((xpos nil) (ypos nil))
      (setf xpos (truncate (+ x (+ x xsize)) 2))
      (setf ypos (truncate (+ y (+ y ysize)) 2))
      (set-foreground-color *draw-window* (rgb rd grn blu))
      (set-fill-texture *draw-window* :foreground)
      (fill-ellipse (frame-child *draw-window*)
        (make-position xpos ypos)
        (truncate xsize 2)
        (truncate ysize 2)
        0)))

(defun draw-color-line (x1 y1 x2 y2 rd grn blu)
   "Paints a color line from <x1,y1> to <x2,y2> in the drawing window.
   Red, green, and blue should each be integers in the range 0-65535."
   (set-foreground-color *draw-window* (rgb rd grn blu))
   (draw-line *draw-window*
     (make-position x1 y1)
     (make-position x2 y2)))
            
(defun clear-drawing  ()
  "Clears the drawing window"
  (clear-page *draw-window*))

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

(defun close-draw-window  ()
  (close *draw-window*))

#|
;; Examples (courtesy of Lee Spector)


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

|#