;;; -*-Scheme-*-

;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-

;;; CLX - Point Graphing demo program

;;; Copyright (C) 1988 Michael O. Newton (newton@csvax.caltech.edu)

;;; Permission is granted to any individual or institution to use, copy,
;;; modify, and distribute this software, provided that this complete
;;; copyright and permission notice is maintained, intact, in all copies and
;;; supporting documentation.

;;; The author provides this software "as is" without express or
;;; implied warranty.

;;; This routine plots the recurrance
;;;      x <- y(1+sin(0.7x)) - 1.2(|x|)^.5
;;;      y <- .21 - x
;;; As described in a ?? 1983 issue of the Mathematical Intelligencer
;;; It has ONLY been tested under X.V11R2 on a Sun3 running KCL

(require 'xlib)

(define (picture point-count)
  (let* ((dpy (open-display))
	 (width 600)
	 (height 600)
	 (black (black-pixel dpy))
	 (white (white-pixel dpy))
	 (root (display-root-window dpy))
	 (win (create-window 'parent root 'background-pixel white
			   'event-mask '(exposure button-press)
			   'width width 'height height))
	 (gc (create-gcontext 'window win
			    'background white 'foreground black)))
    (map-window win)
    (unwind-protect
     (handle-events dpy #t #f
       (expose
	(lambda ignore
	  (clear-window win)
	  (draw-points win gc point-count 0.0 0.0 (* width 0.5) (* height 0.5))
	  (draw-poly-text win gc 10 10 (translate "Click a button to exit")
			  '1-byte)
	  #f))
       (else (lambda ignore #t)))
     (close-display dpy))))

;;; Draw points.  These should maybe be put into a an array so that they do
;;; not have to be recomputed on exposure.  X assumes points are in the range
;;; of width x height, with 0,0 being upper left and 0,H being lower left.
;;;      x <- y(1+sin(0.7x)) - 1.2(|x|)^.5
;;;      y <- .21 - x
;;; hw and hh are half-width and half-height of screen

(define (draw-points win gc count x y hw hh)
  (if (zero? (modulo count 100))
      (display-flush-output (window-display win)))
  (if (not (zero? count))
      (let ((xf (floor (* (+ 1.2 x) hw ))) ; These lines center the picture
	    (yf (floor (* (+ 0.5 y) hh ))))
	(draw-point win gc xf yf)
	(draw-points win gc (1- count)
		     (- (* y (1+ (sin (* 0.7 x)))) (* 1.2 (sqrt (abs x))))
		     (- 0.21 x)
		     hw hh))))

(define (translate string)
  (list->vector (map char->integer (string->list string))))

(picture 10000)