From 54d8e6b0332056522b6e62b20948a9fa89572a19 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 31 Dec 2016 13:30:14 -0500
Subject: events: Reduce allocation in poll-event.

* sdl2/events.scm (poll-event): Reuse the same event structure for each
call.
---
 sdl2/events.scm | 89 ++++++++++++++++++++++++++++++---------------------------
 1 file changed, 47 insertions(+), 42 deletions(-)

(limited to 'sdl2')

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))))))))
-- 
cgit v1.2.3