;;; -*-LISP-*-
;;;
;;; Copyright (C) 2002,2003 Donald Fisk
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
;;; USA

;;; Here is an elegant way to draw almost circles on a
;;; point-plotting display:
;;;
;;; NEW X = OLD X - epsilon * OLD Y
;;; NEW Y = OLD Y + epsilon * NEW(!) X

(setf EPSILON 0.002)

(setq CANVAS (new 'Canvas
		  'title "Still Life"; 'x 600
		  'fillColor WHITE))

;;; Item 149, HAKMEM.
(defun minskyCircle (canvas x y x0 y0)
  (do ((i 4000 (sub1 i))
       (newX)
       (newY))
      ((zerop i))
      (setf newX (- x (* EPSILON y)))
      (setf newY (+ y (* EPSILON newX)))
      (drawPoint (getWindow canvas) (getGC canvas)
		 (+ x0 (floor newX))
		 (+ y0 (floor newY))
		 BLACK)
      (setq x newX)
      (setq y newY)))
      
(doTimes (i 10)
	 (minskyCircle CANVAS 50 (* i 20) 200 200))

(doTimes (i 10)
	 (minskyCircle CANVAS (* i 10) (* i 10)  200 200))

;;;; ---------------------------------------------

;;; Munching squares is just views of the graph Y = X op T
;;; for consecutive values of T = time.  (Item 147, HAKMEM).
(defun munchingSquares ()
  (do ((op 0 (mod (add1 op) 16))
       (window (getWindow CANVAS))
       (gc (getGC CANVAS)))
      (FALSE)
      (do ((time 0 (add1 time)))
	  ((= time 256))
	  (do ((x 255 (sub1 x)))
	      ((< x 0))
	      (drawPoint window gc x (mod (boole op x time) 256) WHITE)))
      (clearArea window 0 0 256 256)))

(setq CANVAS (new 'Canvas
		  'title "Munching Squares"
		  'width 256 'height 256
		  'fillColor BLACK))

(setq ms (thread munchingSquares '()))