;;; -*- Mode:Common-Lisp; Package:USER; Base:10; Fonts:(COURIER HL12B) -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1985,1986,1987,1988,1989,1990 Texas Instruments Incorporated. All rights reserved.

;;; ZMACS TUTORIAL: C-Curve Program

Ï1;;;  This program is a variation on William Gosper's well known C-curves.  TheÏ* Ï1tutorial tells you
;;;  how to enter the missing PLOT-LINE function.  You may thenÏ* Ï1run the completed program by
;;;     1.  pressing Ï*SYSTEM LÏ1 to go to a Lisp Listener,
;;;     2.  pressing the Ï*CLEAR-SCREENÏ1 key to clear the screen, and
;;;     3.  entering Ï*(DO-C-CURVES 300 (/ PI 2))Ï1 to draw the curve.Ï*

(in-package "USER")

(DEFUN DO-C-CURVES (length angle)
  "Draws a C-curve.  LENGTH is the maximum length of a line segment in pixels.
ANGLE is the orientation angle in radians of the \"C\" on the screen (pi/2 gives
an upright C).  The figure is drawn over twice slightly displaced to darken it.
Returns the symbol OK."

Ï1  ;; validate the user's inputsÏ*
  (check-type length (rational (0) *)  "a positive number")
  (check-type angle  number            "a number")

  Ï1;; bind the variables needed by the program only while running the programÏ*
  (let ((min-length 4.)     Ï1; line segment length below which recursion stopsÏ*
	(x-initial 400.)    Ï1; initial X and Y starting point of the C curve in pixelsÏ*
        (y-initial 200.)
	x                   Ï1; current X and Y end point of the C curve in pixelsÏ*
        y)
    Ï1;; make only X, Y, and MIN-LENGTH available to the outside environmentÏ*
    (declare (special x y min-length))
    
    Ï1;; set up initial values of the end points X and Y for first call to C-CURVEÏ*
    (setf x x-initial
	  y y-initial)
    (c-curve length angle)

    Ï1;; use same Y but displace X one pixel for second call to C-CURVE to darken itÏ*
    (setf x (1+ x-initial)
	  y y-initial)
    (c-curve length angle)
    'OK))


(DEFUN C-CURVE (length angle)
  "If LENGTH is greater than MIN-LENGTH, call C-CURVE recursively twice for shorter
length at positive and negative deltas on ANGLE.  Otherwise, just plot the line of
specified LENGTH at specified ANGLE."
  
Ï1  ;; MIN-LENGTH comes from the outside environmentÏ*
  (declare (special min-length))
  
  (cond ((< length min-length)
	 Ï1;; case of LENGTH less than lower limit, so just plot itÏ*
	 (plot-line length angle))
	
	(t
	Ï1 ;; otherwise, case of LENGTH still longer than minimum, so split in two and recurseÏ*
	 (c-curve (/ length (sqrt 2.0))  (+ angle  (/ pi 4.0)))
	 (c-curve (/ length (sqrt 2.0))  (- angle  (/ pi 4.0))))))

(DEFUN CONNECT-LINE (x-new y-new)
  "Draw the actual line segment from the current end point X and Y to the new
end point X-NEW and Y-NEW.  X-NEW and Y-NEW then become the current end point."

Ï1  ;; X and Y are accessed in the outside environmentÏ*
  (declare (special x y))

  Ï1;; draw the line segment on the screenÏ*
  (send tv:selected-window :draw-line (round x) (round y)
	                              (round x-new) (round y-new))
  Ï1;; update the end point of the C curve to be the end of the newly drawn segmentÏ*
  (setf x x-new
	y y-new))

 
