summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2019-01-08 21:29:58 -0500
committerDavid Thompson <dthompson2@worcester.edu>2019-01-08 21:29:58 -0500
commit4b2c190732b9022e7546c5d2724a82905b6555ee (patch)
tree822878ab93b2001dee580559003ca1766c250cc5
parent5ef8b648869d109ea840d20d5d59df1455687d49 (diff)
surface: Add SDL_FillRect binding.
* sdl2/bindings.scm (sdl-fill-rect): New procedure. * sdl2/surface.scm (fill-rect): New procedure. * doc/api.texi (Surfaces): Document it.
-rw-r--r--doc/api.texi4
-rw-r--r--sdl2/bindings.scm3
-rw-r--r--sdl2/surface.scm13
3 files changed, 19 insertions, 1 deletions
diff --git a/doc/api.texi b/doc/api.texi
index 7e47fd7..57e92d3 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1000,6 +1000,10 @@ Blit the rectangle @var{src-rect} from the surface @var{src} to
destination.
@end deffn
+@deffn {Procedure} fill-rect @var{dst} @var{rect} @var{color}
+Fill @var{rect} with @var{color}, a 32-bit color encoded as an integer
+value, in the surface @var{dst}.
+@end deffn
@node Rendering
@section Rendering
diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index 1f97186..c314a23 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -949,6 +949,9 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
(define-foreign sdl-blit-scaled
int "SDL_UpperBlitScaled" '(* * * *))
+(define-foreign sdl-fill-rect
+ int "SDL_FillRect" (list '* '* uint32))
+
;;;
;;; Audio
diff --git a/sdl2/surface.scm b/sdl2/surface.scm
index 3770a17..1350fa3 100644
--- a/sdl2/surface.scm
+++ b/sdl2/surface.scm
@@ -65,7 +65,8 @@
surface-pixels
convert-surface-format
blit-surface
- blit-scaled))
+ blit-scaled
+ fill-rect))
;;;
@@ -464,3 +465,13 @@ surface DST, scaling the source to fit the destination."
((@@ (sdl2 rect) unwrap-rect) dst-rect)
%null-pointer)))
(sdl-error "blit-scaled" "failed to blit surface ~a to ~a" src dst)))
+
+(define (fill-rect dst rect color)
+ "Fill RECT with COLOR in the surface DST."
+ (unless (zero?
+ (ffi:sdl-fill-rect (unwrap-surface dst)
+ (if rect
+ ((@@ (sdl2 rect) unwrap-rect) rect)
+ %null-pointer)
+ color))
+ (sdl-error "fill-rect" "failed to fill rect in ~a" dst)))