scene.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")


;;; Scene Class Definition:


;Type: scene-position



;Function: make-scene
;  Return a new scene object with no elements.

(defun make-scene (&key  elements gstate parent (sensitivity :editable) transform plist view edge-gstate)
   (FUNCALL  #'make-instance 'scene
	  :scene-view view
	  :gstate gstate
	  :edge-gstate edge-gstate
	  :scene-parent parent
	  :sensitivity sensitivity
	  :transform transform
	  :plist plist
	  :elements elements
	  )
  )

(DEFMETHOD initialize-instance :after ((scene scene) &key elements scene-view scene-parent)
  (with-slots (views (scene-elements elements)) scene
    (WHEN scene-parent (SETF (graphic-parent scene) scene-parent))
    (WHEN views (SETF views (LIST scene-view)))
    (WHEN elements
      (DOTIMES (pos (LENGTH elements))
	(scene-insert scene (ELT elements pos))
	))))



;Method: draw-graphic
;  Draw the SCENE 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.
;  For scenes, just draw each of the child graphics.

(defmethod draw-graphic-clipped ((scene scene) (view view)
                           min-x min-y width height)
  (declare (type (or null wcoord) min-x min-y width height))
  (with-slots (elements extent) scene
    (WHEN (visible-p scene)
	(graphic-world-transform scene)	; Cache our transform
	(DOTIMES (position (length elements))
	  (draw-graphic-clipped (ELT elements position) view min-x min-y width height)
	  ))))

(defmethod draw-graphic ((scene scene) (view view)
                           &optional min-x min-y width height)
  (declare (type (or null wcoord) min-x min-y width height))
  (with-slots (elements extent) scene
    (WHEN (visible-p scene)
	(graphic-world-transform scene)	; Cache our transform
	(DOTIMES (position (length elements))
	  (draw-graphic (ELT elements position) view min-x min-y width height)
	  ))))




;Method: normalize-graphic
;  Normalize the SCENE by applying its transform and then calling
;  normalize-graphic on each of its children.
;  Nothing of value is returned.

(defmethod normalize-graphic :before ((scene scene))

  (with-slots ((parent-transform transform) elements) scene
    (WHEN (/= (FILL-POINTER elements) 0)                    ;ignore if no elements
      (DOTIMES (position (length elements))
	(LET ((graphic (aref elements position)))
	  (with-slots ((child-transform transform)) graphic
	    (setf child-transform
		  (compose-transform child-transform
				     parent-transform
				     child-transform)))
	  (normalize-graphic graphic))))))





;Method: extent-compute
;  Compute the extent rectangle for the SCENE.  This is done by combining the extents
;  of each of the elements in SCENE and then applying the SCENE's transform to the
;  resulting extent.

