summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2021-05-13 08:51:09 -0400
committerDavid Thompson <dthompson2@worcester.edu>2021-05-13 08:51:09 -0400
commitc8ea056292b1f6b1efc021525fd1b378f87877fe (patch)
tree26678d43b12daf0a3e9ef84917903a1096fc503f
parent4e821211403cf6c1b144f66df3a8204d4c5bc60d (diff)
events: Add mouse wheel event.
-rw-r--r--sdl2/events.scm40
1 files changed, 40 insertions, 0 deletions
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)