;; kaleidoscope.scm -- an entertaining graphical display

;; John David Stone
;; April 30 -- May 5, 1997

;; KALEIDOSCOPE 

;; This program is intended to run under the Elk implementation of Scheme
;; and requires Elk's X Windows library.

(require 'xlib)

;; The program requires access to an X Windows display -- a device through
;; which X Windows programs can interact with their users.  KALEIDOSCOPE
;; presupposes that it will be invoked from within an X Windows
;; environment, in which cans we can get the display that is the value of
;; the environment variable DISPLAY by invoking OPEN-DISPLAY with no
;; argument.  Let's call this default display K-DISPLAY.

(define k-display (open-display))

;; OPEN-DISPLAY returns #F if it doesn't succeed in acquiring an X Windows
;; display.  We should halt the program in those unfortunate circumstances.

(if (not (display? k-display))
    (error 'kaleidoscope
           "It was not possible to open the default X Windows display."))

;; The K-DISPLAY maintains a table of the pixel colors that are available
;; for immediate use in drawing.  Since we'll refer to this table
;; frequently, it will be useful to have a name for it: K-COLOR-MAP.

(define k-color-map (display-colormap k-display))

;; We can now create the window within which the kaleidoscope program
;; will draw, although we won't put it up on screen quite yet.
;; (CREATE-WINDOW allocates and initializes the storage for the record in
;; which information about the window is stored, but the window will not
;; become visible until the MAP-WINDOW procedure is invoked below.)

;; We'll call the window within which KALEIDOSCOPE runs the K-WINDOW.
;; It is a square window, 512 by 512 pixels, initially painted entirely
;; black.

(define diameter-in-pixels 512)

(define black (alloc-color k-color-map (make-color 0.0 0.0 0.0)))

(define k-window
  (create-window 'parent (display-root-window k-display)
                 'width diameter-in-pixels
                 'height diameter-in-pixels
                 'background-pixel black))

;; K-DISPLAY also supplies a default ``graphics context,'' a record
;; containing information about the drawing style to be used, the current
;; background and foreground colors, the width of lines and arcs, and a
;; variety of other attributes.  Since we'll want to modify the graphics
;; context for KALEIDOSCOPE without side effects on other X Windows
;; programs using the same display, we'll take a fresh copy of the
;; default graphics context and call it K-GRAPHICS-CONTEXT.

(define k-graphics-context
  (copy-gcontext (display-default-gcontext k-display)
                 (display-root-window k-display)))

;; Before putting the window on display, it is customary to tell the window
;; manager program what its properties are, how to identify it, what title
;; to put in the frame, and so on.

;; To simplify the coding of the drawing procedures, we'll ask the window
;; manager not to allow resizing operations by telling it that the minimum
;; and maximum permissible width and height are all 512 pixels.

(set-wm-normal-hints! 'window k-window
                      'min-width diameter-in-pixels
                      'min-height diameter-in-pixels
                      'max-width diameter-in-pixels
                      'max-height diameter-in-pixels)

;; Also, we'll ask the window manager to set up the window in open rather
;; than iconic form, and to allow it to receive keyboard input.

(set-wm-hints! 'window k-window
               'initial-state 'normal
               'input? #t)

;; The window can be called KALEIDOSCOPE and is the only member of a
;; similarly named class.

(set-wm-class! k-window "kaleidoscope" "kaleidoscope")

;; The window pays attention to keystrokes, but discards all other input or
;; interaction events. 

(set-window-event-mask! k-window '(key-press))

;; The window is displayed with the title KALEIDOSCOPE in the frame when it
;; is open ... 

(set-wm-name! k-window '("kaleidoscope"))

;; ... and the icon should be labelled KALEIDOSCOPE when the window is
;; closed.

(set-wm-icon-name! k-window '("kaleidoscope"))

;; The window can now be drawn onto the display.

(map-window k-window)

;; KALEIDOSCOPE creates its charming patterns by drawing into the K-WINDOW.
;; It pauses after each call to the DRAW procedure to allow the user to 
;; issue a command by pressing a key.  The HANDLER procedure is invoked
;; to determine the nature of the command, which can be either STOP,
;; CLEAR (to erase the current pattern before starting to draw a new one)
;; or CONTINUE (to draw on top of the current pattern).

(define kaleidoscope
  (lambda ()

    ;; Repeatedly follow the current command, starting with a CONTINUE
    ;; command and recovering each successive one from HANDLE-EVENTS.

    (do ((command 'continue
                  (handle-events k-display #f #f (key-press handler))))

        ;; When the command is STOP, exit from the loop and free the
        ;; allocated resources.

        ((eq? command 'stop) (clean-up-afterwards))

      ;; Here's the body of the DO-expression.  Check to see whether the
      ;; command is CLEAR; if so, use CLEAR-AREA to black out the window.

      (if (eq? command 'clear)
          (clear-area k-window 0 0 diameter-in-pixels diameter-in-pixels
                      #t))

      ;; Invoke DRAW to make a new pattern or to draw on top of the old
      ;; one.

      (draw))))

;; The HANDLER procedure allows the user to turn off the kaleidoscope
;; (by pressing the Q key) or to clear the current pattern out of the
;; window before starting to draw a new oen (by pressing the C key), or
;; to continue to add lines to the current pattern (by pressing any other
;; key).

(define handler
  (lambda (event window root-window sub-window time x y x-root y-root state
                 keycode same-screen?)
    (cond ((= keycode 30) 'stop)   ; 30 happens to be the keycode for Q
          ((= keycode 42) 'clear)  ;   and 42 the keycode for C.
          (else 'continue))))

;; The following procedures are handy utilities for the DRAW procedure to
;; use in selecting the forms to draw onto the display:

;; The Elk RANDOM procedure takes zero arguments and returns an exact
;; integer in the range from 0 to 32767 (= 2^15 - 1).  The RAND procedure
;; imitates Chez Scheme's RANDOM with an exact integer argument:  It takes
;; a positive integer as its argument and returns a value randomly selected
;; from the natural numbers less than that positive integer.

(define rand
  (lambda (n)

    ;; Make sure that N is a positive integer.

    (if (not (and (integer? n)
                  (positive? n)))
        (error 'rand "The argument must be a positive integer"))

    ;; Scale the result of a call to Elk's RANDOM into the interval from
    ;; 0.0 to 1.0, then multiply by N, truncate to get an integer, and
    ;; coerce it to be exact.

    (inexact->exact (truncate (* n (/ (random) 32768))))))

;; The RANDOM-ELEMENT procedure returns an element randomly selected from
;; a given list.

(define random-element
  (lambda (ls)
    (list-ref ls (rand (length ls)))))

;; It's best to use a limited palette of colors, since the K-COLOR-MAP can
;; provide only so many for the entire display.  Here's the palette that
;; I recommend.  Each of the colors is constructed from its red, green, and
;; blue components by MAKE-COLOR, then allocated from the color map by 
;; ALLOC-COLOR and added to the palette.

(define palette
  (map (lambda (color)
         (alloc-color k-color-map color))
       (list (make-color 1.0 1.0 1.0)      ; white
             (make-color 1.0 1.0 0.0)      ; yellow
             (make-color 1.0 0.0 1.0)      ; magenta
             (make-color 0.0 1.0 1.0)      ; cyan
             (make-color 1.0 0.0 0.0)      ; red
             (make-color 0.0 1.0 0.0)      ; green
             (make-color 0.0 0.0 1.0)      ; blue
             (make-color 0.2 0.5 0.8)      ; greenish-blue
             (make-color 0.2 0.8 0.5)      ; aqua
             (make-color 0.5 0.2 0.8)      ; purple
             (make-color 0.5 0.8 0.2)      ; lime
             (make-color 0.8 0.2 0.5)      ; brick
             (make-color 0.8 0.5 0.2))))   ; brown

;; RANDOM-COLOR chooses and returns a random element from this palette.

(define random-color
  (lambda ()
    (random-element palette)))

;; Initially, the DRAW procedure is not very impressive.  It draws one
;; line, of a width somewhere between two and six pixels, in a randomly
;; chosen color, from one randomly chosen point in the K-WINDOW to another.

(define draw
  (lambda ()

    ;; Set the width of the lines that are drawn to a randomly selected
    ;; value in the range from two pixels to six pixels.

    (set-gcontext-line-width! k-graphics-context (+ (rand 5) 2))

    ;; Randomly select from the palette a color in which to draw the
    ;; figures.

    (set-gcontext-foreground! k-graphics-context (random-color))

    ;; Draw a line from a randomly selected starting point to a randomly
    ;; selected terminus.  The x- and y-coordinates of each of the two
    ;; points are selected at random in the range from 0 (top or left)
    ;; through 511 (bottom or right).

    (draw-line k-window k-graphics-context
               (rand diameter-in-pixels)     ; x-coordinate of starting point
               (rand diameter-in-pixels)     ; y-coordinate of starting point
               (rand diameter-in-pixels)     ; x-coordinate of terminus
               (rand diameter-in-pixels))))  ; y-coordinate of terminus

;; In the cleanup phase, free all the allocated resources, in the reverse
;; of the order in which they were allocated. 

(define clean-up-afterwards
  (lambda ()
    (destroy-window k-window)
    (free-colormap k-color-map)
    (free-gcontext k-graphics-context)
    (close-display k-display)))

;; Now to start the thing running.  That's it!

(kaleidoscope)