surface: Add SDL_BlitScaled binding.
authorDavid Thompson <dthompson2@worcester.edu>
Wed, 9 Jan 2019 02:19:52 +0000 (21:19 -0500)
committerDavid Thompson <dthompson2@worcester.edu>
Wed, 9 Jan 2019 02:29:48 +0000 (21:29 -0500)
* sdl2/bindings.scm (sdl-blit-scaled): New procedure.
* sdl2/surface.scm (blit-scaled): New procedure.
* doc/api.texi (Surfaces): Document it.

doc/api.texi
sdl2/bindings.scm
sdl2/surface.scm

index f09cdfd..7e47fd7 100644 (file)
@@ -994,6 +994,13 @@ Blit the rectangle @var{src-rect} from the surface @var{src} to
 @var{dst-rect} of the surface @var{dst}.
 @end deffn
 
+@deffn {Procedure} blit-scaled @var{src} @var{src-rect} @var{dst} @var{dst-rect}
+Blit the rectangle @var{src-rect} from the surface @var{src} to
+@var{dst-rect} of the surface @var{dst}, scaling the source to fit the
+destination.
+@end deffn
+
+
 @node Rendering
 @section Rendering
 
index 7c16abb..1f97186 100644 (file)
@@ -946,6 +946,9 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
 (define-foreign sdl-blit-surface
   int "SDL_UpperBlit" '(* * * *))
 
+(define-foreign sdl-blit-scaled
+  int "SDL_UpperBlitScaled" '(* * * *))
+
 \f
 ;;;
 ;;; Audio
index a918bd7..3770a17 100644 (file)
@@ -64,7 +64,8 @@
             surface-pitch
             surface-pixels
             convert-surface-format
-            blit-surface))
+            blit-surface
+            blit-scaled))
 
 \f
 ;;;
@@ -449,3 +450,17 @@ surface DST."
                                      ((@@ (sdl2 rect) unwrap-rect) dst-rect)
                                      %null-pointer)))
     (sdl-error "blit-surface" "failed to blit surface ~a to ~a" src dst)))
+
+(define (blit-scaled src src-rect dst dst-rect)
+  "Blit the rectangle SRC-RECT from the surface SRC to DST-RECT of the
+surface DST, scaling the source to fit the destination."
+  (unless (zero?
+           (ffi:sdl-blit-surface (unwrap-surface src)
+                                 (if src-rect
+                                     ((@@ (sdl2 rect) unwrap-rect) src-rect)
+                                     %null-pointer)
+                                 (unwrap-surface dst)
+                                 (if dst-rect
+                                     ((@@ (sdl2 rect) unwrap-rect) dst-rect)
+                                     %null-pointer)))
+    (sdl-error "blit-scaled" "failed to blit surface ~a to ~a" src dst)))