Developer CD Series 1994 June: Reference Library/Dev.CD Jun 94.toast/Periodicals/develop/develop Issue 5/develop 5 code/Lisp Mini-App/Program/draw-dialog-class.lisp

Text File | 1992-04-08 | 12.1 KB | 279 lines | [TEXT/CCL2]

#|
   draw-dialog-class.lisp

   Defines the DRAW-DIALOG class used in the Mini-Application
   sample program.

   For further info, see files "About Mini-App" and "Instructions".


   Copyright 1990, 1991 by Ruben Kleiman for Apple Computer, Inc.

   Change History.
   03-12-92 slm  Updated file header comments.
   03-10-92 slm  Create by Rectangle menu item checkmark is now
                 maintained by view-activate-event-handler. Note
                 that there is no change when another type of
                 window other than a draw-dialog is activated.
   03-08-92 slm  Changed class of draw-dialog from color-dialog to
                 dialog because color-dialog is superseded, and
                 want tutorial to run on B&W Macs.

|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Define DRAW-DIALOG class
;;;
;;;   This class is used to create windows on which we will build objects.
;;;   The window may be used under two main modes:
;;;
;;;            AUTHOR MODE -- It is possible to add objects to the window
;;;                           from the palette, look at object properties,
;;;                           and edit object scripts.
;;;
;;;            BROWSE MODE -- Only the regular script handlers are activated.
;;;
;;;   The slot browse-mode determines which mode the window is in (default: Author mode)
;;;
(defclass draw-dialog (window)
  ((my-items              :initform NIL)       ; List of all items in window
   (item-last-under-mouse :initform NIL)       ; Item currently under the mouse
   (browse-mode           :initform nil)       ; Mode in which window is being used (default = author)
   (selections            :initform nil)       ; Currently selected item(s)
   (create-by-rectangle   :initform nil))      ; Can draw-items be created by dragging out a rectangle?
  (:documentation "This class defines our windows"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; view-activate-event-handler [draw-dialog]
;;;
;;; This gets called by MCL whenever the window is about to be activated.
;;; We want to make sure that the Window Info... and Window Script menu items
;;; are activated when this window is in the front.
;;;
(defmethod view-activate-event-handler ((w draw-dialog))
  (menu-item-enable *window-object-info-menu-item*)
  (menu-item-enable *window-script-menu-item*)
  (set-menu-item-check-mark *create-by-rectangle-menu-item*
                            (slot-value w 'create-by-rectangle))
  (and (slot-value w 'selections)
       (set-menu-title *selected-object-menu-indicator*
                       (concatenate 'string "Selected:  "
                                    (slot-value (car (slot-value w 'selections)) 'name))))
  (call-next-method))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; view-deactivate-event-handler [draw-dialog]
;;;
;;; This gets called by MCL whenever the window is about to be deactivated.
;;; We want to make sure that the Window Info... and Window Script menu items
;;; are disabled when this window is no longer in the front.
;;;
(defmethod view-deactivate-event-handler ((w draw-dialog))
  (menu-item-disable *window-object-info-menu-item*)
  (menu-item-disable *window-script-menu-item*)
  (call-next-method))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; view-draw-contents [draw-dialog]
;;;
;;; This will draw the contents of the window in a back to front order
;;; using the list in the slot MY-ITEMS.
;;;
(defmethod view-draw-contents ((window draw-dialog))
  (dolist (item (slot-value window 'my-items))
    (view-draw-contents item)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; window-close [draw-dialog]
;;;
;;; This gets called when the window is closed.
;;; draw-item rectangles are disposed.
;;;
(defmethod window-close ((w draw-dialog))
  (dolist (item (slot-value w 'my-items))
    (dispose-record (slot-value item 'rectangle) :rect))
  (call-next-method))      ; This will actually close the window

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; window-null-event-handler [draw-dialog]
;;;
;;; This gets called by MCL after _WaitNextEvent returns a null event
;;;
(defmethod window-null-event-handler ((w draw-dialog))
  (let* ((where (view-mouse-position w))    ; Window coordinate point of mouse
         (item (find-view-containing-point w (point-h where) (point-v where)))
         (last-under-mouse (slot-value w 'item-last-under-mouse)))
    ;; Handle mouse-within, mouse-enter and mouse-leave events
    (when (and (slot-value w 'browse-mode)   ; in browser mode and
               item)                         ; when mouse is over an item
      (cond ((eq last-under-mouse item)
             (mouse-within item where))
            (t (if last-under-mouse
                 (mouse-leave last-under-mouse where))
               (setf (slot-value w 'item-last-under-mouse)
                     item)
               (mouse-enter item where)))
      ;; Handle idle event for window
      (idle w)))
  (call-next-method))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; view-click-event-handler [draw-dialog]
;;;
;;; This gets called by MCL when the mouse goes down in the window.
;;; We dispatch on MOUSE-DOWN events only when we are in browse mode.
;;; Otherwise, we call the author mode click event handler to handle
;;; authoring requirements (moving, resizing objects, etc...)
;;;
(defmethod view-click-event-handler ((w draw-dialog) where)
  (let ((item (find-view-containing-point w (point-h where) (point-v where))))
    (if (slot-value w 'browse-mode)
      (if item
        (mouse-down item where))
      (author-mode-click-handler item where))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; window-mouse-up-event-handler [draw-dialog]
;;;
;;; This gets called by MCL when the mouse goes up in the window.
;;; We dispatch on MOUSE-UP events only when we are in browse mode.
;;;
(defmethod window-mouse-up-event-handler ((w draw-dialog))
  (let* ((where (view-mouse-position w))
         (item (find-view-containing-point w (point-h where) (point-v where))))
    (if (and item
             (slot-value w 'browse-mode))
      (mouse-up item where)))
  (call-next-method))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; view-key-event-handler [draw-dialog]
;;;
;;; This gets called by MCL when a key is depressed and the window is selected.
;;; We dispatch on KEY events only when we are in browse mode
;;;
(defmethod view-key-event-handler ((w draw-dialog) character)
  (let* ((where (view-mouse-position w))
         (item (find-view-containing-point w (point-h where) (point-v where))))
    (if (and item
             (slot-value w 'browse-mode))
      (key item character)))
  (call-next-method))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; author-mode-click-handler [draw-dialog]
;;;
;;; Gets called whenever there is a click in a DRAW-DIALOG window,
;;; the click was not over an object in the window, and
;;; the window is in author mode (i.e., not in browse mode)
;;;
(defmethod author-mode-click-handler ((w draw-dialog) where)
  (if (double-click-p)
    (author-mode-double-click-handler w where)
    (author-mode-single-click-handler w where)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; author-mode-double-click-handler [draw-dialog]
;;;
;;; Gets called when there is a double click on the DRAW-DIALOG window,
;;; the click was not over an object in the window, and
;;; the window is in author mode
;;;
(defmethod author-mode-double-click-handler ((w draw-dialog) where)
  (declare (ignore where))
  ;; Show window information (same as selecting Window Info... menu item)
  (show-object-info w))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; author-mode-single-click-handler [draw-dialog]
;;;
;;; Gets called when there is a double click on the DRAW-DIALOG window,
;;; the click was not over an object in the window, and
;;; the window is in author mode
;;;
(defmethod author-mode-single-click-handler ((w draw-dialog) where)
  ;; Deselect selected items if appropriate:
  (unless (find-view-containing-point w (point-h where) (point-v where))
    (deselect-items w))

  ;; Check whether the user intends to drag out a rectangle.
  ;; If so, then drag out a grey rectangle and create a draw-item
  ;; if appropiate by checking *clonable-item*.
  (if (and *clonable-item*                       ; Is there a class from which we may create a draw-item?
           (slot-value w 'create-by-rectangle))  ; and can user create draw-item by dragging out a rectangle?
    (multiple-value-bind (topleft bottomright)
                         (select-rectangle w)
      (let ((clone (clone-draw-item *clonable-item*)))
        (set-view-position clone topleft)
        (set-view-size clone (subtract-points bottomright topleft))
        (add-items w clone)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; deselect-items [draw-dialog]
;;;
;;; Called to deselect everything in window
;;;
(defmethod deselect-items ((window draw-dialog))
  (dolist (item (slot-value window 'selections))
    (setf (slot-value item 'selected) nil)     ; Turn off selection flag
    (view-draw-contents item))                 ; Redraw item
  (setf (slot-value window 'selections) nil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; show-info [draw-dialog]
;;;
;;; This gets called whenever the window's information box must be shown
;;;
(defmethod show-info ((w draw-dialog))
  ;; Shows information box for window
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; bring-item-to-front [draw-dialog]
;;;
;;; This gets called whenever the item (a draw-item) is requested
;;; to be moved to the front of this window.  The ITEM argument
;;; is optional: if it is not supplied, then the currently selected
;;; item, if any, will be brought to the front.
;;; Being in the front means that it will be drawn last.
;;; Since items are drawn in order from the beginning to the end of
;;; of the slot MY-ITEMS of the draw-dialog window, all that needs
;;; to be done is to move the item to the end of the list.
;;;
(defmethod bring-item-to-front ((window draw-dialog) &optional item)
  ;; Figure out which item to bring to front, if any:
  (or item (setq item (first (slot-value window 'selections))))
  ;; If there's an item, then bring it to the front:
  (when item
    (setf (slot-value window 'my-items)
          (delete item (slot-value window 'my-items)))
    (setf (slot-value window 'my-items)
          (nconc (slot-value window 'my-items) (list item))))
  ;; Redraw the window so that the change is immediately apparent:
  (view-draw-contents window))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; add-subviews [draw-dialog]
;;;
;;; Add new dialog items into our ordered item list after
;;; they have been added to the dialog.
;;;
(defmethod add-subviews :after ((d draw-dialog) &rest new-items)
  (dolist (item new-items)
    (pushnew item (slot-value d 'my-items))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; remove-subviews [draw-dialog]
;;;
;;; Remove dialog items from our ordered item list after
;;; they have been removed from the dialog.
;;;
(defmethod remove-subviews :after ((d draw-dialog) &rest old-items)
  (dolist (item old-items)
    (setf (slot-value d 'my-items)   (delete item (slot-value d 'my-items)))
    (setf (slot-value d 'selections) (delete item (slot-value d 'selections)))))


;end of file draw-dialog-class.lisp
;------------------------------------------------