;;; -*- Mode:LISP; Package:USER; Readtable:CL; Base:10 -*-

(defun wow ()
  (dotimes (i 350)
    (send tv:initial-lisp-listener :draw-circle 400 400 (* 2 i)))
  (loop))

(defvar *window* tv:initial-lisp-listener)

(defconstant *square-root-of-two* (sqrt 2))

(defconstant *square-root-of-two-over-two* (/ 1 (sqrt 2)))

(defconstant *pi-over-four* (/ pi 4))

(defvar *x* 0)

(defvar *y* 0)

(defun c-curve (length angle min-length)
  (if (< length min-length)
      (plot-line length angle)
      (progn
	(c-curve (* length *square-root-of-two-over-two*)
		 (+ angle *pi-over-four*)
		 min-length)
	(c-curve (* length *square-root-of-two-over-two*)
		 (- angle *pi-over-four*)
		 min-length))))

(defun dragon-curve (length angle min-length handedness)
  "See p. 348, 'LISP'."
  (if (< length min-length)
      (plot-line length angle)
      (progn
	(dragon-curve (* length *square-root-of-two-over-two*)
		      (+ angle (* handedness *pi-over-four*))
		      min-length
		      +1)
	(dragon-curve (* length *square-root-of-two-over-two*)
		      (- angle (* handedness *pi-over-four*))
		      min-length
		      -1))))

(defun depth-dragon-curve (length angle depth handedness)
  "See p. 348, 'LISP'."
  (if (zerop depth)
      (plot-line length angle)
      (progn
	(depth-dragon-curve (* length *square-root-of-two-over-two*)
			    (+ angle (* handedness *pi-over-four*))
			    (1- depth)
			    +1)
	(depth-dragon-curve (* length *square-root-of-two-over-two*)
			    (- angle (* handedness *pi-over-four*))
			    (1- depth)
			    -1))))

(defun funny-curve (length angle min-length handedness)
  (if (< length min-length)
      (plot-line length angle)
      (progn
	(funny-curve (* length *square-root-of-two-over-two*)
		      (+ angle (* handedness *pi-over-four*))
		      min-length
		      (- handedness))
	(funny-curve (* length *square-root-of-two-over-two*)
		      (- angle (* handedness *pi-over-four*))
		      min-length
		      (+ handedness)))))

(defun plot-line (length angle)
  (let* ((dx (* length (cos angle)))
	 (dy (* length (sin angle)))
	 (x2 (round (+ *x* dx)))
	 (y2 (round (+ *y* dy))))
    (send *window* :draw-line *x* *y* x2 y2)
    (setq *x* x2)
    (setq *y* y2)))

(defun center ()
  (setq *x* 300)
  (setq *y* 300))

(eval-when (eval) #'try)
(NAMED-LAMBDA TRY NIL (BLOCK TRY (CENTER) (DRAGON-CURVE 200 0 3 1) (DRAGON-CURVE 200 0 2 1) (CENTER) (DRAGON-CURVE 200 PI 2 1) (CENTER) (DRAGON-CURVE 200 (* PI 1/2) 1 1) (CENTER) (DRAGON-CURVE 200 (* PI 3/2) 1 1)))

(dragon-curve 
(eval-when (eval)
  (center)
  (setq *x* (+ 200 *x*))
  (dragon-curve 200 (* pi 3/4) 2 1))

(defun dragon-iter ()
  (dotimes (i 100)
    (princ (read-char))
    (center)
    (setq *x* 150)
    (depth-dragon-curve 500 0 i 1)))