;;;-*- 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
;;; -------------------------------------------------------------------------------------
;;; 10/11/88    TWE	Added extra argument to :WRITE-LATEX. 
;;;  6/15/88    TWE	Fixed drawing to copy the object to the picture window when the
;;;			user has specified enough parameters (instead of XORing the
;;;			object and interfering with other objects).  This keeps the user
;;;			from having to refresh the screen so often.
;;; 10/15/87    TWE	Fixed the error checking to allow for a width with a zero value
;;;			for the height, and flag that as an error.
;;;  9/29/87    TWE	Fixed ovals to handle negative dimensions.
;;;  8/31/87    TWE	Fixed the drawing primitive to calculate the radius properly.
;;;			Previously, it used MAX-HOLLOW-CIRCLE-DIAMETER as a radius.  Now
;;;			it divides it by 2.
;;;  7/17/87    TWE	Fixed up so that the user can see the coordinate being specified
;;;			when a single point is specified.
;;;  6/29/87    TWE	Fixed up the argument VARIABLE to be CVV-VARIABLE to get around
;;;			a compiler warning message.  Also added the support for
;;;			MINIMUM-X/Y to make the picture only as big as the user makes it.
;;;  6/22/87    TWE	Fixed it up so that it would work.
;;;  6/21/86	TWE	Initial creation.


#|

This file defines code to handle ovals.

|#

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

(DEFMETHOD (OVAL-OBJECT :TRANSLATE-UNITS) (NEW-OVER-OLD X-ORIGIN Y-ORIGIN)
  (SETQ WIDTH      (* NEW-OVER-OLD WIDTH)
	HEIGHT     (* NEW-OVER-OLD HEIGHT)
        X-POSITION (+ (* NEW-OVER-OLD (- X-POSITION X-ORIGIN)) X-ORIGIN)
        Y-POSITION (+ (* NEW-OVER-OLD (- Y-POSITION Y-ORIGIN)) Y-ORIGIN)))

(DEFCONSTANT OVAL-CORNER-MOUSE-DOCUMENTATION
             '(:MOUSE-L-1 "Pick the bottom left corner of the oval"
               :MOUSE-M-1 "Abort out of this operation"))

(DEFUN PICK-OVAL-POINT (OBJECT)
  "Pick an (X,Y) point for an oval via the mouse."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (IF (AND (SEND OBJECT :X-POSITION)
	   (SEND OBJECT :WIDTH))
      ;; The user has already specified the position.  All
      ;; that is being done now is to change the position.
      (MOVE-OVAL OBJECT)
      ;;1ELSE*
      (MULTIPLE-VALUE-BIND (NEW-X NEW-Y)
          ;; The eye glasses were chosen because no other glyph came
          ;; close to representing an oval.  In fact, the eye glases
          ;; were the only closed shape which had rounded corners.
          (MOUSE-SPECIFY-POINT OBJECT W:MOUSE-GLYPH-EYE-GLASSES
                               OVAL-CORNER-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))
              ;; Only draw the oval when the size has been specified.
              (WHEN (SEND OBJECT :WIDTH)
                (SEND OBJECT :DRAW SELF))
              T)
            ;;1ELSE*
            NIL))))

(DEFUN MOVE-OVAL (OBJECT)
  "Use the mouse to move an oval to a new location."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (COND ((NULL (SEND OBJECT :X-POSITION))
         (PICTURE-ERROR "A corner position is not specified yet.")
         T)
        ((NULL (SEND OBJECT :WIDTH))
         (PICTURE-ERROR "A size is not specified yet.")
         T)
        (T
         (LET ((OLD-X-POSITION (SEND OBJECT :X-POSITION))
               (OLD-Y-POSITION (SEND OBJECT :Y-POSITION))
               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))
			 (SETF (SEND OBJECT :X-POSITION) X-UNIT)
			 (SETF (SEND OBJECT :Y-POSITION) Y-UNIT))
		     (SEND SELF :WRITE-OBJECT-STATUS OBJECT)
		     (DRAW-OVAL-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
               (PROGN
                 ;; Draw the object with a IOR alu after we have finished moving it.
                 (SEND OBJECT :DRAW SELF)
                 T)
               ;;1ELSE*
               (PROGN
                 ;; Set the oval 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)
                 (SEND OBJECT :DRAW SELF W:ALU-XOR)
                 NIL))))))

