rectangle.lisp

;;;-*- Mode:Common-Lisp; Package:PICTURES; Base:10 -*-
;;;
;;;
;;;
;;;			 TEXAS INSTRUMENTS INCORPORATED
;;;				  P.O. BOX 149149
;;;			       AUSTIN, TEXAS 78714-9149
;;;
;;; Copyright (C)1987,1988,1989,1990 Texas Instruments Incorporated.
;;;
;;; Permission is granted to any individual or institution to use, copy, modify,
;;; and distribute this software, provided that this complete copyright and
;;; permission notice is maintained, intact, in all copies and supporting
;;; documentation.
;;;
;;; Texas Instruments Incorporated provides this software "as is" without
;;; express or implied warranty.
;;;
;;; Authors: Delmar Hager, James Dutton, Teri Crowe
;;; Contributors: Kerry Kimbrough, Patrick Hogan, Eric Mielke

(in-package "PICTURES")


;Rectangle Class Definition:

(defclass pictures::rectangle (polygon)
  ()
  (:documentation "A  graphic that represents a rectangle in object coordinates."))


;Filled-Rectangle Class Definition:

(defclass filled-rectangle (  rectangle filled-polygon)
  ()
  (:documentation "Filled rectangle class in pictures"))


;Filled-Rectangle-Edge Class Definition:

(defclass filled-rectangle-edge (  rectangle filled-polygon-edge)
  ()
  (:documentation "Filled rectangle edge class in pictures"))



(defun make-rectangle (x-min y-min width height  &rest options )
  "Make a rectangle with the with the given X-MIN, Y-MIN, WIDTH and HEIGHT.
The following keyword OPTIONS are allowed: GSTATE PARENT SENESITIVITY TRANSFORM PLIST"
  (APPLY #'MAKE-INSTANCE 'rectangle
	 :point-seq (complete-rectangle x-min y-min (+ x-min width) (+ y-min height))
	 options))

(defun make-filled-rectangle (x-min y-min width height  &rest options )
  "Make a filled-rectangle with with the given X-MIN, Y-MIN, WIDTH and HEIGHT.
The following keyword OPTIONS are allowed: GSTATE PARENT SENESITIVITY TRANSFORM PLIST"
  (APPLY #'MAKE-INSTANCE 'filled-rectangle
	 :point-seq (complete-rectangle x-min y-min (+ x-min width) (+ y-min height))
	 options))

(defun make-filled-rectangle-edge (x-min y-min width height  &rest options )
  "Make a filled-rectangle-edge with the given X-MIN, Y-MIN, WIDTH and HEIGHT.
The following keyword OPTIONS are allowed: GSTATE PARENT SENESITIVITY TRANSFORM PLIST EDGE-GSTATE"
  (APPLY #'MAKE-INSTANCE 'filled-rectangle-edge
	 :point-seq (complete-rectangle x-min y-min (+ x-min width) (+ y-min height))
	 options))

; Graphic methods for rectangle graphics
(DEFMETHOD rectangle-origin-x ((rectangle rectangle))
  (vertex-x rectangle 0))

(DEFMETHOD (SETF rectangle-origin-x) (origin-x (rectangle rectangle) )
  (LET ((difference (- origin-x (vertex-x rectangle 0))))
    (extent-changed rectangle)
    (DOTIMES (pos 4 origin-x)
      (SETF (vertex-x rectangle pos) (+ difference (vertex-x rectangle pos)) ))))

(DEFMETHOD rectangle-origin-y ((rectangle rectangle))
  (vertex-y rectangle 0))

(DEFMETHOD (SETF rectangle-origin-y) (origin-y (rectangle rectangle) )
  (LET ((difference (- origin-y (vertex-y rectangle 0))))
    (extent-changed rectangle)
    (DOTIMES (pos 4 origin-y)
      (SETF (vertex-y rectangle pos) (+ difference (vertex-y rectangle pos)) ))))

(DEFMETHOD rectangle-width ((rectangle rectangle))
  (with-slots (vertices) rectangle
    (VALUES (distance
	      (vertex-x rectangle 0) (vertex-y rectangle 0) (vertex-x rectangle 1) (vertex-y rectangle 1)))))

(DEFMETHOD (SETF rectangle-width) (width (rectangle rectangle))
  (with-slots (vertices ) rectangle
    (extent-changed rectangle)
    (MULTIPLE-VALUE-BIND (x y dx dy) (compute-point (VERTEX-X RECTANGLE 0)(VERTEX-Y RECTANGLE 0)
						    (vertex-x rectangle 1)(vertex-y rectangle 1) width)
      (SETF (vertex-x rectangle 1) x)
      (SETF (vertex-y rectangle 1) y)
      (SETF (vertex-x rectangle 2) (+ (vertex-x rectangle 2) dx))
      (SETF (vertex-y rectangle 2) (+ (vertex-y rectangle 2) dy))))
  rectangle)

