;; plot-project.scm -- plotting a real function

;; John David Stone
;; Department of Mathematics and Computer Science
;; Grinnell College
;; stone@math.grin.edu

;; created November 19, 1997
;; last revised November 20, 1997

;; The purpose of this program is to take a function from real numbers to
;; real numbers, proposed by the user in the form of a Scheme procedure,
;; and to display a plot of that function over a specified range of
;; arguments.

;; 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.  It presupposes
;; that it will be invoked from within an X Windows environment, in which
;; case 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 PLOT-DISPLAY.

(define plot-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? plot-display))
    (error 'plotter
           "It was not possible to open the default X Windows display."))

;; The PLOT-DISPLAY data structure 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:
;; PLOT-COLOR-MAP.

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

;; We can now create the window within which the plotting 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 the plotting program runs the
;; PLOT-WINDOW.  It is a square window, 512 by 512 pixels, initially
;; painted entirely white.  The axes and labels will be drawn on in black
;; and the graph of the function in red.

(define diameter-in-pixels 512)

(define white (alloc-color plot-color-map (make-color 1.0 1.0 1.0)))
(define black (alloc-color plot-color-map (make-color 0.0 0.0 0.0)))
(define red (alloc-color plot-color-map (make-color 1.0 0.0 0.0)))

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

;; The plot will be framed by an empty margin 32 pixels wide:

(define plot-margin 32)
(define plot-diameter (- diameter-in-pixels plot-margin plot-margin))

;; PLOT-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 plotting 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 PLOT-GRAPHICS-CONTEXT.

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

;; Input is handled by this procedure, which returns an instruction to the
;; plotting procedure: The symbol DRAW directs it to plot the function (or
;; redraw it, if necessary), and the symbol QUIT tells it to close the
;; graphics window.  The user requests QUIT by pressing the Q key; any
;; other keystroke sends the DRAW instruction.

