summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2016-12-31 13:30:14 -0500
committerDavid Thompson <dthompson2@worcester.edu>2016-12-31 13:31:18 -0500
commit54d8e6b0332056522b6e62b20948a9fa89572a19 (patch)
tree830c22e1bca3922fbd80b2942897e6e41ced319b
parent94d459fd7214580d2b4203f3be143cb724a29bbf (diff)
events: Reduce allocation in poll-event.
* sdl2/events.scm (poll-event): Reuse the same event structure for each call.
-rw-r--r--sdl2/events.scm89
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))))))))