From c8ea056292b1f6b1efc021525fd1b378f87877fe Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Thu, 13 May 2021 08:51:09 -0400
Subject: events: Add mouse wheel event.

---
 sdl2/events.scm | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

diff --git a/sdl2/events.scm b/sdl2/events.scm
index 8204b34..10a6ee1 100644
--- a/sdl2/events.scm
+++ b/sdl2/events.scm
@@ -100,6 +100,15 @@
             mouse-motion-event-x-rel
             mouse-motion-event-y-rel
 
+            make-mouse-wheel-event
+            mouse-wheel-event?
+            mouse-wheel-event-timestamp
+            mouse-wheel-event-window-id
+            mouse-wheel-event-which
+            mouse-wheel-event-x
+            mouse-wheel-event-y
+            mouse-wheel-event-direction
+
             make-joystick-axis-event
             joystick-axis-event?
             joystick-axis-event-timestamp
@@ -984,6 +993,35 @@
                               (button-mask->list state)
                               x y xrel yrel))))
 
+(define-record-type <mouse-wheel-event>
+  (make-mouse-wheel-event timestamp window-id which x y direction)
+  mouse-wheel-event?
+  (timestamp mouse-wheel-event-timestamp)
+  (window-id mouse-wheel-event-window-id)
+  (which mouse-wheel-event-which)
+  (x mouse-wheel-event-x)
+  (y mouse-wheel-event-y)
+  (direction mouse-wheel-direction))
+
+(define (parse-mouse-wheel-event ptr)
+  (define types
+    (list uint32   ; type
+          uint32   ; timestamp
+          uint32   ; windowID
+          uint32   ; which
+          int32    ; x
+          int32    ; y
+          uint32)) ; direction
+  (match (parse-c-struct ptr types)
+    ((_ timestamp window-id which x y direction)
+     (make-mouse-wheel-event timestamp
+                             window-id
+                             which
+                             x y
+                             (if (= direction ffi:SDL_MOUSEWHEEL_NORMAL)
+                                 'normal
+                                 'flipped)))))
+
 
 ;;;
 ;;; Joystick
@@ -1275,6 +1313,8 @@
                  (parse-mouse-button-event ptr))
                 ((= type ffi:SDL_MOUSEMOTION)
                  (parse-mouse-motion-event ptr))
+                ((= type ffi:SDL_MOUSEWHEEL)
+                 (parse-mouse-wheel-event ptr))
                 ((= type ffi:SDL_JOYAXISMOTION)
                  (parse-joystick-axis-event ptr))
                 ((= type ffi:SDL_JOYBALLMOTION)
-- 
cgit v1.2.3