From a75936cdff67adfd34fc163ab446b87844f1dcfe Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 5 Dec 2020 15:01:44 -0500
Subject: render: Allow for rendering rects with minimal allocation.

---
 doc/api.texi    | 13 +++++++----
 sdl2/render.scm | 67 +++++++++++++++++++++++++++++++++++----------------------
 2 files changed, 50 insertions(+), 30 deletions(-)

diff --git a/doc/api.texi b/doc/api.texi
index 16f57eb..ee26d9b 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1172,16 +1172,21 @@ target of @var{renderer}.
 Draw the outline of @var{rectangle} onto renderer.
 @end deffn
 
-@deffn {Procedure} render-draw-rects renderer rectangles
-Draw the outline of the list @var{rectangles} onto @var{renderer}.
+@deffn {Procedure} render-draw-rects renderer rects
+Draw the outline of all rects in the list @var{rects} onto
+@var{renderer}.  Optionally, for best performance, @var{rects} may
+instead be a bytevector packed with signed 32 bit integers, 4 per rect
+(x, y, width, height).
 @end deffn
 
 @deffn {Procedure} render-fill-rect renderer rectangle
 Fill @var{rectangle} onto @var{renderer}.
 @end deffn
 
-@deffn {Procedure} render-fill-rects renderer rectangles
-Fill the list @var{rectangles} onto @var{renderer}.
+@deffn {Procedure} render-fill-rects renderer rects
+Fill the list @var{rects} onto @var{renderer}.  Optionally, for best
+performance, @var{rects} may instead be a bytevector packed with
+signed 32 bit integers, 4 per rect (x, y, width, height).
 @end deffn
 
 @deffn {Procedure} set-render-target! renderer texture
diff --git a/sdl2/render.scm b/sdl2/render.scm
index 4cf0a28..2320d71 100644
--- a/sdl2/render.scm
+++ b/sdl2/render.scm
@@ -198,6 +198,26 @@ disable it."
   "Draw line on RENDERER."
   (ffi:sdl-render-draw-line (unwrap-renderer renderer) x1 y1 x2 y2))
 
+(define (render-draw-rect renderer rect)
+  "Draw RECT on RENDERER."
+  (ffi:sdl-render-draw-rect
+   (unwrap-renderer renderer)
+   (if rect
+       ((@@ (sdl2 rect) unwrap-rect) rect)
+       %null-pointer)))
+
+(define (render-draw-point renderer x y)
+  "Draw point on RENDERER."
+  (ffi:sdl-render-draw-point (unwrap-renderer renderer) x y))
+
+(define *pointer-cache* (make-weak-key-hash-table))
+
+(define (bytevector->pointer/cached bv)
+  (or (hashq-ref *pointer-cache* bv)
+      (let ((ptr (bytevector->pointer bv)))
+        (hashq-set! *pointer-cache* bv ptr)
+        ptr)))
+
 (define (render-draw-lines renderer points)
   "Draw lines connecting POINTS on RENDERER."
   (define (fill-bv bv l n)
@@ -213,10 +233,6 @@ disable it."
                                (bytevector->pointer bv)
                                count)))
 
-(define (render-draw-point renderer x y)
-  "Draw point on RENDERER."
-  (ffi:sdl-render-draw-point (unwrap-renderer renderer) x y))
-
 (define (render-draw-points renderer points)
   "Draw POINTS on RENDERER."
   (define (fill-bv bv l n)
@@ -232,25 +248,25 @@ disable it."
                                 (bytevector->pointer bv)
                                 count)))
 
-(define (render-draw-rect renderer rect)
-  "Draw RECT on RENDERER."
-  (ffi:sdl-render-draw-rect
-   (unwrap-renderer renderer)
-   (if rect
-       ((@@ (sdl2 rect) unwrap-rect) rect)
-       %null-pointer)))
-
-(define (render-draw-rects renderer rects)
-  "Draw RECTS on RENDERER."
+(define (build-rect-bv rects)
   (let* ((count (length rects))
          (bv (make-s32vector (* count 4))))
     (for-each (lambda (rect i)
                 (bytevector-copy! ((@@ (sdl2 rect) rect-bv) rect) 0
                                   bv (* i 4 4) (* 4 4)))
               rects (iota count))
-    (ffi:sdl-render-draw-rects (unwrap-renderer renderer)
-                               (bytevector->pointer bv)
-                               count)))
+    bv))
+
+(define (render-draw-rects renderer rects)
+  "Draw RECTS on RENDERER."
+  (if (bytevector? rects)
+      (ffi:sdl-render-draw-rects (unwrap-renderer renderer)
+                                 (bytevector->pointer/cached rects)
+                                 (/ (bytevector-length rects) 16))
+      (let ((bv (build-rect-bv rects)))
+        (ffi:sdl-render-draw-rects (unwrap-renderer renderer)
+                                   (bytevector->pointer bv)
+                                   (length rects)))))
 
 (define (render-fill-rect renderer rect)
   "Fill RECT on RENDERER."
@@ -262,15 +278,14 @@ disable it."
 
 (define (render-fill-rects renderer rects)
   "Fill RECTS on RENDERER."
-  (let* ((count (length rects))
-         (bv (make-s32vector (* count 4))))
-    (for-each (lambda (rect i)
-                (bytevector-copy! ((@@ (sdl2 rect) rect-bv) rect) 0
-                                  bv (* i 4 4) (* 4 4)))
-              rects (iota count))
-    (ffi:sdl-render-fill-rects (unwrap-renderer renderer)
-                               (bytevector->pointer bv)
-                               count)))
+  (if (bytevector? rects)
+      (ffi:sdl-render-fill-rects (unwrap-renderer renderer)
+                                 (bytevector->pointer/cached rects)
+                                 (/ (bytevector-length rects) 16))
+      (let ((bv (build-rect-bv rects)))
+        (ffi:sdl-render-fill-rects (unwrap-renderer renderer)
+                                   (bytevector->pointer bv)
+                                   (length rects)))))
 
 
 ;;;
-- 
cgit v1.2.3