source: trunk/source/examples/cocoa/easygui/events.lisp @ 12720

Last change on this file since 12720 was 12720, checked in by cater, 11 years ago

Towards unified handling of control &c modifiers with keys and with mouse

File size: 3.7 KB
Line 
1(in-package :easygui)
2
3;;; Changed by AWSC (arthur.cater@ucd.ie) Feb 2009:
4;;; Modified define-chaining-responder-method to allow subclasses of easygui
5;;; views to inherit mouse handling behaviour.
6;;; Changed by AWSC Apr 2009:
7;;; Modified define-chaining-responder-method to bind *modifier-key-pattern*
8;;; when Lisp mouse handlers are being called.
9;;; The original work I changed is by an unknown author.
10;;; Permission to use disseminate and further modify these changes is granted.
11
12;;; Event handling basics
13
14(defmacro define-chaining-responder-method (class-name
15                                            (objc-name lisp-name)
16                                            (self-arg event-arg)
17                                            &body arg-compute-forms)
18  `(objc:defmethod (,objc-name :void) ((,self-arg ,class-name)
19                                       ,event-arg)
20     (let ((superclasses (ccl:class-precedence-list (class-of (easygui-view-of ,self-arg)))))
21       (if (some #'(lambda (super)
22                     (find-method #',lisp-name nil (list (class-name super)) nil))
23                 superclasses)
24           (let ((*modifier-key-pattern* (#/modifierFlags ,event-arg)))
25             (,lisp-name (easygui-view-of ,self-arg)
26                         ,@arg-compute-forms))
27           (,objc-name (#/nextResponder ,self-arg) ,event-arg)))))
28
29(defmacro define-useful-mouse-event-handling-routines (class-name)
30  `(progn
31     (define-chaining-responder-method ,class-name
32         (#/mouseDown: mouse-down) (self event)
33       :cocoa-event event
34       :location (let ((objc-pt (#/convertPoint:fromView:
35                                 self
36                                 (#/locationInWindow event)
37                                 nil)))
38                   (point (ns:ns-point-x objc-pt) (ns:ns-point-y objc-pt)))
39       :button (#/buttonNumber event)
40       :click-count (#/clickCount event)
41       :delta (point (#/deltaX event) (#/deltaY event)))
42     (define-chaining-responder-method ,class-name
43         (#/mouseUp: mouse-up) (self event)
44       :cocoa-event event
45       :location (let ((objc-pt (#/convertPoint:fromView:
46                                 self
47                                 (#/locationInWindow event)
48                                 nil)))
49                   (point (ns:ns-point-x objc-pt) (ns:ns-point-y objc-pt)))
50       :button (#/buttonNumber event)
51       :click-count (#/clickCount event)
52       :delta (point (#/deltaX event) (#/deltaY event)))
53     (define-chaining-responder-method ,class-name
54         (#/mouseDragged: mouse-dragged) (self event)
55       :cocoa-event event
56       :location (let ((objc-pt (#/convertPoint:fromView:
57                                 self
58                                 (#/locationInWindow event)
59                                 nil)))
60                   (point (ns:ns-point-x objc-pt) (ns:ns-point-y objc-pt))))))
61
62;;; Mouse:
63
64(defclass event-handler-mixin () ())
65
66(defclass mouse-event-handler-mixin () ())
67
68
69(macrolet ((defgeneric-and-empty-method (name (&rest args) &rest options)
70               `(defgeneric ,name ,args
71                  ,@options
72                  (:method ,args
73                    (declare (ignore ,@(remove-if (lambda (sym) (member sym lambda-list-keywords)) args)))))))
74  ;; TODO: mouse-move
75  (defgeneric-and-empty-method mouse-down (view &key cocoa-event location button
76                                                click-count delta))
77  (defgeneric-and-empty-method mouse-up (view &key cocoa-event location button
78                                              click-count delta))
79  (defgeneric-and-empty-method mouse-dragged (view &key cocoa-event location
80                                                   delta)))
Note: See TracBrowser for help on using the repository browser.