diff options
author | David Thompson <dthompson2@worcester.edu> | 2019-01-08 21:29:58 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2019-01-08 21:29:58 -0500 |
commit | 4b2c190732b9022e7546c5d2724a82905b6555ee (patch) | |
tree | 822878ab93b2001dee580559003ca1766c250cc5 | |
parent | 5ef8b648869d109ea840d20d5d59df1455687d49 (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.texi | 4 | ||||
-rw-r--r-- | sdl2/bindings.scm | 3 | ||||
-rw-r--r-- | sdl2/surface.scm | 13 |
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))) |