From 8a11b291ec148441efacc96a2f9f187e4098af20 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 5 Dec 2020 15:08:52 -0500
Subject: render: Allow for rendering points with minimal allocation.

---
 sdl2/render.scm | 51 +++++++++++++++++++++++++++------------------------
 1 file changed, 27 insertions(+), 24 deletions(-)

(limited to 'sdl2')

diff --git a/sdl2/render.scm b/sdl2/render.scm
index 2320d71..0f5119c 100644
--- a/sdl2/render.scm
+++ b/sdl2/render.scm
@@ -218,35 +218,38 @@ disable it."
         (hashq-set! *pointer-cache* bv ptr)
         ptr)))
 
+(define (build-point-bv points)
+  (let ((bv (make-s32vector (* (length points) 2))))
+    (let loop ((points points)
+               (i 0))
+      (match points
+        (() bv)
+        (((x y) . rest)
+         (s32vector-set! bv (* i 2) x)
+         (s32vector-set! bv (+ (* i 1) 1) y)
+         (loop rest (+ i 1)))))))
+
 (define (render-draw-lines renderer points)
   "Draw lines connecting POINTS on RENDERER."
-  (define (fill-bv bv l n)
-    (match l
-      (() bv)
-      (((x y) . r)
-       (s32vector-set! bv n x)
-       (s32vector-set! bv (+ n 1) y)
-       (fill-bv bv r (+ 2 n)))))
-  (let* ((count (length points))
-         (bv (fill-bv (make-s32vector (* count 2)) points 0)))
-    (ffi:sdl-render-draw-lines (unwrap-renderer renderer)
-                               (bytevector->pointer bv)
-                               count)))
+  (if (bytevector? points)
+      (ffi:sdl-render-draw-lines (unwrap-renderer renderer)
+                                 (bytevector->pointer/cached points)
+                                 (/ (bytevector-length points) 8))
+      (let ((bv (build-point-bv points)))
+        (ffi:sdl-render-draw-lines (unwrap-renderer renderer)
+                                   (bytevector->pointer bv)
+                                   (length points)))))
 
 (define (render-draw-points renderer points)
   "Draw POINTS on RENDERER."
-  (define (fill-bv bv l n)
-    (match l
-      (() bv)
-      (((x y) . r)
-       (s32vector-set! bv n x)
-       (s32vector-set! bv (+ n 1) y)
-       (fill-bv bv r (+ 2 n)))))
-  (let* ((count (length points))
-         (bv (fill-bv (make-s32vector (* count 2)) points 0)))
-    (ffi:sdl-render-draw-points (unwrap-renderer renderer)
-                                (bytevector->pointer bv)
-                                count)))
+  (if (bytevector? points)
+      (ffi:sdl-render-draw-points (unwrap-renderer renderer)
+                                  (bytevector->pointer/cached points)
+                                  (/ (bytevector-length points) 8))
+      (let ((bv (build-point-bv points)))
+        (ffi:sdl-render-draw-points (unwrap-renderer renderer)
+                                    (bytevector->pointer bv)
+                                    (length points)))))
 
 (define (build-rect-bv rects)
   (let* ((count (length rects))
-- 
cgit v1.2.3