(DEFMETHOD rectangle-height ((rectangle rectangle))
  (with-slots (vertices ) rectangle
    (VALUES (distance
	     (vertex-x rectangle 0)
	     (vertex-y rectangle 0)
	     (vertex-x rectangle 3)
	     (vertex-y rectangle 3)))))

(DEFMETHOD (SETF rectangle-height) (height (rectangle rectangle))
  (with-slots (vertices ) rectangle
    (extent-changed rectangle)
    (MULTIPLE-VALUE-BIND (x y dx dy) (compute-point (VERTEX-X RECTANGLE 0)(VERTEX-Y RECTANGLE 0)
						    (vertex-x rectangle 3)(vertex-y rectangle 3) height)
      (SETF (vertex-x rectangle 3) x)
      (SETF (vertex-y rectangle 3) y)
      (SETF (vertex-x rectangle 2) (+ (vertex-x rectangle 2) dx))
      (SETF (vertex-y rectangle 2) (+ (vertex-y rectangle 2) dy)))
    rectangle))

(DEFMETHOD rectangle-size ((rectangle rectangle))
  (VALUES
    (distance
     (vertex-x rectangle 0)
     (vertex-y rectangle 0)
     (vertex-x rectangle 1)
     (vertex-y rectangle 1))
    (distance
     (vertex-x rectangle 0)
     (vertex-y rectangle 0)
     (vertex-x rectangle 3)
     (vertex-y rectangle 3))))

(DEFMETHOD normalize-graphic  :around ((rectangle rectangle))
  (with-slots (vertices transform) rectangle
    (extent-changed rectangle)
    (WHEN (AND transform (= (t12 transform)(t21 transform) 0))
      (with-slots (vertices transform) rectangle
	(transform-point-seq transform vertices)
	(SETF transform nil))
      )
    transform))

(DEFUN compute-point (x1 y1 x2 y2 distance)
  (LET* (x y)
    (IF (=  x1 x2)
	(VALUES x1 (+ y1 distance) 0 (- (+ y1 distance) y2 ))
	(progn
	  (SETF y (- y1 (* distance (SIN (ATAN (/ (- y1 y2)(- x1 x2)))))))
	  (SETF x (- x1 (* distance (COS  (ATAN (/ (- y1 y2)(- x1 x2)))))))
	  (VALUES x y (- x x2) (- y y2))))))

(DEFUN distance (x1 y1 x2 y2)
  "the distance between two points"
      (SQRT (+ (* (- x1 x2)(- x1 x2))(* (- y1 y2)(- y1 y2)))))

;; Draw the rectangle object in the given view. if min-x, min-y,
;; width, and height are given, then only parts of the object that lie
;; within the given rectangle need to be drawn.
(defmethod draw-graphic ((rectangle rectangle) (view view)
			 &optional min-x min-y width height)
  (declare (type (or null wcoord) min-x min-y width height))
  (with-slots (vertices extent transform) rectangle
    (WHEN (visible-p rectangle)
      (LET ((world-transform (graphic-world-transform rectangle)))
	(with-vector temp-vertices
	  (copy-to-vector vertices temp-vertices)
	  (transform-point-seq world-transform temp-vertices)
	  (if (AND world-transform (= (t12 world-transform)(t21 world-transform) 0))
	      (view-draw-rectangle view		; Yes, use draw-rectangle to draw it
				   (min-value-vector temp-vertices 0)
				   (min-value-vector temp-vertices 1)
				   (- (max-value-vector temp-vertices 0)(min-value-vector temp-vertices 0))
				   (- (max-value-vector temp-vertices 1)(min-value-vector temp-vertices 1))
				   (graphic-gstate rectangle))
	      (view-draw-polygon view		; No, use draw-polygon to draw it
				 temp-vertices
				 (graphic-gstate rectangle))
	      )
	  ))
      rectangle)))

;; Draw the filled-rectangle object in the given view. if min-x,
;; min-y, width, and height are given, then only parts of the object
;; that lie within the given rectangle need to be drawn.
(defmethod draw-graphic ((rectangle filled-rectangle) (view view)
			 &optional min-x min-y width height)
  (declare (type (or null wcoord) min-x min-y width height))
  (with-slots (vertices transform extent) rectangle
    (WHEN   (visible-p rectangle)
      (LET ((world-transform (graphic-world-transform rectangle)))
	(with-vector temp-vertices
	  (copy-to-vector vertices temp-vertices)
	  (transform-point-seq (graphic-world-transform rectangle) temp-vertices)
	  (if (AND world-transform (= (t12 world-transform)(t21 world-transform) 0))
	      (view-draw-filled-rectangle view	; Yes, use draw-rectangle to draw it
					  (min-value-vector temp-vertices 0)
					  (min-value-vector temp-vertices 1)
					  (- (max-value-vector temp-vertices 0)(min-value-vector temp-vertices 0))
					  (- (max-value-vector temp-vertices 1)(min-value-vector temp-vertices 1))
					  (graphic-gstate rectangle))
	      (view-draw-filled-polygon view	; No, use draw-polygon to draw it
					temp-vertices
					(graphic-gstate rectangle))))))))