(DEFMETHOD extent-compute ((scene scene))
;(DEFUN scene-extent-compute (scene)

  (with-slots (elements) scene
    (IF (/= (FILL-POINTER elements) 0)					; Is this an empty scene?
      (let ((first-child-extent ; No, get the first child's extent
	      (DOTIMES (position (length elements))		; For all the other children...
              (WHEN (valid-extent-p (graphic-extent (aref elements position)))
		 (RETURN (graphic-extent (aref elements position)) )))
              ))
        (if first-child-extent			; Is it defined?
          (let ((temp-extent				; Yes, make a copy in a temp
                  (extent-copy first-child-extent
                               (make-extent-rect))))
            (DOTIMES (position (length elements))		; For all the other children...
	      (WHEN (valid-extent-p (graphic-extent (aref elements position)))
		(extent-combine (graphic-extent (aref elements position))	;  Combine their extents
                              temp-extent)))
            (extent-transform (graphic-transform scene)	; Apply our transform to the result
                              temp-extent
                              temp-extent)
            temp-extent)
	  )
	)
      (make-extent-rect :xmin 0 :ymin 0 :xmax 0 :ymax 0))))


;Method: scene-delete
;  If POS is 0 or nil, the first or last object in the SCENE is
;  deleted.  If POS is a graphic, then that graphic is deleted.
;  The deleted graphic is returned with its parent slot set to nil.

(defmethod scene-delete ((scene scene) pos)
  (declare (type scene-position pos))

  (extent-changed scene)
  (with-slots (elements) scene                                  ;from a scene
    (when elements
      (let ((dead-graphic					; Remember who was killed
              (case pos
                (nil
		 (UNLESS (EQL (FILL-POINTER elements) 0)
		  (LET ((graphic (AREF elements (- (length elements) 1))))
		    (SETF (FILL-POINTER elements)	; Delete last graphic
			  (- (FILL-POINTER elements ) 1))
		    graphic)))

                (t
		 (LET* ((realpos  (OR (POSITION pos elements) pos))
			(graphic (WHEN (NUMBERP realpos) (AREF elements realpos)))
		       )
		   (WHEN (NUMBERP realpos)
		     (DO ((position (+ 1 realpos)(+ 1 position)))      ; Delete the given graphic or position
			 ((eq position (length elements)) nil)
		       (SETF (aref elements (- position 1))(aref elements position)))
		     (SETF (FILL-POINTER elements)(- (FILL-POINTER elements) 1))
		     graphic
		     )))
		)))
        (when dead-graphic					; If we killed something,
          (graphic-stack-purge *transform-stack* dead-graphic)	; Notify the transform stack
          (graphic-stack-purge *gstate-stack* dead-graphic)
	  (graphic-stack-purge *edge-gstate-stack* dead-graphic); Notify the gstate stack
          (setf (slot-value dead-graphic 'parent) nil))		; Clear its parent slot

        dead-graphic))))					; Return the dead guy


;Method: scene-elements
;  Return the list of elements contained by SCENE.

(defmethod scene-elements ((scene scene))


  (slot-value scene 'elements))

(DEFMETHOD (SETF scene-elements) (element-seq (scene scene))
  (with-slots (elements) scene
    (SETF (FILL-POINTER elements) 0)
    (WHEN element-seq
      (DOTIMES (pos (LENGTH element-seq))
	(scene-insert scene (ELT element-seq pos))
	)))
  element-seq)

;Method: scene-insert
;  Inserts the GRAPHIC at the given POSITION in the SCENE.  If POSITION is a
;  graphic, then GRAPHIC is inserted immediately after it.  If POSITION is :FIRST
;  or :LAST, then GRAPHIC is inserted at the beginning or the end of the elements
;  list respectively.  The parent slot of GRAPHIC is changed to point to SCENE
;  and the GRAPHIC is returned.

(defmethod scene-insert ((scene scene) (graphic graphic) &optional pos )
  (extent-changed scene)
  (WHEN (graphic-parent graphic)
    (scene-delete (graphic-parent graphic) graphic))	;if there is a parent remove from the elements list of that parent
  (SETF (graphic-gstate graphic) (combine-into (graphic-combined-gstate scene) (graphic-gstate graphic)))
  (with-slots (elements parent) scene		;to a scene
    (case pos
      (nil
       (VECTOR-PUSH-EXTEND graphic elements 5)	;insert after last graphic
       )

      (t
       (LET* ((realpos  (OR (POSITION pos elements) pos ))
	      )
	 (WHEN  (NUMBERP realpos)
	   (VECTOR-PUSH-EXTEND 0 elements 5)	;make sure the vector is long enough
						; insert at position of the given graphic or position
	   (DO ((position (1- (length elements)) (1- position)))
	       ((eq position realpos) nil)
	     (SETF (aref elements position)(aref elements (- position 1))))
	   (SETF (aref elements realpos) graphic)
	   )))
      )
    )
  (setf (slot-value graphic 'parent) scene)	; Set its new parent
  graphic)					; Return the inserted graphic


(defmethod scene-insert ((scene scene) (graphic scene) &optional pos )
  (extent-changed scene)
  (UNLESS (EQL   scene graphic)
    (WHEN (graphic-parent graphic)
      (scene-delete (graphic-parent graphic) graphic))	;if there is a parent remove from the elements list of that parent
    (SETF (graphic-gstate graphic) (combine-into (graphic-combined-gstate scene) (graphic-gstate graphic)))
    (with-vector temp-elements
      (copy-to-vector (scene-elements graphic) temp-elements)
      (setf (scene-elements graphic) temp-elements))

    (with-slots (elements parent) scene		;to a scene
      (case pos
	(nil
	 (VECTOR-PUSH-EXTEND graphic elements 5)	;insert after last graphic
	 )

	(t
	 (LET* ((realpos  (OR (POSITION pos elements) pos ))
		)
	   (WHEN  (NUMBERP realpos)
	     (VECTOR-PUSH-EXTEND 0 elements 5)	;make sure the vector is long enough
						; insert at position of the given graphic or position
	     (DO ((position (1- (length elements)) (1- position)))
		 ((eq position realpos) nil)
	       (SETF (aref elements position)(aref elements (- position 1))))
	     (SETF (aref elements realpos) graphic)
	     ))))
      )

    (setf (slot-value graphic 'parent) scene))			; Set its new parent
  graphic)

							; Return the inserted graphic


;Method: scene-reparent
;  Move each of the ELEMENTS into the SCENE.
;  Return the new parent scene.

(defmethod scene-reparent ((scene scene) new-parent &rest elements)
  (declare (type list elements))
  (extent-changed scene)
  (with-vector children
	       (copy-to-vector (scene-elements scene) children)
	       (MAP nil #'(lambda (child) (scene-insert new-parent child)) children))
  (dolist (child elements)				; Go through the list
    (scene-insert new-parent child))			; Add it to the new scene
  scene)						; Return the scene now containing graphic




;Method: scene-ungroup
;  Reparent all elements of SCENE to the parent of SCENE.
;  Delete SCENE from its parent.

(defmethod scene-ungroup ((scene scene))
  (extent-changed scene)
  (with-slots (elements) scene
    (let ((grand-parent (graphic-parent scene)))
      (if grand-parent					; Is there a grand parent?
          (prog1
            (scene-reparent scene grand-parent )	; Yes, make it the parent
            (scene-delete grand-parent scene))	;  and delete the scene
	  (with-vector children
	       (copy-to-vector (scene-elements scene) children)
	       (MAP nil #'(lambda (child) (scene-delete scene child)) children))
	  ))))		;  i.e., they have no parent


(DEFMETHOD scene-graphic ((scene scene) position)
  (with-slots (elements) scene
    (WHEN (< position (FILL-POINTER elements))
      (AREF elements position))))


(DEFMETHOD scene-restack ((scene scene) old-position new-position)

  (LET ((graphic (scene-delete scene old-position)))
    (scene-insert scene graphic new-position)))