(define handler
  (lambda (event window root-window sub-window time x y x-root y-root state
                 keycode same-screen?)
    (if (= keycode 30)    ; 30 happens to be the keycode for Q.
        'quit
        'draw)))

;; 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 plot-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 permit keyboard input into that window.

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

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

(set-wm-class! plot-window "plotter" "plotter")

;; We shall allow PLOTTER to respond to certain keystrokes, but direct it
;; to ignore all other input and interaction events -- it is intended for
;; display only.

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

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

(set-wm-name! plot-window '("plotter"))

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

(set-wm-icon-name! plot-window '("plotter"))

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

(map-window plot-window)

;; When we have finished with all these interesting components of the X
;; Window System, we should explicitly relinquish them, reversing the order
;; in which they were created.  The CLEAN-UP-AFTERWARDS procedure takes
;; care of this process.

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

;; The PLOTTER procedure first computes a number of values of the specified
;; function, for arguments in the specified range, and finds the maximum
;; and minimum of those values, so as to determine the scale to be used
;; along the vertical axis and the interval within which the values are to
;; be displayed.  It draws appropriately placed axes into the window,
;; labels them, and adds a few labelled tick marks to each one for
;; reference.  It then draws a succession of line segments connecting the
;; points whose coordinates are the selected arguments and the computed
;; values of the function; ideally, if there are enough points, these line
;; segments blend visually into a smooth curve.  Finally, it starts up an
;; event handler to listen for the signal to quit.

(define plotter
  (lambda (function lower-bound upper-bound)
    (let* ((arguments (subdivide lower-bound upper-bound
                                 (- plot-diameter 1)))
           (results (map function arguments))
           (top (apply max results))
           (bottom (apply min results)))

      ;; Repeatedly activate the event handler to determine the nature of
      ;; the user's next request.

      (do ((request 'draw
                    (handle-events plot-display #f #f (key-press handler))))

          ;; When the request is QUIT, exit from the loop and free the
          ;; allocated resources.
          
          ((eq? request 'quit) (clean-up-afterwards))

        ;; When the request is DRAW, draw in the axes and plot the
        ;; function.

        (if (eq? request 'draw)
            (begin
              (draw-axes lower-bound upper-bound bottom top)
              (plot-function arguments results lower-bound upper-bound
                             bottom top)
              (add-credit-line)))))))

;; The SUBDIVIDE procedure takes three arguments.  The first two, which
;; must be real numbers, specify the lower and upper bounds of an interval;
;; the third, which must be an exact positive integer, indicates the number
;; of sub-intervals into which the interval should be divided.  SUBDIVIDE
;; returns a list of real numbers of which LOWER is the first element,
;; UPPER the last, and the intermediate results are equally spaced real
;; values that partition the interval into the specified number of
;; sub-intervals.

(define subdivide
  (lambda (lower upper intervals)
    (let ((gap (/ (- upper lower) intervals)))
      (let loop ((result (list upper))
                 (post (- upper gap)))
        (if (< post lower)
            result
            (loop (cons post result) (- post gap)))))))

;; The DRAW-AXES procedure positions a pair of coordinate axes on the
;; display.  It takes as arguments the least and greatest arguments and
;; values of the function to be plotted.

(define draw-axes
  (lambda (left right bottom top)

    ;; Compute the positions at which to display the axes -- through the
    ;; point at which the other coordinate is zero, if that is in the
    ;; window and otherwise near the edge of the window on the side closest
    ;; to zero.

    (let ((x-axis-coordinate
           (cond ((not (negative? left)) left)
                 ((not (positive? right)) right)
                 (else 0)))
          (y-axis-coordinate
           (cond ((not (positive? top)) top)
                 ((not (negative? bottom)) bottom)
                 (else 0))))

      ;; Draw the axis with black lines one pixel wide.

      (set-gcontext-line-width! plot-graphics-context 1)
      (set-gcontext-foreground! plot-graphics-context black)

      ;; The horizontal axis, from left to right:

      (draw-line plot-window plot-graphics-context
                 (scale left left right)
                 (reverse-scale x-axis-coordinate bottom top)
                 (scale right left right)
                 (reverse-scale x-axis-coordinate bottom top))

      ;; The vertical axis, from top to bottom:

      (draw-line plot-window plot-graphics-context
                 (scale y-axis-coordinate left right)
                 (reverse-scale top bottom top)
                 (scale y-axis-coordinate left right)
                 (reverse-scale bottom bottom top)))))

;; The SCALE procedure transforms numbers in the range specified for
;; arguments to the function into pixel counts from the left edge of the
;; window.  The division operation indicates how far from the left edge of
;; the plot the given position is, as a fraction of the total width of the
;; plot; the multiplication scales this up to a pixel count, and the
;; addition allows for the left margin around the plot.

(define scale
  (lambda (position start finish)
    (+ plot-margin
       (truncate (* plot-diameter (/ (- position start)
                                     (- finish start)))))))

;; The REVERSE-SCALE procedure transforms numbers in the range specified
;; for values of the function to be plotted into pixel counts from the top
;; edge of the window.  The division operation indicates how far from the
;; bottom edge of the plot the given position is, as a fraction of the
;; total height of the plot; the multiplication scales this up to a pixel
;; count, and the subtraction reverses the direction of measurement so that
;; one is counting down from the top rather than up from the bottom,
;; allowing also for the top margin around the plot.

(define reverse-scale
  (lambda (position start finish)
    (- diameter-in-pixels
       plot-margin
       (truncate (* plot-diameter (/ (- position start)
                                     (- finish start)))))))

;; PLOT-FUNCTION draws the curve of the function onto the graph, given the
;; values of the function for a substantial number of arguments.

(define plot-function
  (lambda (arguments results left right bottom top)

    ;; Plot the curve with a red line two pixels wide.

    (set-gcontext-line-width! plot-graphics-context 2)
    (set-gcontext-foreground! plot-graphics-context red)

    ;; Construct a vector of pairs, each pair comprising the x- and
    ;; y-values of one point on the graph of the function to be plotted.
    ;; Submit this vector to DRAW-LINES, which will connect the dots.

    (let* ((len (length arguments))
           (vec (make-vector len)))
      (do ((position 0 (+ position 1))
           (rest-of-args arguments (cdr rest-of-args))
           (rest-of-results results (cdr rest-of-results)))
          ((= position len) (draw-lines plot-window plot-graphics-context
                                        vec #f))
        (vector-set! vec position
                     (cons (scale (car rest-of-args) left right)
                           (reverse-scale (car rest-of-results)
                                          bottom top))))))) 

(define add-credit-line
  (lambda ()
    (let ((credit-line (translate-text "Drawn by PLOTTER"))
          (current-font (gcontext-font plot-graphics-context)))
      (set-gcontext-foreground! plot-graphics-context black)
      (draw-image-text plot-window plot-graphics-context
                       (quotient plot-margin 2)
                       (- diameter-in-pixels (quotient plot-margin 2))
                       credit-line '1-byte))))

;; Now to start the thing running.  In this particular example, we plot the
;; function x^3 - 8x - 4 in the range from -4 to +5.

(plotter (lambda (x) (- (* x x x) (* 8 x) 4)) -4.0 5.0)
(exit)