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