diff options
| -rw-r--r-- | sdl2/events.scm | 89 |
1 files changed, 47 insertions, 42 deletions
diff --git a/sdl2/events.scm b/sdl2/events.scm index f207348..56bf233 100644 --- a/sdl2/events.scm +++ b/sdl2/events.scm @@ -1228,46 +1228,51 @@ ;;; Event management ;;; -(define (poll-event) +(define poll-event + ;; Multiple threads calling this procedure is not a concern because + ;; most SDL functions only work from the main thread, so we can + ;; reduce memory allocation by reusing the same bytevector each time + ;; we poll for events. (let* ((e (make-sdl-event)) - (ptr (bytevector->pointer e)) - (result (ffi:sdl-poll-event ptr))) - (and (= result 1) - (let ((type (sdl-event-type e))) - (cond - ((= type ffi:SDL_QUIT) - (parse-quit-event ptr)) - ((= type ffi:SDL_WINDOWEVENT) - (parse-window-event ptr)) - ((or (= type ffi:SDL_KEYDOWN) - (= type ffi:SDL_KEYUP)) - (parse-keyboard-event ptr)) - ((= type ffi:SDL_TEXTINPUT) - (parse-text-input-event ptr)) - ((or (= type ffi:SDL_MOUSEBUTTONDOWN) - (= type ffi:SDL_MOUSEBUTTONUP)) - (parse-mouse-button-event ptr)) - ((= type ffi:SDL_MOUSEMOTION) - (parse-mouse-motion-event ptr)) - ((= type ffi:SDL_JOYAXISMOTION) - (parse-joystick-axis-event ptr)) - ((= type ffi:SDL_JOYBALLMOTION) - (parse-joystick-ball-event ptr)) - ((= type ffi:SDL_JOYHATMOTION) - (parse-joystick-hat-event ptr)) - ((or (= type ffi:SDL_JOYBUTTONDOWN) - (= type ffi:SDL_JOYBUTTONUP)) - (parse-joystick-button-event ptr)) - ((or (= type ffi:SDL_JOYDEVICEADDED) - (= type ffi:SDL_JOYDEVICEREMOVED)) - (parse-joystick-device-event ptr)) - ((= type ffi:SDL_CONTROLLERAXISMOTION) - (parse-controller-axis-event ptr)) - ((or (= type ffi:SDL_CONTROLLERBUTTONDOWN) - (= type ffi:SDL_CONTROLLERBUTTONUP)) - (parse-controller-button-event ptr)) - ((or (= type ffi:SDL_CONTROLLERDEVICEADDED) - (= type ffi:SDL_CONTROLLERDEVICEREMOVED) - (= type ffi:SDL_CONTROLLERDEVICEREMAPPED)) - (parse-controller-device-event ptr)) - (else 'fixme:unsupported-event)))))) + (ptr (bytevector->pointer e))) + (lambda () + (let ((result (ffi:sdl-poll-event ptr))) + (and (= result 1) + (let ((type (sdl-event-type e))) + (cond + ((= type ffi:SDL_QUIT) + (parse-quit-event ptr)) + ((= type ffi:SDL_WINDOWEVENT) + (parse-window-event ptr)) + ((or (= type ffi:SDL_KEYDOWN) + (= type ffi:SDL_KEYUP)) + (parse-keyboard-event ptr)) + ((= type ffi:SDL_TEXTINPUT) + (parse-text-input-event ptr)) + ((or (= type ffi:SDL_MOUSEBUTTONDOWN) + (= type ffi:SDL_MOUSEBUTTONUP)) + (parse-mouse-button-event ptr)) + ((= type ffi:SDL_MOUSEMOTION) + (parse-mouse-motion-event ptr)) + ((= type ffi:SDL_JOYAXISMOTION) + (parse-joystick-axis-event ptr)) + ((= type ffi:SDL_JOYBALLMOTION) + (parse-joystick-ball-event ptr)) + ((= type ffi:SDL_JOYHATMOTION) + (parse-joystick-hat-event ptr)) + ((or (= type ffi:SDL_JOYBUTTONDOWN) + (= type ffi:SDL_JOYBUTTONUP)) + (parse-joystick-button-event ptr)) + ((or (= type ffi:SDL_JOYDEVICEADDED) + (= type ffi:SDL_JOYDEVICEREMOVED)) + (parse-joystick-device-event ptr)) + ((= type ffi:SDL_CONTROLLERAXISMOTION) + (parse-controller-axis-event ptr)) + ((or (= type ffi:SDL_CONTROLLERBUTTONDOWN) + (= type ffi:SDL_CONTROLLERBUTTONUP)) + (parse-controller-button-event ptr)) + ((or (= type ffi:SDL_CONTROLLERDEVICEADDED) + (= type ffi:SDL_CONTROLLERDEVICEREMOVED) + (= type ffi:SDL_CONTROLLERDEVICEREMAPPED)) + (parse-controller-device-event ptr)) + (else 'fixme:unsupported-event)))))))) |