;;;-*- Mode:Common-Lisp; Package:PICTURE; Base:10; Fonts:(MEDFNB HL12B HL12BI) -*-


;;; This software was developed at the Texas Instruments Corporation
;;; and is provided "as-is".  Texas Instruments Corporation and the
;;; author disclaim all warranties on the software, including without
;;; limitation, all implied warranties of merchantability and fitness.
;;;
;;; This software does not contain any technical data or information
;;; that is proprietary in nature.  It may be copied, modified, and
;;; distributed on a non-profit basis and with the inclusion of this
;;; notice.
;;;
;;; Copyright (C) 1989, Texas Instruments Incorporated.



;;; Change history:
;;;
;;;  Date      Author	Description
;;; -------------------------------------------------------------------------------------
;;;  3/21/89    TWE	Fixed up spline drawing to use :DRAW-POLYLINE instead of drawing
;;;			the individual pieces vis :DRAW-LINE.  This new approach avoids
;;;			leaving mouse turds on the picture window.  Added code to
;;;			indicate that the graphic objects generated are non-standard
;;;			LaTeX commands (well, really they are eepic commands).
;;;  3/20/89    TWE	Initial creation.

(DEFFLAVOR SPLINE-OBJECT
 ((END-X-POSITION NIL :TYPE INTEGER-OR-NIL)
  (END-Y-POSITION NIL :TYPE INTEGER-OR-NIL)
  (CONTROL-X      NIL :TYPE INTEGER-OR-NIL)
  (CONTROL-Y      NIL :TYPE INTEGER-OR-NIL)
  (THICKNESS      NIL :TYPE INTEGER-OR-NIL))
  (BASIC-OBJECT)
  :SETTABLE-INSTANCE-VARIABLES
  :INITTABLE-INSTANCE-VARIABLES
  :GETTABLE-INSTANCE-VARIABLES)

(DEFMETHOD (SPLINE-OBJECT :TRANSLATE-UNITS) (NEW-OVER-OLD X-ORIGIN Y-ORIGIN)
  (SETQ X-POSITION     (+ (* NEW-OVER-OLD (- X-POSITION     X-ORIGIN)) X-ORIGIN)
        Y-POSITION     (+ (* NEW-OVER-OLD (- Y-POSITION     Y-ORIGIN)) Y-ORIGIN)
        END-X-POSITION (+ (* NEW-OVER-OLD (- END-X-POSITION X-ORIGIN)) X-ORIGIN)
        END-Y-POSITION (+ (* NEW-OVER-OLD (- END-Y-POSITION Y-ORIGIN)) Y-ORIGIN)
        CONTROL-X      (+ (* NEW-OVER-OLD (- CONTROL-X      X-ORIGIN)) X-ORIGIN)
        CONTROL-Y      (+ (* NEW-OVER-OLD (- CONTROL-Y      Y-ORIGIN)) Y-ORIGIN)))

;;; We assume that the spline is composed of two line segments, which is wrong, but
;;; the code to really calculate this is more complex than I care to write at this
;;; time and this case is close enough to reality to be adequate for now.  One of
;;; the line segment goes from the initial position to the control point, and the
;;; other line segment goes from the control point to the final position.
(DEFMETHOD (SPLINE-OBJECT :DISTANCE-FROM-POINT) (WINDOW X Y)
  "Returns the smallest distance that this object is from the point (X,Y).
X and Y are measured in terms of the current unit."
  (DECLARE (IGNORE WINDOW))
  (MIN
    (DISTANCE-FROM-LINE-SEGMENT X Y X-POSITION Y-POSITION CONTROL-X CONTROL-Y)
    (DISTANCE-FROM-LINE-SEGMENT X Y CONTROL-X CONTROL-Y END-X-POSITION END-Y-POSITION)))

