diff options
author | David Thompson <dthompson2@worcester.edu> | 2021-05-13 08:51:09 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2021-05-13 08:51:09 -0400 |
commit | c8ea056292b1f6b1efc021525fd1b378f87877fe (patch) | |
tree | 26678d43b12daf0a3e9ef84917903a1096fc503f | |
parent | 4e821211403cf6c1b144f66df3a8204d4c5bc60d (diff) |
events: Add mouse wheel event.
-rw-r--r-- | sdl2/events.scm | 40 |
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) |