;;;-*- 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") (defmethod handle-event ((view view) (event event)) "Do event translation based on the graphic event translations or the view event-translations slot." (declare (type event event)) (IF (eq :exposure (slot-value (the event event) 'key)) (IF (slot-boundp view 'x) (with-slots (x y width height) (the event event) (display view x y width height)) (display view)) ;; handle events (IF (NOT (GETF (slot-value view 'plist) :ignore-graphic-events)) (WHEN (slot-boundp event 'x) (with-slots (x y) event (UNLESS (AND x y ; is x,y a valid coordinate from the event (MULTIPLE-VALUE-BIND (world-x world-y) (view-untransform-point view x y) (or (graphic-action-p ; yes, is x,y in a grabber box? (graphic-pick (view-selection-scene view) ; yes, translate the event world-x world-y (view-pixel-size view)) event view) (graphic-action-p ; no, is x,y on a graphic? (graphic-pick (view-graphic view) world-x world-y (view-pixel-size view)) ;yes, is there an event translation? event view)))) ; yes, perform the event translation (call-next-method)))) (call-next-method))) t) (defun call-action-internal (contact action) (if (consp action) (apply (car action) contact (cdr action)) (funcall action contact))) (DEFUN graphic-action-p (graphic event view) "Return true if an action was executed for the graphic" (WHEN graphic ;Have a all of the graphic-parents been checked for actions ; or no graphic choosen? (LET ((actions (translate-graphic-event graphic event))) ; no, get the actions for the event from the graphic (WHEN actions ; are there any actions? (dolist (action actions t) ; yes, execute the actions (graphic-call-action graphic view action) (graphic-action-p (graphic-parent graphic) event view) ; no, look to the graphic-parent ))) ) ; yes, end the recursion and return nil ) (defun graphic-call-action (graphic contact action) (if (consp action) (apply (car action) graphic contact (cdr action)) (funcall action graphic contact))) (defgeneric graphic-pick (graphic x y &optional arpeture) (:documentation "Return the graphic if the world coordinate x,y is on the graphic or return nil") (DECLARE (VALUES graphic nil))) (DEFMETHOD graphic-pick ((graphic graphic) x y &optional (pixel 1)) (DECLARE (VALUES (type graphic))) (AND (NOT (EQ (graphic-sensitivity graphic) :viewable)) ; is the graphic not viewable or hidden? (NOT (EQ (graphic-sensitivity graphic) :hidden)) (graphic-contains-p graphic x y pixel) ; and the x,y coordinate on the graphic graphic)); yes, return the graphic (DEFMETHOD graphic-pick ((scene scene) x y &optional (pixel 1)) (UNLESS (OR (EQ (graphic-sensitivity scene) :viewable) ;is the scene viewable or hidden? (EQ (graphic-sensitivity scene) :hidden) (NOT (graphic-contains-p scene x y pixel)) ) (LET* ((elements (scene-elements scene)) (element-length (FILL-POINTER elements))) (WHEN (> element-length 0) ; no, is the scene empty? (DO* ((position (1- element-length)(1- position)) ) ((< position 0) ) ;no graphic in the scene is selected so return nil (LET ((graphic (graphic-pick (ELT elements position) x y pixel))) ; no, pick a graphic (WHEN graphic ; is there a picked graphic? (WHEN (OR (EQ (graphic-sensitivity scene) :selectable) ; yes, is the scene selectable or editable? (EQ (graphic-sensitivity scene) :editable)) (RETURN scene)) ; yes, return the scene (RETURN graphic)) ; no, return the graphic )))))) (DEFMETHOD graphic-pick ((scene grabber-rect) x y &optional (pixel 1)) (UNLESS (OR (EQ (graphic-sensitivity scene) :viewable) ;is the scene viewable or hidden? (EQ (graphic-sensitivity scene) :hidden) ) (LET* ((elements (scene-elements scene)) (element-length (FILL-POINTER elements))) (WHEN (> element-length 0) ; no, is the scene empty? (DO* ((position (1- element-length)(1- position)) ) ((< position 0) ) ;no graphic in the scene is selected so return nil (LET ((graphic (graphic-pick (ELT elements position) x y pixel))) ; no, pick a graphic (WHEN graphic ; is there a picked graphic? (WHEN (OR (EQ (graphic-sensitivity scene) :selectable) ; yes, is the scene selectable or editable? (EQ (graphic-sensitivity scene) :editable)) (RETURN scene)) ; yes, return the scene (RETURN graphic)) ; no, return the graphic )))))) (DEFMETHOD graphic-pick ((scene selection-scene) x y &optional (pixel 1)) (UNLESS (OR (EQ (graphic-sensitivity scene) :viewable) ;is the scene viewable or hidden? (EQ (graphic-sensitivity scene) :hidden) ) (LET* ((elements (scene-elements scene)) (element-length (FILL-POINTER elements))) (WHEN (> element-length 0) ; no, is the scene empty? (DO* ((position (1- element-length)(1- position)) ) ((< position 0) ) ;no graphic in the scene is selected so return nil (LET ((graphic (graphic-pick (ELT elements position) x y pixel))) ; no, pick a graphic (WHEN graphic ; is there a picked graphic? (WHEN (OR (EQ (graphic-sensitivity scene) :selectable) ; yes, is the scene selectable or editable? (EQ (graphic-sensitivity scene) :editable)) (RETURN scene)) ; yes, return the scene (RETURN graphic)) ; no, return the graphic )))))) (defgeneric graphic-within (graphic x y width height ) (:documentation "Return the graphic if it is within the rectangle defined by X, Y, Width and Height or return nil. If a scene is subselectable a list of selectable graphics in the scene is returned.") (DECLARE (VALUES (OR graphic (LIST of graphics) nil)))) (DEFMETHOD graphic-within ((graphic graphic) x y width height) (DECLARE (VALUES (type graphic))) (AND (NOT (EQ (graphic-sensitivity graphic) :viewable)) ; is the graphic not viewable or hidden? (NOT (EQ (graphic-sensitivity graphic) :hidden)) (graphic-within-p graphic x y width height) ; and the graphic is within the rectangle graphic)) ; return the graphic (DEFMETHOD graphic-within ((scene scene) x y width height) (UNLESS (OR (EQ (graphic-sensitivity scene) :viewable) ; is the scene viewable or hidden? (EQ (graphic-sensitivity scene) :hidden)) (LET* ((elements (scene-elements scene)) (elements-length (FILL-POINTER elements)) selected) (WHEN (> elements-length 0) ; no, is the scene empty? (DO* ((position (1- elements-length) (1- position))) ;no, check for a picked graphic is the scene ((< position 0) ) ;when no graphic in the scene is selected return nil (LET ((graphic (graphic-within (ELT elements position) x y width height))) ; pick a graphic (WHEN graphic ; is there a picked graphic? (IF (ATOM graphic) ; yes, is it a atom (SETF selected (CONS graphic selected )); yes, add it to the selected list (SETF selected (APPEND graphic selected)) ; no, add each graphic in the list to the selected list )))) (VALUES (IF (OR (EQ (graphic-sensitivity scene) :selectable) ; is the scene selectable or editable? (EQ (graphic-sensitivity scene) :editable)) (WHEN selected scene) ; yes, return the scene selected)))))) ; no, return the graphic