(DEFUN RUBBER-BAND-OVAL (OBJECT)
  "Use the mouse to specify the size of an oval."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (IF (NULL (SEND OBJECT :X-POSITION))
      (PICTURE-ERROR "A corner position is not specified yet.")
      ;;ELSE
      (LET* ((OLD-WIDTH    (SEND OBJECT :WIDTH))
	     (OLD-HEIGHT   (SEND OBJECT :HEIGHT))
             (X-POSITION   (SEND OBJECT :X-POSITION))
             (Y-POSITION   (SEND OBJECT :Y-POSITION))
             (OLD-X-PIXEL-POSITION (TRANSLATE-X-UNIT-TO-PIXEL X-POSITION))
             (OLD-Y-PIXEL-POSITION (TRANSLATE-Y-UNIT-TO-PIXEL Y-POSITION))
             USER-INPUT)
        (SEND SELF :TURN-ON-RUBBERBAND
	      #'(LAMBDA (X Y)
                  (MULTIPLE-VALUE-BIND (NEW-WIDTH NEW-HEIGHT)
                      (SEND SELF :GRIDIFY-MEASURE
			    (- (TRANSLATE-PIXEL-TO-UNIT X) X-POSITION)
			    (- Y-POSITION (TRANSLATE-PIXEL-TO-UNIT Y)))
                    (SETF (SEND OBJECT :WIDTH ) NEW-WIDTH)
                    (SETF (SEND OBJECT :HEIGHT) NEW-HEIGHT)
                    (SEND SELF :WRITE-OBJECT-STATUS OBJECT)
                    (DRAW-OVAL-OBJECT OBJECT W:ALU-XOR)))
              (IF OLD-WIDTH
                  (+ (TRANSLATE-UNIT-TO-PIXEL OLD-WIDTH) OLD-X-PIXEL-POSITION)
                  ;;1ELSE*
                  NIL)
              (IF OLD-HEIGHT
                  (+ (TRANSLATE-UNIT-TO-PIXEL OLD-HEIGHT) OLD-Y-PIXEL-POSITION)
                  ;;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 sizing it.
              (SEND OBJECT :DRAW SELF)
              T)
            ;;ELSE
            (PROGN
              ;; Erase the object from the screen.
              (SEND OBJECT :DRAW SELF W:ALU-XOR)
              (WHEN OLD-WIDTH
                ;; Set the object back the way it was.
                (SETF (SEND OBJECT :WIDTH ) OLD-WIDTH)
                (SETF (SEND OBJECT :HEIGHT) OLD-HEIGHT)
                (SEND OBJECT :DRAW SELF))
              NIL)))))

