render: Allow for rendering rects with minimal allocation.

1 files changed, 41 insertions, 26 deletions

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)))))
 
 
 ;;;