From 895180d78f951d92b7888f134da426ad606d043d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Tue, 4 Jun 2019 20:16:08 +0200
Subject: render: Add SDL_RenderDrawRect and SDL_RenderFillRect bindings.

* sdl2/bindings.scm (sdl-render-draw-rect, sdl-render-draw-rects,
  sdl-render-fill-rect, sdl-render-fill-rects): New procedures.
* sdl2/render.scm (render-draw-rect, render-draw-rects,
  render-fill-rect, render-fill-rects): New procedures.
* doc/api.texi: Document new procedures.
---
 sdl2/bindings.scm | 12 ++++++++++++
 sdl2/render.scm   | 41 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 53 insertions(+)

(limited to 'sdl2')

diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index 900b641..ae7f0d0 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -261,6 +261,18 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
 (define-foreign sdl-render-draw-points
   int "SDL_RenderDrawPoints" (list '* '* int))
 
+(define-foreign sdl-render-draw-rect
+  int "SDL_RenderDrawRect" (list '* '*))
+
+(define-foreign sdl-render-draw-rects
+  int "SDL_RenderDrawRects" (list '* '* int))
+
+(define-foreign sdl-render-fill-rect
+  int "SDL_RenderFillRect" (list '* '*))
+
+(define-foreign sdl-render-fill-rects
+  int "SDL_RenderFillRects" (list '* '* int))
+
 
 ;;;
 ;;; Events
diff --git a/sdl2/render.scm b/sdl2/render.scm
index 0b92bc4..6504ce9 100644
--- a/sdl2/render.scm
+++ b/sdl2/render.scm
@@ -28,6 +28,7 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (system foreign)
+  #:use-module (rnrs bytevectors)
   #:use-module (sdl2)
   #:use-module ((sdl2 bindings) #:prefix ffi:)
   #:export (make-renderer
@@ -42,6 +43,10 @@
             render-draw-lines
             render-draw-point
             render-draw-points
+            render-draw-rect
+            render-draw-rects
+            render-fill-rect
+            render-fill-rects
 
             delete-texture!
             surface->texture))
@@ -150,6 +155,42 @@ color."
                                 (bytevector->pointer bv)
                                 count)))
 
+(define (render-draw-rect renderer rect)
+  "Draw RECT on RENDERER."
+  (ffi:sdl-render-draw-rect
+   (unwrap-renderer renderer)
+   ((@@ (sdl2 rect) unwrap-rect) rect)))
+
+(define (render-draw-rects renderer rects)
+  "Draw 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-draw-rects (unwrap-renderer renderer)
+                               (bytevector->pointer bv)
+                               count)))
+
+(define (render-fill-rect renderer rect)
+  "Fill RECT on RENDERER."
+  (ffi:sdl-render-fill-rect
+   (unwrap-renderer renderer)
+   ((@@ (sdl2 rect) unwrap-rect) rect)))
+
+(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)))
+
 
 ;;;
 ;;; Texture
-- 
cgit v1.2.3