(DEFUN GET-OVAL-SIZE-DATA (OBJECT)
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  "Get the exact dimensions of the object from the user."
  (LET ((OBJECT-WIDTH  (IF (ZEROP (SEND OBJECT :WIDTH )) 2.0 (SEND OBJECT :WIDTH )))
	(OBJECT-HEIGHT (IF (ZEROP (SEND OBJECT :HEIGHT)) 2.0 (SEND OBJECT :HEIGHT)))
        (PICTURE-BASE-UNIT BASE-UNIT))
    (FLET ((VALIDATE-WIDTH (WINDOW CVV-VARIABLE OLD-VALUE NEW-VALUE)
                           (DECLARE (IGNORE WINDOW CVV-VARIABLE OLD-VALUE))
                           (VALIDATE-PAGE-WIDTH NEW-VALUE PICTURE-BASE-UNIT))
	   (VALIDATE-HEIGHT (WINDOW CVV-VARIABLE OLD-VALUE NEW-VALUE)
                            (DECLARE (IGNORE WINDOW CVV-VARIABLE OLD-VALUE))
                            (VALIDATE-PAGE-HEIGHT NEW-VALUE PICTURE-BASE-UNIT)))
      (CONDITION-CASE ()
          (W:CHOOSE-VARIABLE-VALUES
           `((,(LOCF OBJECT-WIDTH)  "Width"  :CONSTRAINT ,#'VALIDATE-WIDTH
              :DOCUMENTATION "Width of the oval.")
             (,(LOCF OBJECT-HEIGHT) "Height" :CONSTRAINT ,#'VALIDATE-HEIGHT
              :DOCUMENTATION "Height of the oval."))
           :MARGIN-CHOICES '("Do It"
                             ("Abort" (SIGNAL-CONDITION EH:ABORT-OBJECT)))
           :LABEL (FORMAT NIL "Enter size for an oval in ~a"
                          (GET 'UNIT-NAME-STRING PICTURE-BASE-UNIT)))
        (EH:ABORT (SETQ OBJECT-WIDTH NIL))))
    (IF OBJECT-WIDTH
        (PROGN
          (WHEN (SEND OBJECT :X-POSITION)
            ;; Erase the oval only if it is there.
            (SEND OBJECT :DRAW SELF W:ALU-XOR))
          (SETF (SEND OBJECT :WIDTH ) OBJECT-WIDTH)
          (SETF (SEND OBJECT :HEIGHT) OBJECT-HEIGHT)
          ;; If the corner position hasn't been specified then don't draw the oval.
          (WHEN (SEND OBJECT :X-POSITION)
            (SEND OBJECT :DRAW SELF))
          T)
      ;;ELSE
      NIL)))

;;; Primitive which just draws an oval on a window.
(DEFUN SIMPLE-DRAW-OVAL (WINDOW X Y WIDTH HEIGHT &OPTIONAL (ALU W:ALU-IOR) (THICKNESS 1))
  ;; Don't error out when the area of the oval is zero.
  (WHEN (AND (NOT (ZEROP WIDTH)) (NOT (ZEROP HEIGHT)))
    ;; Handle negative oval dimensions.
    (WHEN (MINUSP WIDTH)
      (SETQ WIDTH (- WIDTH))
      (DECF X WIDTH))
    (WHEN (MINUSP HEIGHT)
      (SETQ HEIGHT (- HEIGHT))
      (DECF Y HEIGHT))
    (LET ((RADIUS (MIN (TRUNCATE WIDTH 2) (TRUNCATE HEIGHT 2)
                       (TRUNCATE MAX-HOLLOW-CIRCLE-DIAMETER 2))))
      (SETQ THICKNESS (TRUNCATE THICKNESS 2))
      ;; Need to calculate the end points first.  The following oval shows
      ;; what each of the things being computed in the following LET
      ;; represents.  Also shown are the compass points used when drawing
      ;; the oval's corners.
      ;;
      ;;  NW                 NE
      ;;      
      ;;        X1    X2   OUTER-X
      ;;        v      v   v
      ;;       .--------.
      ;;      '          `
      ;;     '            `
      ;;    |              |<Y1
      ;;    |              |
      ;;    |              |
      ;;    |              |
      ;;    |              |<Y2
      ;;    `.            .'
      ;;      `.________.'  < OUTER-Y
      ;;
      ;;  SW                 SE
      (LET ((X1 (+ X RADIUS))
            (Y1 (+ Y RADIUS))
            (X2 (- (+ X WIDTH ) RADIUS))
            (Y2 (- (+ Y HEIGHT) RADIUS))
            (OUTER-X  (+ X WIDTH))
            (OUTER-Y  (+ Y HEIGHT)))
        (SIMPLE-DRAW-CORNER WINDOW X2 Y1 RADIUS :NE ALU THICKNESS)
        (SEND WINDOW :DRAW-LINE X1 Y X2 Y THICKNESS W:BLACK ALU)       ; Top line
        (SIMPLE-DRAW-CORNER WINDOW X1 Y1 RADIUS :NW ALU THICKNESS)
        (SEND WINDOW :DRAW-LINE X Y1 X Y2 THICKNESS W:BLACK ALU)       ; Left line
        (SIMPLE-DRAW-CORNER WINDOW X1 Y2 RADIUS :SW ALU THICKNESS)
        (SEND WINDOW :DRAW-LINE X1 OUTER-Y X2 OUTER-Y THICKNESS W:BLACK ALU)   ; Bottom line
        (SIMPLE-DRAW-CORNER WINDOW X2 Y2 RADIUS :SE ALU THICKNESS)
        (SEND WINDOW :DRAW-LINE OUTER-X Y1 OUTER-X Y2 THICKNESS W:BLACK ALU)   ; Right line
        ))))

(DEFMETHOD (OVAL-OBJECT :WRITE-LATEX) (LATEX-STREAM TEXIFY)
  "2Write the description of this object to a LaTeX file.*"
  (DECLARE (IGNORE TEXIFY))
  (FORMAT LATEX-STREAM "\\put(~F,~F){\\oval(~F,~F)}~%"
          ;; For LaTeX, the (X,Y) position is in the center of the oval.  Internally we
          ;; have the (X,Y) position being the upper left corner so that when the grid
          ;; is turned on we will be positioned to a meaningful point.  In this way, when
          ;; ovals are combined with lines or vectors, the alignment will be correct.
          (+ X-POSITION (/ WIDTH  2.0))
          (- Y-POSITION (/ HEIGHT 2.0)) WIDTH HEIGHT))

(DEFMETHOD (OVAL-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:OVAL-OBJECT ~
                                         :X-POSITION ~D :Y-POSITION ~D ~
                                         :WIDTH ~D :HEIGHT ~D)~%"
          X-POSITION Y-POSITION WIDTH HEIGHT))

(DEFUN DRAW-OVAL-OBJECT (OBJECT &OPTIONAL (ALU W:CHAR-ALUF))
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (LET ((PIXEL-WIDTH  (TRANSLATE-UNIT-TO-PIXEL   (SEND OBJECT :WIDTH)))
	(PIXEL-HEIGHT (TRANSLATE-UNIT-TO-PIXEL   (SEND OBJECT :HEIGHT)))
        (PIXEL-X      (TRANSLATE-X-UNIT-TO-PIXEL (SEND OBJECT :X-POSITION)))
        (PIXEL-Y      (TRANSLATE-Y-UNIT-TO-PIXEL (SEND OBJECT :Y-POSITION))))
    ;; 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.
    (SIMPLE-DRAW-OVAL SELF PIXEL-X PIXEL-Y PIXEL-WIDTH PIXEL-HEIGHT ALU LINE-THICKNESS)))

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

(DEFMETHOD (OVAL-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.
If the point (X,Y) is inside of the object then 0.0 is returned."
  (DECLARE (IGNORE WINDOW))
  (DISTANCE-FROM-BOX X Y X-POSITION Y-POSITION
                     (+ X-POSITION WIDTH) (- Y-POSITION HEIGHT)))

(DEFMETHOD (OVAL-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))
  ;; Note that the (X,Y) position of the box is the upper left corner.
  ;; This makes the maximum Y value of the box the Y-POSITION.
  (VALUES X-POSITION Y-POSITION (+ X-POSITION WIDTH) (- Y-POSITION HEIGHT)))

(DEFMETHOD (OVAL-OBJECT :NAME) ()
  "Return a string which identifies the object."
  (FORMAT NIL "Oval at (~D,~D) with width ~D and height ~D"
          X-POSITION Y-POSITION WIDTH HEIGHT))

(DEFMETHOD (OVAL-OBJECT :SHORT-NAME) ()
  "Return a narrow string which identifies the object."
  (FORMAT NIL "Oval ~
              ~:[~2*~;at ~%(~,2F,~,2F)~]~
              ~:[~*~;~%Width=~D~]~
              ~:[~*~;~%Height=~D~]"
          X-POSITION X-POSITION Y-POSITION (NOT (ZEROP WIDTH)) WIDTH (NOT (ZEROP HEIGHT)) HEIGHT))

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

(DEFMETHOD (OVAL-OBJECT :REPLICATE) ()
  "2Make a copy of this object.*"
  (MAKE-INSTANCE 'OVAL-OBJECT
                 :X-POSITION X-POSITION
                 :Y-POSITION Y-POSITION
                 :WIDTH WIDTH :HEIGHT HEIGHT))

(DEFCONSTANT OVAL-ACTION-ITEM-LIST
             '(("Pick a corner" :VALUE PICK-OVAL-POINT
                :DOCUMENTATION "Pick the bottom left corner of the oval.")
               ("Oval size" :BUTTONS ((NIL :VALUE RUBBER-BAND-OVAL)
                                     ()
                                     (NIL :VALUE GET-OVAL-SIZE-DATA))
                :DOCUMENTATION (:MOUSE-L-1 "Specify oval size using the mouse"
                                :MOUSE-R-1 "Enter the oval size using the keyboard"))
               ("Abort" :VALUE :ABORT
                :DOCUMENTATION "Quit without specifying an oval.")
               ("Done" :VALUE :DONE
                :DOCUMENTATION "Click here when you are done specifying an oval."))
  "Menu item-list through which a user specifies an oval.")

