summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2019-06-04 20:16:08 +0200
committerDavid Thompson <dthompson2@worcester.edu>2019-06-04 15:45:46 -0400
commit895180d78f951d92b7888f134da426ad606d043d (patch)
treede29912b7dd0e97ea2ec5af3c46c7577675176b5
parent84e59980a606f54ea96bb1932ff9a6474a5aaf45 (diff)
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.
-rw-r--r--doc/api.texi17
-rw-r--r--sdl2/bindings.scm12
-rw-r--r--sdl2/render.scm41
3 files changed, 70 insertions, 0 deletions
diff --git a/doc/api.texi b/doc/api.texi
index e222c11..44d6506 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1082,6 +1082,23 @@ Draw a multiple points from @var{points} on the current rendering
target of @var{renderer}.
@end deffn
+@deffn {Procedure} render-draw-rect renderer rectangle
+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}.
+@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}.
+@end deffn
+
+
@deffn {Procedure} surface->texture renderer surface
Convert @var{surface} to a texture suitable for @var{renderer}.
@end deffn
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