;;; Taken from the code which calculates the distance from a line.
(DEFUN DISTANCE-FROM-LINE-SEGMENT (X Y X-POSITION Y-POSITION END-X-POSITION END-Y-POSITION)
  "Returns the smallest distance that this object is from the point (X,Y).
X and Y are measured in terms of the current unit."
  ;; Compute the length of a line segment starting at (X-POSITION,Y-POSITION)
  ;; and ending at a point (X1,Y1) such that the slope of the line segment is
  ;; DELTA-Y / DELTA-X and (X1,Y1) is the point nearest to the point (X,Y).
  (LET (SLOPE-DIRECTION
        (DELTA-X (- X-POSITION END-X-POSITION))
        (DELTA-Y (- Y-POSITION END-Y-POSITION)))
    (COND ((ZEROP DELTA-X)
           (SETQ SLOPE-DIRECTION (SIGN DELTA-Y))
           ;; This is a vertical line.  The distance between any point and this line is
           ;; simply the differences between the X components.  However, this isn't really
           ;; a line but is just a line segment.  For those points which are to the
           ;; immediate left or right of this line segment, the distance is easy.  For the
           ;; other points, the distance formula must be applied between (X,Y) and the
           ;; appropriate endpoint.
           (IF (OR (<= Y-POSITION Y END-Y-POSITION)
                   (>= Y-POSITION Y END-Y-POSITION))
               (ABS (- X-POSITION X))
               ;;ELSE
               (IF (OR (AND (PLUSP  SLOPE-DIRECTION) (< Y Y-POSITION))
                       (AND (MINUSP SLOPE-DIRECTION) (> Y Y-POSITION)))
                   ;; (X,Y) is below or above the line segment, respectively.
                   (W:DIST X Y X-POSITION Y-POSITION)
                   ;;ELSE
                   (W:DIST X Y X-POSITION END-Y-POSITION))))
          ((ZEROP DELTA-Y)
           ;;Horizontal line.  Very similar to the vertical case.
           (SETQ SLOPE-DIRECTION (SIGN DELTA-X))
           ;; This is a horizontal line.  This is very similar to the vertical line case.
           (IF (OR (<= X-POSITION X END-X-POSITION)
                   (>= X-POSITION X END-X-POSITION))
               (ABS (- Y-POSITION Y))
               ;;ELSE
               (IF (OR (AND (PLUSP  SLOPE-DIRECTION) (< X X-POSITION))
                       (AND (MINUSP SLOPE-DIRECTION) (> X X-POSITION)))
                   ;; (X,Y) is to the left or right of the line segment, respectively.
                   (W:DIST X Y X-POSITION Y-POSITION)
                   ;;ELSE
                   (W:DIST X Y END-X-POSITION Y-POSITION))))
          (T
           ;; This is the complex case.  We have an arbitrarily (well, almost)
           ;; sloped line segment.  For an explanation of the following
           ;; calculation, see the comments before the definition of the
           ;; BEST-LINE-LENGTH function.  The idea is to first determine if the point (X,Y)
           ;; is closer to some point on the line segment or if it is closer to one of the
           ;; endpoints.  If this were a line instead of a line segment, then we would just
           ;; need to compute the distance from the point (X2,Y2) and (X,Y).  But this is
           ;; not a line, it is a line segment,  We need to determine if (X2,Y2) is within
           ;; the line segment before we can do that kind of distance calculation.
           (LET* ((SLOPE (/ DELTA-Y DELTA-X))
                  (INTERCEPT (- Y-POSITION (* SLOPE X-POSITION)))
                  (X2 (/ (+ (* Y SLOPE) X (- (* INTERCEPT SLOPE)))
                         (1+ (* SLOPE SLOPE))))
                  (Y2 (+ (* SLOPE X2) INTERCEPT)))
             (IF (AND (FUNCALL (IF (PLUSP DELTA-X) #'<= #'>=) X-POSITION X2 END-X-POSITION)
                      (FUNCALL (IF (PLUSP DELTA-Y) #'<= #'>=) Y-POSITION Y2 END-Y-POSITION))
                 (W:DIST X Y X2 Y2)
                 ;;1ELSE*
                 ;; At this point we know that the point (X,Y) is nearest to one
                 ;; of the endpoints.  We could try to figure out which endpoint
                 ;; it is nearest, but we don't really need to do that.  At the
                 ;; expense of some extra calculations, all we need to do is to
                 ;; compute the distances between (X,Y) and each of the endpoints.
                 ;; The smallest distance is the correct one.
                 (MIN (W:DIST X Y X-POSITION Y-POSITION)
                      (W:DIST X Y END-X-POSITION END-Y-POSITION))))))))

(DEFMETHOD (SPLINE-OBJECT :OBJECT-LIMITS) (WINDOW)
  "Returns the minimum and maximum limits of this object.
The values returned are the left top right and bottom unit values."
  (DECLARE (IGNORE WINDOW))
  ;; This calculation isn't entirely accurate since the control point isn't really on
  ;; the spline that is drawn.  The box is really smaller than what we pass back.
  (VALUES (MIN X-POSITION END-X-POSITION CONTROL-X) (MAX Y-POSITION END-Y-POSITION CONTROL-Y)
          (MAX X-POSITION END-X-POSITION CONTROL-X) (MIN Y-POSITION END-Y-POSITION CONTROL-Y)))

(DEFMETHOD (SPLINE-OBJECT :WRITE-LATEX) (LATEX-STREAM TEXIFY)
  "2Write the description of this object to a LaTeX file.*"
  (DECLARE (IGNORE TEXIFY))
  (WHEN THICKNESS
    (FORMAT LATEX-STREAM (COND ((= THICKNESS *THIN-LINES*)
                                "{\\thinlines ")
                               ((= THICKNESS *THICK-LINES*)
                                "{\\thicklines ")
                               (T
                                ;; The scale factor of 0.075mm was derived by looking at
                                ;; thin and thick lines and lines of thickness .15mm and
                                ;; .30mm and noting that they looked identical.
                                (FORMAT NIL "{\\allinethickness{~Dmm} " (* THICKNESS 0.075))))))
        
  (FORMAT LATEX-STREAM "\\spline(~F,~F)(~F,~F)(~F,~F)"
          X-POSITION Y-POSITION CONTROL-X CONTROL-Y END-X-POSITION END-Y-POSITION)
  (WHEN THICKNESS
    (FORMAT LATEX-STREAM "}"))
  (TERPRI LATEX-STREAM))

(DEFMETHOD (SPLINE-OBJECT :WRITE-PICTURE) (PICTURE-STREAM)
  "2Write the description of this object to an auxilary file.*"
  ;; We write a string which, when read using the READ function, will create this object.
  (FORMAT PICTURE-STREAM "(MAKE-INSTANCE 'PICTURE:SPLINE-OBJECT ~
                                         :X-POSITION ~D :Y-POSITION ~D ~
                                         :PORTABLE-OBJECT NIL ~
                                         :END-X-POSITION ~D :END-Y-POSITION ~D ~
                                         :CONTROL-X ~D :CONTROL-Y ~D ~
                                         :THICKNESS ~D)~%"
          X-POSITION Y-POSITION  END-X-POSITION END-Y-POSITION CONTROL-X CONTROL-Y
          THICKNESS))

(DEFMETHOD (SPLINE-OBJECT :DRAW) (WINDOW &OPTIONAL (ALU NIL))
  (IF ALU
      (SEND WINDOW :SETUP-INSTANCE-ENVIRONMENT (LIST 'DRAW-SPLINE-OBJECT SELF ALU))
      ;;1ELSE*
      (SEND WINDOW :SETUP-INSTANCE-ENVIRONMENT (LIST 'DRAW-SPLINE-OBJECT SELF))))

(DEFMETHOD (SPLINE-OBJECT :NAME) ()
  "Return a string which identifies the object."
  (FORMAT NIL "Spline from (~D,~D) to (~D,~D)~%with control point at (~D,~D)"
          X-POSITION Y-POSITION END-X-POSITION END-Y-POSITION CONTROL-X CONTROL-Y))

(DEFMETHOD (SPLINE-OBJECT :SHORT-NAME) ()
  "Return a narrow string which identifies the object."
  (FORMAT NIL "Spline ~
              ~:[~4*~;~%(~,2F,~,2F)->(~,2F,~,2F)~]~
              ~:[~2*~;~%Control=(~,2F,~,2F)~]"
          X-POSITION X-POSITION Y-POSITION END-X-POSITION END-Y-POSITION
          CONTROL-X CONTROL-X CONTROL-Y))

(DEFMETHOD (SPLINE-OBJECT :EDIT-FUNCTION) ()
  "Returns the symbol which is the function to do editing for this object."
  'DRAW-SPLINE)

(DEFMETHOD (SPLINE-OBJECT :PICK-CORNER-FUNCTION) ()
  'PICK-SPLINE-POINT)

(DEFMETHOD (SPLINE-OBJECT :REPLICATE) ()
  "2Make a copy of this object.*"
  (MAKE-INSTANCE 'SPLINE-OBJECT
                 :X-POSITION X-POSITION
                 :Y-POSITION Y-POSITION
                 :PORTABLE-OBJECT NIL
                 :END-X-POSITION END-X-POSITION
                 :END-Y-POSITION END-Y-POSITION
                 :CONTROL-X CONTROL-X
                 :CONTROL-Y CONTROL-Y
                 :THICKNESS THICKNESS))

(DEFCONSTANT SPLINE-POINTS 500)
(DEFPARAMETER SPLINEX (MAKE-ARRAY SPLINE-POINTS))
(DEFPARAMETER SPLINEY (MAKE-ARRAY SPLINE-POINTS))

(DEFUN CALCULATE-SPLINE-POINTS (XX-IN YY-IN)
  (LET* (XP YP WORK T1 T2 T3
         (PATH-LENGTH (LENGTH XX-IN))
         (N (1+ PATH-LENGTH))
         (XX (LET ((ARRAY (MAKE-ARRAY (+ N 1))))
               (SETF (AREF ARRAY 0) (AREF XX-IN 0))
               (SETF (AREF ARRAY N) (AREF XX-IN (- N 2)))
               (LOOP FOR I FROM 1 BELOW N
                     DO (SETF (AREF ARRAY I) (AREF XX-IN (1- I))))
               ARRAY))
         (YY (LET ((ARRAY (MAKE-ARRAY (+ N 1))))
               (SETF (AREF ARRAY 0) (AREF YY-IN 0))
               (SETF (AREF ARRAY N) (AREF YY-IN (- N 2)))
               (LOOP FOR I FROM 1 BELOW N
                     DO (SETF (AREF ARRAY I) (AREF YY-IN (1- I))))
               ARRAY))
         (SPLINE-LENGTH 0))
    (FLET ((IDIST (X1 Y1 X2 Y2)
            (DECLARE (VALUES INTEGER))
            (TRUNCATE (+ (W:DIST X1 Y1 X2 Y2) .5))))
      (LOOP FOR I FROM 0 BELOW (1- N)
            FOR STEPS = (TRUNCATE (+ (IDIST (AREF XX    I )   (AREF YY    I )
                                            (AREF XX (+ I 1)) (AREF YY (+ I 1)))
                                     (IDIST (AREF XX (+ I 1)) (AREF YY (+ I 1))
                                            (AREF XX (+ I 2)) (AREF YY (+ I 2))))
                                  20)
            FOR DOUBLE-STEPS = (+ 0.0D0 STEPS)
            DO (PROGN
                 (LOOP FOR J FROM 0 BELOW STEPS
                       FOR DOUBLE-J = (+ 0.0D0 J)
                       DO (PROGN
                            (SETQ WORK (/ DOUBLE-J DOUBLE-STEPS)
                                  T1 (* 0.5D0 WORK WORK))
                            (DECF WORK 0.5D0)
                            (SETQ T2 (- 0.75D0 (* WORK WORK)))
                            (DECF WORK 0.5D0)
                            (SETQ T3 (* 0.5D0 WORK WORK))
                            (SETQ XP (+ (* T1 (AREF XX (+ I 2)))
                                        (* T2 (AREF XX (+ I 1)))
                                        (* T3 (AREF XX (+ I 0))) .5)
                                  YP (+ (* T1 (AREF YY (+ I 2)))
                                        (* T2 (AREF YY (+ I 1)))
                                        (* T3 (AREF YY (+ I 0))) .5))
                            (SETQ XP (TRUNCATE XP))
                            (SETQ YP (TRUNCATE YP))
                            (WHEN (= SPLINE-LENGTH (1- SPLINE-POINTS))
                              (ERROR "Too many points in a spline"))
                            (SETF (AREF SPLINEX SPLINE-LENGTH) XP)
                            (SETF (AREF SPLINEY SPLINE-LENGTH) YP)
                            (INCF SPLINE-LENGTH))))))
    (WHEN (NOT (= SPLINE-LENGTH (1- SPLINE-POINTS)))
      ;; Mark the last point.
      (SETF (AREF SPLINEX SPLINE-LENGTH) NIL))
    SPLINE-LENGTH))

(DEFUN DRAW-SPLINE-POINTS (WINDOW ALU THICKNESS)
  ;; Large thicknesses must be scaled again to make them look correct on the screen.
  ;; The problem here is that thin lines are drawn with only one pixel of thickness, but
  ;; their comparative thickness on the page is much smaller.  Thick lines are also much
  ;; thicker on the screen than they appear on paper.  What we are doing here is to
  ;; scale lines thicker than `thick lines' to make them appear the same on the screen
  ;; as they appear on paper.
  (WHEN (> THICKNESS (TRUNCATE *THICK-LINES* 2))
    (SETQ THICKNESS (MAX (TRUNCATE *THICK-LINES* 2) (TRUNCATE (/ THICKNESS 1.275)))))

  ;; It is best to draw the spline all at once rather than in pieces so that there
  ;; aren't any gaps between the line segments.
  (SEND WINDOW :DRAW-POLYLINE SPLINEX SPLINEY THICKNESS W:BLACK
        ;; How many points are there?
        (LOOP FOR COUNT FROM 0 BY 1 WHILE (AREF SPLINEX COUNT) FINALLY (RETURN COUNT))
        ALU))

(DEFUN DRAW-SPLINE-OBJECT (OBJECT &OPTIONAL (ALU W:CHAR-ALUF))
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (LET ((X-ARRAY (MAKE-ARRAY 3))
        (Y-ARRAY (MAKE-ARRAY 3)))
    ;; Note that we do not translate the line-thickness since this is not in terms of
    ;; a specific dimension; it can only be thick or thin.

    (SETF (AREF X-ARRAY 0) (TRANSLATE-X-UNIT-TO-PIXEL (SEND OBJECT :X-POSITION)))
    (SETF (AREF Y-ARRAY 0) (TRANSLATE-Y-UNIT-TO-PIXEL (SEND OBJECT :Y-POSITION)))
    (SETF (AREF X-ARRAY 1) (TRANSLATE-X-UNIT-TO-PIXEL (SEND OBJECT :CONTROL-X)))
    (SETF (AREF Y-ARRAY 1) (TRANSLATE-Y-UNIT-TO-PIXEL (SEND OBJECT :CONTROL-Y)))
    (SETF (AREF X-ARRAY 2) (TRANSLATE-X-UNIT-TO-PIXEL (SEND OBJECT :END-X-POSITION)))
    (SETF (AREF Y-ARRAY 2) (TRANSLATE-Y-UNIT-TO-PIXEL (SEND OBJECT :END-Y-POSITION)))
    (WHEN (PLUSP (CALCULATE-SPLINE-POINTS X-ARRAY Y-ARRAY))
      (DRAW-SPLINE-POINTS SELF ALU (OR (SEND OBJECT :THICKNESS) LINE-THICKNESS)))))


(DEFCONSTANT SPLINE-END-POINT-MOUSE-DOCUMENTATION
             '(:MOUSE-L-1 "Pick an end point of the spline"
               :MOUSE-M-1 "Abort out of this operation"))

(DEFUN MOVE-SPLINE (OBJECT)
  "Use the mouse to move a spline to a new location."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (COND ((NULL (SEND OBJECT :X-POSITION))
         (PICTURE-ERROR "A starting point is not specified yet.")
         T)
        ((NULL (SEND OBJECT :END-X-POSITION))
         (PICTURE-ERROR "An ending point is not specified yet.")
         T)
        ((NULL (SEND OBJECT :CONTROL-X))
         (PICTURE-ERROR "A control point is not specified yet.")
         T)
        (T
         (LET ((OLD-X-POSITION (SEND OBJECT :X-POSITION))
               (OLD-Y-POSITION (SEND OBJECT :Y-POSITION))
               (OLD-END-X-POSITION (SEND OBJECT :END-X-POSITION))
               (OLD-END-Y-POSITION (SEND OBJECT :END-Y-POSITION))
               (OLD-CONTROL-X (SEND OBJECT :CONTROL-X))
               (OLD-CONTROL-Y (SEND OBJECT :CONTROL-Y))
               USER-INPUT)
           (SEND
             SELF :TURN-ON-RUBBERBAND
             #'(LAMBDA (X Y)
                (MULTIPLE-VALUE-BIND (X-UNIT Y-UNIT)
                    (SEND SELF :GRIDIFY-MEASURE
                          (TRANSLATE-PIXEL-TO-UNIT X)
                          (TRANSLATE-PIXEL-TO-UNIT Y))
                  (LET ((DELTA-X (- X-UNIT (SEND OBJECT :X-POSITION)))
                        (DELTA-Y (- Y-UNIT (SEND OBJECT :Y-POSITION))))
                    (SETF (SEND OBJECT :X-POSITION) X-UNIT)
                    (SETF (SEND OBJECT :Y-POSITION) Y-UNIT)
                    (SETF (SEND OBJECT :END-X-POSITION) (+ (SEND OBJECT :END-X-POSITION) DELTA-X))
                    (SETF (SEND OBJECT :END-Y-POSITION) (+ (SEND OBJECT :END-Y-POSITION) DELTA-Y))
                    (SETF (SEND OBJECT :CONTROL-X) (+ (SEND OBJECT :CONTROL-X) DELTA-X))
                    (SETF (SEND OBJECT :CONTROL-Y) (+ (SEND OBJECT :CONTROL-Y) DELTA-Y))))
                (SEND SELF :WRITE-OBJECT-STATUS OBJECT)
                (DRAW-SPLINE-OBJECT OBJECT W:ALU-XOR))
             (TRANSLATE-X-UNIT-TO-PIXEL OLD-X-POSITION)
             (TRANSLATE-Y-UNIT-TO-PIXEL OLD-Y-POSITION))
           (SETQ USER-INPUT (READ-MOUSE-XY-INPUT))
           ;; Turn off rubberbanding.
           (SEND SELF :TURN-OFF-RUBBERBAND)
           (IF USER-INPUT
               ;; Draw the object with a IOR alu after we have finished moving it.
               (PROGN
                 (SEND OBJECT :DRAW SELF)
                 T)
               ;;ELSE
               (PROGN
                 ;; Set the spline back the way it was.
                 (SEND OBJECT :DRAW SELF W:ALU-XOR)
                 (SETF (SEND OBJECT :X-POSITION) OLD-X-POSITION)
                 (SETF (SEND OBJECT :Y-POSITION) OLD-Y-POSITION)
                 (SETF (SEND OBJECT :END-X-POSITION) OLD-END-X-POSITION)
                 (SETF (SEND OBJECT :END-Y-POSITION) OLD-END-Y-POSITION)
                 (SETF (SEND OBJECT :CONTROL-X) OLD-CONTROL-X)
                 (SETF (SEND OBJECT :CONTROL-Y) OLD-CONTROL-Y)
                 (SEND OBJECT :DRAW SELF W:ALU-XOR)
                 NIL))))))

(DEFUN PICK-SPLINE-POINT (OBJECT)
  "Pick an initial (X,Y) point for a spline via the mouse."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (IF (AND (SEND OBJECT :X-POSITION)
           (SEND OBJECT :END-X-POSITION)
           (SEND OBJECT :CONTROL-X))
      (PROGN
        ;; The user has already specified the position.  All
        ;; that is being done now is to change the position.
        (MOVE-SPLINE OBJECT))
      ;;1ELSE*
      (MULTIPLE-VALUE-BIND (NEW-X NEW-Y)
          (MOUSE-SPECIFY-POINT OBJECT W:MOUSE-GLYPH-SPLINE-POINTER
                               SPLINE-END-POINT-MOUSE-DOCUMENTATION)
        (IF NEW-X
            (PROGN
              (MULTIPLE-VALUE-BIND (X-UNIT Y-UNIT)
                  (SEND SELF :GRIDIFY-MEASURE
                        (TRANSLATE-PIXEL-TO-UNIT NEW-X)
                        (TRANSLATE-PIXEL-TO-UNIT NEW-Y))
                (SETF (SEND OBJECT :X-POSITION) X-UNIT)
                (SETF (SEND OBJECT :Y-POSITION) Y-UNIT))
              T)
            ;;ELSE
            NIL))))

(DEFUN PICK-SPLINE-END-POINT (OBJECT)
  "Pick an ending (X,Y) point for a spline via the mouse."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (COND ((AND (SEND OBJECT :X-POSITION)
              (SEND OBJECT :END-X-POSITION)
              (SEND OBJECT :CONTROL-X))
         ;; The user has already specified the position.  All
         ;; that is being done now is to change the position.
         (RUBBER-BAND-SPLINE OBJECT :END))
        ((AND (SEND OBJECT :X-POSITION)
              (SEND OBJECT :END-X-POSITION)
              (NULL (SEND OBJECT :CONTROL-X)))
         ;; Have initial position and end position, but no control point.
         (SETF (SEND OBJECT :CONTROL-X) (SEND OBJECT :END-X-POSITION))
         (SETF (SEND OBJECT :CONTROL-Y) (SEND OBJECT :END-Y-POSITION))
         (RUBBER-BAND-SPLINE OBJECT :END))
        (T
         (RUBBER-BAND-SPLINE OBJECT :END))))

(DEFUN PICK-SPLINE-CONTROL-POINT (OBJECT)
  "Pick the control (X,Y) point for a spline via the mouse."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (COND ((AND (SEND OBJECT :X-POSITION)
              (SEND OBJECT :END-X-POSITION)
              (SEND OBJECT :CONTROL-X))
         
         ;; The user has already specified the position.  All
         ;; that is being done now is to change the position.
         (RUBBER-BAND-SPLINE OBJECT :CONTROL))
        ((AND (SEND OBJECT :X-POSITION)
              (SEND OBJECT :END-X-POSITION)
              (NULL (SEND OBJECT :CONTROL-X)))
         ;; Have initial position and end position, but no control point.
         (SETF (SEND OBJECT :CONTROL-X) (SEND OBJECT :END-X-POSITION))
         (SETF (SEND OBJECT :CONTROL-Y) (SEND OBJECT :END-Y-POSITION))
         (RUBBER-BAND-SPLINE OBJECT :CONTROL))
        (T
         (PICTURE-ERROR "Starting and ending points not specified yet."))))

(DEFUN RUBBER-BAND-SPLINE (OBJECT WHICH-POINT)
  "Use the mouse to specify the length and slope of a line."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (COND
    ((NULL (SEND OBJECT :X-POSITION))
     (PICTURE-ERROR "A starting point is not specified yet."))
    ((AND (EQ WHICH-POINT :CONTROL) (NULL (SEND OBJECT :END-X-POSITION)))
     (PICTURE-ERROR "A ending point is not specified yet."))
    (T
     (LET* ((WHICH-POINT-X-METHOD (CASE WHICH-POINT
                                    (:START   :X-POSITION)
                                    (:END     :END-X-POSITION)
                                    (:CONTROL :CONTROL-X)))
            (WHICH-POINT-Y-METHOD (CASE WHICH-POINT
                                    (:START   :Y-POSITION)
                                    (:END     :END-Y-POSITION)
                                    (:CONTROL :CONTROL-Y)))
            (CONTROL-POINT-UNSPECIFIED (NULL (SEND OBJECT :CONTROL-X)))
            (OLD-X (SEND OBJECT WHICH-POINT-X-METHOD))
            (OLD-Y (SEND OBJECT WHICH-POINT-Y-METHOD))
            USER-INPUT)
       (SEND
         SELF :TURN-ON-RUBBERBAND
         #'(LAMBDA (X Y)
             (MULTIPLE-VALUE-BIND (NEW-X NEW-Y)
                 (SEND SELF :GRIDIFY-MEASURE
                       (TRANSLATE-PIXEL-TO-UNIT X)
                       (TRANSLATE-PIXEL-TO-UNIT Y))
               (SETF (SEND OBJECT WHICH-POINT-X-METHOD) NEW-X)
               (SETF (SEND OBJECT WHICH-POINT-Y-METHOD) NEW-Y)
               (WHEN CONTROL-POINT-UNSPECIFIED
                 (SETF (SEND OBJECT :CONTROL-X) NEW-X)
                 (SETF (SEND OBJECT :CONTROL-Y) NEW-Y))
               (SEND SELF :WRITE-OBJECT-STATUS OBJECT)
               (DRAW-SPLINE-OBJECT OBJECT W:ALU-XOR)))
         ;; If an endpoint was previously specified then move the mouse there.
         (IF (SEND OBJECT WHICH-POINT-X-METHOD)
             (TRANSLATE-UNIT-TO-PIXEL (SEND OBJECT WHICH-POINT-X-METHOD))
             ;;1ELSE*
             NIL)
         (IF (SEND OBJECT WHICH-POINT-Y-METHOD)
             (TRANSLATE-Y-UNIT-TO-PIXEL (SEND OBJECT WHICH-POINT-Y-METHOD))
             ;;1ELSE*
             NIL))
       (SETQ USER-INPUT (READ-MOUSE-XY-INPUT))
       ;; Turn off rubberbanding.
       (SEND SELF :TURN-OFF-RUBBERBAND)
       (IF USER-INPUT
           (PROGN
             ;; Draw the object with a IOR alu after we have finished specifying the length.
             (SEND OBJECT :DRAW SELF)
             T)
           ;;ELSE
           (PROGN
             ;; Set the spline back the way it was.
             (SETF (SEND OBJECT WHICH-POINT-X-METHOD) OLD-X)
             (SETF (SEND OBJECT WHICH-POINT-Y-METHOD) OLD-Y)
             NIL))))))

(DEFCONSTANT SPLINE-ACTION-ITEM-LIST
#| 1 |#      '(("Pick start point" :VALUE PICK-SPLINE-POINT
                :DOCUMENTATION "Pick a start point of the spline via the mouse.")
#| 2 |#        ("Pick end point" :VALUE PICK-SPLINE-END-POINT
                :DOCUMENTATION "Pick an end point of the spline via the mouse.")
#| 3 |#        ("Pick middle point" :VALUE PICK-SPLINE-CONTROL-POINT
                :DOCUMENTATION "Pick a middle point of the spline via the mouse.")
#| 4 |#        ("Spline thickness" :VALUE GET-LINE-THICKNESS :DOCUMENTATION "Specify spline thickness")
#| 5 |#        ("Abort" :VALUE :ABORT
                :DOCUMENTATION "Quit without specifying a spline.")
#| 6 |#        ("Done" :VALUE :DONE
                :DOCUMENTATION "Click here when you are done specifying a spline."))
  "Menu item-list through which a user specifies a spline.")

(DEFCONSTANT SPLINE-ITEM-SEQUENCING
             (GENERATE-ACTION-ITEM-SEQUENCE SPLINE-ACTION-ITEM-LIST
               '((NIL 1) (1 2) (2 3) (3 6) (4 6))))

(DEFUN DRAW-SPLINE (&OPTIONAL (OLD-OBJECT NIL))
  "Handles all interaction for drawing a spline."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (LET ((OBJECT NIL))
    (IF OLD-OBJECT
        (SETQ OBJECT OLD-OBJECT)
        ;;1ELSE*
        (SETQ OBJECT (MAKE-INSTANCE 'SPLINE-OBJECT :PORTABLE-OBJECT NIL)))
    (IF (GET-OBJECT-DATA OBJECT SPLINE-ACTION-ITEM-LIST "Specify a spline" SPLINE-ITEM-SEQUENCING)
        (LET ((X0      (SEND OBJECT :X-POSITION))
              (Y0      (SEND OBJECT :Y-POSITION))
              (X1      (SEND OBJECT :END-X-POSITION))
              (Y1      (SEND OBJECT :END-Y-POSITION))
              (CX      (SEND OBJECT :CONTROL-X))
              (CY      (SEND OBJECT :CONTROL-Y)))
          (IF (OR (NULL X0) (NULL Y0) (NULL X1) (NULL Y1) (NULL CX) (NULL CY))
              ;; The spline needs to have all of its components specified.
              (PICTURE-ERROR "The ~a component of the spline must be specified."
                             (COND ((NULL X0) "starting X position")
                                   ((NULL Y0) "starting Y position")
                                   ((NULL X1) "ending X position")
                                   ((NULL Y1) "ending Y position")
                                   ((NULL CX) "middle X position")
                                   ((NULL CY) "middle Y position")))
              ;;1ELSE*
              (PROGN
                (MULTIPLE-VALUE-BIND (LEFT TOP RIGHT BOTTOM)
                    (SEND OBJECT :OBJECT-LIMITS SELF)
                  (SETQ MAXIMUM-X-UNIT (MAX MAXIMUM-X-UNIT RIGHT )
                        MINIMUM-X-UNIT (MIN MINIMUM-X-UNIT LEFT  )
                        MAXIMUM-Y-UNIT (MAX MAXIMUM-Y-UNIT TOP   )
                        MINIMUM-Y-UNIT (MIN MINIMUM-Y-UNIT BOTTOM)))
		(WHEN (NULL OLD-OBJECT)
		  (PUSH OBJECT DISPLAY-LIST)))))
        ;;1ELSE*
        ;; See if enough of the object's parameters were entered for it to be displayed.
        (WHEN (AND (SEND OBJECT :X-POSITION)
                   (SEND OBJECT :Y-POSITION)
                   (SEND OBJECT :END-X-POSITION)
                   (SEND OBJECT :END-Y-POSITION)
                   (SEND OBJECT :CONTROL-X)
                   (SEND OBJECT :CONTROL-Y))
          ;; Don't XOR the object if the user aborted out of the menu for an existing object.
          (WHEN (NULL OLD-OBJECT)
            (SEND OBJECT :DRAW SELF W:ALU-XOR))))))