(DEFCONSTANT OVAL-ITEM-SEQUENCING
             (GENERATE-ACTION-ITEM-SEQUENCE OVAL-ACTION-ITEM-LIST
                                            '((NIL 1) (1 2) (2 4))))

(DEFUN DRAW-OVAL (&OPTIONAL (OLD-OBJECT NIL))
  "Handles all interaction for drawing an oval."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (LET ((OBJECT NIL))
    (IF OLD-OBJECT
        (SETQ OBJECT OLD-OBJECT)
        ;;1ELSE*
        (SETQ OBJECT (MAKE-INSTANCE 'OVAL-OBJECT)))
    (IF (GET-OBJECT-DATA OBJECT OVAL-ACTION-ITEM-LIST "Specify an oval"
                         OVAL-ITEM-SEQUENCING)
        (IF (OR (ZEROP (SEND OBJECT :WIDTH))
                (ZEROP (SEND OBJECT :HEIGHT))
                (NULL  (SEND OBJECT :X-POSITION))
                (NULL  (SEND OBJECT :Y-POSITION)))
            ;; The oval needs to have a size and a position.
            (PICTURE-ERROR "The ~a component of the oval must be specified."
                           (COND ((ZEROP (SEND OBJECT :WIDTH     )) "width")
				 ((ZEROP (SEND OBJECT :HEIGHT    )) "height")
                                 ((NULL  (SEND OBJECT :X-POSITION)) "initial corner")))
            ;;ELSE
            (PROGN
              (LET ((OBJECT-HEIGHT (SEND OBJECT :HEIGHT)))
                (WHEN (MINUSP OBJECT-HEIGHT)
                  (SETF (SEND OBJECT :HEIGHT) (- OBJECT-HEIGHT))
                  (DECF (SEND OBJECT :Y-POSITION) OBJECT-HEIGHT)))
              (LET ((OBJECT-WIDTH (SEND OBJECT :WIDTH)))
                (WHEN (MINUSP OBJECT-WIDTH)
                  (SETF (SEND OBJECT :WIDTH) (- OBJECT-WIDTH))
                  (INCF (SEND OBJECT :X-POSITION) OBJECT-WIDTH)))
              (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 (NOT (ZEROP (SEND OBJECT :WIDTH)))
                   (NOT (ZEROP (SEND OBJECT :HEIGHT)))
                   (SEND OBJECT :X-POSITION)
                   (SEND OBJECT :Y-POSITION))
          ;; 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))))))