| [7472] | 1 | (in-package :easygui)
|
|---|
| 2 |
|
|---|
| [11797] | 3 | ;;; Changed by AWSC Feb 2009:
|
|---|
| 4 | ;;; Modified define-chaining-responder-method to allow subclasses of easygui
|
|---|
| 5 | ;;; views to inherit mouse handling behaviour.
|
|---|
| 6 | ;;; Original work by an unknown author.
|
|---|
| 7 | ;;; Permission to use the change is granted.
|
|---|
| 8 |
|
|---|
| [7472] | 9 | ;;; Event handling basics
|
|---|
| 10 |
|
|---|
| 11 | (defmacro define-chaining-responder-method (class-name
|
|---|
| 12 | (objc-name lisp-name)
|
|---|
| 13 | (self-arg event-arg)
|
|---|
| 14 | &body arg-compute-forms)
|
|---|
| 15 | `(objc:defmethod (,objc-name :void) ((,self-arg ,class-name)
|
|---|
| 16 | ,event-arg)
|
|---|
| [11797] | 17 | (let ((superclasses (ccl:class-precedence-list (class-of (easygui-view-of ,self-arg)))))
|
|---|
| 18 | (if (some #'(lambda (super)
|
|---|
| 19 | (find-method #',lisp-name nil (list (class-name super)) nil))
|
|---|
| 20 | superclasses)
|
|---|
| [7472] | 21 | (,lisp-name (easygui-view-of ,self-arg)
|
|---|
| 22 | ,@arg-compute-forms)
|
|---|
| 23 | (,objc-name (#/nextResponder ,self-arg) ,event-arg)))))
|
|---|
| 24 |
|
|---|
| 25 | (defmacro define-useful-mouse-event-handling-routines (class-name)
|
|---|
| 26 | `(progn
|
|---|
| 27 | (define-chaining-responder-method ,class-name
|
|---|
| 28 | (#/mouseDown: mouse-down) (self event)
|
|---|
| 29 | :cocoa-event event
|
|---|
| 30 | :location (let ((objc-pt (#/convertPoint:fromView:
|
|---|
| 31 | self
|
|---|
| 32 | (#/locationInWindow event)
|
|---|
| 33 | nil)))
|
|---|
| 34 | (point (ns:ns-point-x objc-pt) (ns:ns-point-y objc-pt)))
|
|---|
| 35 | :button (#/buttonNumber event)
|
|---|
| 36 | :click-count (#/clickCount event)
|
|---|
| 37 | :delta (point (#/deltaX event) (#/deltaY event)))
|
|---|
| 38 | (define-chaining-responder-method ,class-name
|
|---|
| 39 | (#/mouseUp: mouse-up) (self event)
|
|---|
| 40 | :cocoa-event event
|
|---|
| 41 | :location (let ((objc-pt (#/convertPoint:fromView:
|
|---|
| 42 | self
|
|---|
| 43 | (#/locationInWindow event)
|
|---|
| 44 | nil)))
|
|---|
| 45 | (point (ns:ns-point-x objc-pt) (ns:ns-point-y objc-pt)))
|
|---|
| 46 | :button (#/buttonNumber event)
|
|---|
| 47 | :click-count (#/clickCount event)
|
|---|
| 48 | :delta (point (#/deltaX event) (#/deltaY event)))
|
|---|
| 49 | (define-chaining-responder-method ,class-name
|
|---|
| 50 | (#/mouseDragged: mouse-dragged) (self event)
|
|---|
| 51 | :cocoa-event event
|
|---|
| 52 | :location (let ((objc-pt (#/convertPoint:fromView:
|
|---|
| 53 | self
|
|---|
| 54 | (#/locationInWindow event)
|
|---|
| 55 | nil)))
|
|---|
| 56 | (point (ns:ns-point-x objc-pt) (ns:ns-point-y objc-pt))))))
|
|---|
| 57 |
|
|---|
| 58 | ;;; Mouse:
|
|---|
| 59 |
|
|---|
| 60 | (defclass event-handler-mixin () ())
|
|---|
| 61 |
|
|---|
| 62 | (defclass mouse-event-handler-mixin () ())
|
|---|
| 63 |
|
|---|
| 64 |
|
|---|
| 65 | (macrolet ((defgeneric-and-empty-method (name (&rest args) &rest options)
|
|---|
| 66 | `(defgeneric ,name ,args
|
|---|
| 67 | ,@options
|
|---|
| 68 | (:method ,args
|
|---|
| 69 | (declare (ignore ,@args))))))
|
|---|
| 70 | ;; TODO: mouse-move
|
|---|
| 71 | (defgeneric-and-empty-method mouse-down (view &key cocoa-event location button
|
|---|
| 72 | click-count delta))
|
|---|
| 73 | (defgeneric-and-empty-method mouse-up (view &key cocoa-event location button
|
|---|
| 74 | click-count delta))
|
|---|
| 75 | (defgeneric-and-empty-method mouse-dragged (view &key cocoa-event location
|
|---|
| 76 | delta)))
|
|---|