;; Draw the FILLED-RECTANGLE-EDGE object by first drawing the interior
;; and then boundary. If MIN-X, MIN-Y, WIDTH, and HEIGHT are given,
;; then only parts of the object that lie within the given rectangle
;; need to be drawn.
(defmethod draw-graphic ((rectangle filled-rectangle-edge) (view view)
			 &optional min-x min-y width height)
  (declare (type (or null wcoord) min-x min-y width height))
  (with-slots (edge-gstate extent) rectangle
    (WHEN (visible-p rectangle)
      (LET ((world-transform (graphic-world-transform rectangle)))
	(with-slots (vertices transform) rectangle
	  (with-vector temp-vertices
	    (copy-to-vector vertices temp-vertices)
	    (transform-point-seq (graphic-world-transform rectangle) temp-vertices)
						; Yes, use draw-fillrectangle to  Draw the interior
	    (if (AND world-transform (= (t12 world-transform)(t21 world-transform) 0))
		(progn
		  (view-draw-filled-rectangle
		    view
		    (min-value-vector temp-vertices 0)
		    (min-value-vector temp-vertices 1)
		    (- (max-value-vector temp-vertices 0)(min-value-vector temp-vertices 0))
		    (- (max-value-vector temp-vertices 1)(min-value-vector temp-vertices 1))
		    (graphic-gstate rectangle))
						; Draw the boundary
		  (view-draw-rectangle
		    view
		    (min-value-vector temp-vertices 0)
		    (min-value-vector temp-vertices 1)
		    (- (max-value-vector temp-vertices 0)(min-value-vector temp-vertices 0))
		    (- (max-value-vector temp-vertices 1)(min-value-vector temp-vertices 1))
		    (edge-gstate rectangle)))
		(PROGN
		  (view-draw-filled-polygon view	; No, use draw-fillpolygon to draw the interior
					    temp-vertices
					    (graphic-gstate rectangle))
		  (view-draw-polygon view	; Draw the boundary
				     temp-vertices
				     (edge-gstate rectangle))))))))))

(defmethod scale-transform ((graphic rectangle) scale-x scale-y
                            &optional (fixed-x 0) (fixed-y 0))
  ;; Damage from old graphic
  (graphic-damage graphic)
  (with-slots (transform) graphic
    (UNLESS (AND transform (= (t12 transform)(t21 transform) 0))
      (COND
	((= scale-x 1) (SETF scale-x scale-y))
	((= scale-y 1) (SETF scale-y scale-x))
	((< scale-x scale-y)(SETF scale-x scale-y))
	(t (SETF  scale-y scale-x))))
    (when (null transform)				; If no transform
      (setf transform (make-transform)))		; Create one
    (graphic-stack-purge *transform-stack* graphic)	; Notify the transform stack
    (PROG1
	(scale-transform transform			; Scale it
			 scale-x scale-y fixed-x fixed-y)
      (extent-changed graphic))				; Notify graphic his extent may have changed
    (graphic-damage graphic)				; Damage from new graphic
    transform))


;; Private Method: complete-rectangle
;;  Compute and return the world coordinates of all four vertices of the given RECTANGLE.
;;  Also returns the X and Y lengths of the diagonal.
(defun complete-rectangle (x1 y1 x3 y3 &aux x2 y2 x4 y4)
  (PSETF  x2 x3
	  y2 y1
	  y4 y3
	  x4 x1)
  ;; X and Y lengths of the diagonal
  (VALUES (vector x1 y1 x2 y2 x3 y3 x4 y4)))

;; private method to determine if a rectangle is ortagonal
(DEFMETHOD orthogonal ((rectangle rectangle) (view view))
  (with-slots (vertices) rectangle
    (LET  ((x1 (VERTEX-X RECTANGLE 0) )
	   (y1 (VERTEX-Y RECTANGLE 0))
	   (x3 (vertex-x rectangle 2))
	   (y3 (vertex-y rectangle 2))
	   (epsilon	(view-pixel-size view)))	; World size of one pixel in this view
      (if (or (<= (abs (- x1 x3)) epsilon)	; Is rectangle orthogonal?
	      (<= (abs (- y1 y3)) epsilon))
	  t
	  nil))))


(DEFUN point-in-rectangle  (x y xmin ymin height width )
  "this function determines if a given point is within the extent bound of a graphic"
    (And (>= x xmin )
	       (<= x (+ xmin height))
	       (>= y ymin)
	       (<= y (+ ymin width))))