;;; -*- 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 (b)(3)(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, 1988 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 L1 to go to a Lisp Listener,
;;;     2.  pressing the *CLEAR-SCREEN1 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))