From 1737ca0627d5fb75a4e74c8ee0562f734ce34ebf Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Fri, 24 Jun 2022 08:18:49 -0500
Subject: [add] handling of mousewheel events

---
 examples/02-moving-bitmp.lisp |  5 +++++
 wheelwork.lisp                | 19 ++++++++++++++-----
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/examples/02-moving-bitmp.lisp b/examples/02-moving-bitmp.lisp
index a132e9f..153ca1d 100644
--- a/examples/02-moving-bitmp.lisp
+++ b/examples/02-moving-bitmp.lisp
@@ -75,6 +75,10 @@
   (ww::on-blur ()
     (format t "~a lost focus~%" target)))
 
+(ww::defhandler wheelie
+    (ww::on-mousewheel ()
+      (print (list :mousewheel horiz vert dir))))
+
 (defmethod ww::boot ((app bitmap-display))
   (let ((bm
           (make-instance 'ww::bitmap
@@ -95,6 +99,7 @@
     (ww::set-handler bm2 #'thing-clicked)
     (ww::set-handler bm2 #'look-at-me )
     (ww::set-handler bm2 #'look-away)
+    (ww::set-handler bm2 #'wheelie)
     (ww::add-unit app bm2)))
 
 
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)))
 
-- 
cgit v1.2.3