home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / mixin-madness / dialog-item-mixins / button-dim.lisp next >
Encoding:
Text File  |  1992-01-30  |  2.7 KB  |  79 lines
  1. (in-package :oou)
  2. (oou-provide :button-dim)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; button-dim.Lisp
  5. ;;
  6. ;; Copyright ⌐ 1991 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; Dialog item mixin for button behavior.
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies
  15.  :simple-view-ce)
  16.  
  17. (export '(button-dim button-hilite))
  18.  
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20.  
  21. (defclass button-dim () ())
  22.  
  23. (defmethod view-click-event-handler ((di button-dim) where)
  24.   (when (with-focused-view (view-container di) (button-track di where))
  25.     (call-next-method)))
  26.  
  27. (defmethod button-hilite ((di button-dim) hilite-flag)
  28.   (hilite-view di hilite-flag))
  29.  
  30. (defmethod point-in-button-p ((di button-dim) where)
  31.   (point-in-click-region-p di where))
  32.  
  33. (defmethod button-track ((di button-dim) initial-mouse-position)
  34.   ;;returns t or nil indicating if the mouse was realeased in the button
  35.   (let ((inverted (point-in-button-p di initial-mouse-position)))
  36.     (when inverted (button-hilite di t))
  37.     (loop
  38.       (unless (#_WaitMouseUp)
  39.         (when inverted (button-hilite di nil))
  40.         (return inverted))
  41.       (if (point-in-button-p di (view-mouse-position (view-container di)))
  42.         (unless inverted (button-hilite di t) (setf inverted t))
  43.         (when inverted (button-hilite di nil) (setf inverted nil))))))
  44.  
  45. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  46.  
  47. #|
  48. ;alternate handler to allow event processing during button tracking
  49. (defmethod view-click-event-handler ((di button-dim) where)
  50.   (eval-enqueue 
  51.    `(when (with-focused-view (view-container ,di) (button-track ,di ,where))
  52.       (dialog-item-action ,di))))
  53. |#
  54.  
  55. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  56.  
  57. #|
  58.  
  59. ;;; a modest example - adding button behavior to static text dialog items
  60.  
  61. (defclass sttxt-but (button-dim static-text-dialog-item) ())
  62.  
  63. (setf *test-w*
  64.       (make-instance 'dialog
  65.                      :window-type :document
  66.                      :view-position :centered
  67.                      :view-size #@(200 100)
  68.                      :window-title "rect-button-dim demo"
  69.                      :close-box-p t
  70.                      :color-p t
  71.                      :view-subviews
  72.                      (list (make-dialog-item 'sttxt-but
  73.                                              #@(20 20)
  74.                                              #@(160 18)
  75.                                              "I'm static text + a mixin"
  76.                                              #'(lambda (item) (declare (ignore item)) (ed-beep))
  77.                                              ))))
  78.  
  79. |#