diff options
| author | Colin Okay <colin@cicadas.surf> | 2022-06-24 08:18:49 -0500 |
|---|---|---|
| committer | Colin Okay <colin@cicadas.surf> | 2022-06-24 08:18:49 -0500 |
| commit | 1737ca0627d5fb75a4e74c8ee0562f734ce34ebf (patch) | |
| tree | 1f424ee9d696710e66b6ab4e8c34ff1c35ecc3e7 /wheelwork.lisp | |
| parent | 2f0602913a02823092393b29a26992f61fafbdb4 (diff) | |
[add] handling of mousewheel events
Diffstat (limited to 'wheelwork.lisp')
| -rw-r--r-- | wheelwork.lisp | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/wheelwork.lisp b/wheelwork.lisp index 1aefd51..d8637f1 100644 --- a/wheelwork.lisp +++ b/wheelwork.lisp @@ -405,6 +405,12 @@ give focus to whatever was clicked." (handler (get-handler-for target 'mousemotion))) (funcall handler target x y xrel yrel state wx wy wxrel wyrel)))))) +(defun eventloop-mousewheel (app wx wy dir) + (when (should-listen-for-p 'mousewheel app) + (when-let* ((focus (get-focus app)) + (handler (get-handler-for focus 'mousewheel))) + (funcall handler focus wx wy dir)))) + (defun eventloop (app) (sdl2:with-event-loop (:method :poll) (:mousebuttondown @@ -419,6 +425,9 @@ give focus to whatever was clicked." (:keyup (:keysym keysym) (eventloop-keyup app keysym)) + (:mousewheel + (:x x :y y :direction dir) + (eventloop-mousewheel app x y dir)) (:idle () (render app)) (:quit () t))) @@ -724,20 +733,20 @@ can be redefined using this form to support interactive development." ,@body))) (defmacro on-mousewheel - ((&optional (target 'target) (x 'x) (y 'y) (dir 'dir)) &body body) + ((&optional (target 'target) (horiz 'horiz) (vert 'vert) (dir 'dir)) &body body) "Creates a handler for MOUSEWHEEL events" `(make-instance 'event-handler :event-type 'wheelwork::mousewheel :handler-function (lambda (,(intern (symbol-name target)) - ,(intern (symbol-name x)) - ,(intern (symbol-name y)) + ,(intern (symbol-name horiz)) + ,(intern (symbol-name vert)) ,(intern (symbol-name dir))) (declare (ignorable ,(intern (symbol-name target)) - ,(intern (symbol-name x)) - ,(intern (symbol-name y)) + ,(intern (symbol-name horiz)) + ,(intern (symbol-name vert)) ,(intern (symbol-name dir)))) ,@body))) |