;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; flight-sequence.lisp

;; Lee Spector, October 1998

(defparameter *canvas-x* 600 "The x dimension of the drawing")
(defparameter *canvas-y* 600 "The y dimension of the drawing")

(defun stroke-rectangle (x1 y1 x2 y2 r1 r2 g1 g2 b1 b2 max-strokes)
  "Draws a random number of lines (at most max-strokes many) in the rectangle
defined by the points <x1,y1> and <x2,y2>, with red color components in the
range [r1-r2], green in [g1-g2], and blue in [b1-b2]."
  (let ((strokes (random max-strokes))) ;; determine how many strokes to draw
    (dotimes (i strokes) ;; draw the strokes
      (draw-color-line
       (+ (min x1 x2) (random (abs (- x1 x2)))) ;x1
       (+ (min y1 y2) (random (abs (- y1 y2)))) ;y1
       (+ (min x1 x2) (random (abs (- x1 x2)))) ;x2
       (+ (min y1 y2) (random (abs (- y1 y2)))) ;y2
       (+ (min r1 r2) (random (abs (- r1 r2)))) ;r
       (+ (min g1 g2) (random (abs (- g1 g2)))) ;g
       (+ (min b1 b2) (random (abs (- b1 b2)))) ;b
       ))))

(defun black-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 0
                          0
                          0)))

(defun perturb (initial-value max-jump)
  "Returns a number that differs randomly from initial-value by a maximum
difference of max-jump."
  (+ initial-value
     (* (random (+ 1 max-jump))
        (if (zerop (random 2)) 1 -1))))

(defun random-middle-x-value ()
  "Returns a random x value somewhere near the middle of the drawing."
  (+ (truncate *canvas-x* 4)
     (truncate (random *canvas-x*) 2)))

(defun random-middle-y-value ()
  "Returns a random y value somewhere near the middle of the drawing."
  (+ (truncate *canvas-y* 4)
     (truncate (random *canvas-y*) 2)))

(defun init-scene ()
  "Initializes the drawing window, closing any previous drawing window first."
  (when (and *draw-window* (wptr *draw-window*))
    (close-draw-window))
  (init-draw-window "Flight" *canvas-x* *canvas-y*))

(defun draw-scene (start-x1 start-y1 start-x2 start-y2)
  "Draws a scene with two object clusters, each starting at the given 
coordinate."
  (black-drawing)
  (draw-background)
  (draw-objects start-x1 start-y1)
  (draw-objects start-x2 start-y2))

(defun flight-sequence ()
  "Produces an infinite sequence of scene drawings. Press command-period to
halt."
  (let ((center-x1 (random-middle-x-value))
        (center-y1 (random-middle-y-value))
        (center-x2 (random-middle-x-value))
        (center-y2 (random-middle-y-value))
        (max-jump 20))
    (init-scene)
    (loop
      ;; draw the scene
      (draw-scene center-x1 center-y1 center-x2 center-y2)
      ;; move the start points of the objects slightly
      (setq center-x1 (perturb center-x1 max-jump))
      (setq center-y1 (perturb center-y1 max-jump))
      (setq center-x2 (perturb center-x2 max-jump))
      (setq center-y2 (perturb center-y2 max-jump))
      ;; wait a while before drawing the next scene
      (sleep 5)
      )))

(defun draw-objects (start-x start-y)
  "Draws an object cluster starting at and wantering from the
given coordinate."
  (let ((max-jump 20)
        (num-objects (random 25)))
    (dotimes (i num-objects)
      (draw-object start-x start-y)
      (setq start-x (perturb start-x max-jump))
      (setq start-y (perturb start-y max-jump)))))

(defun draw-object (center-x center-y)
  "Draws a single object, which is a bunch of lines and a bunch of ovals."
  (let ((deviation (random 50)))
    (stroke-rectangle
     (- center-x deviation)
     (- center-y deviation)
     (+ center-x deviation)
     (+ center-y deviation)
     0
     65535
     0
     0
     0
     65535
     20)
    ))

(defun draw-background ()
  "Draws the background -- a ground and a sky"
  (let ((horizon (random *canvas-y*)))
    (draw-ground horizon)
    (draw-sky horizon)))

(defun draw-ground (horizon)
  "Draws the ground below the horizon."
  (stroke-rectangle
   (- *canvas-x*)
   horizon
   (* 2 *canvas-x*)
   (* 2 *canvas-y*)
   0
   65536
   0
   65536
   0
   0
   1000))

(defun draw-sky (horizon)
  "Draws the sky above the horizon."
  (stroke-rectangle
   (- *canvas-x*)
   (- *canvas-y*)
   (* 2 *canvas-x*)
   horizon
   0
   0
   20000
   65536
   65535
   65536
   1000))

;; run it
(flight-sequence)