From 5ef8b648869d109ea840d20d5d59df1455687d49 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 8 Jan 2019 21:19:52 -0500
Subject: surface: Add SDL_BlitScaled binding.

* sdl2/bindings.scm (sdl-blit-scaled): New procedure.
* sdl2/surface.scm (blit-scaled): New procedure.
* doc/api.texi (Surfaces): Document it.
---
 sdl2/surface.scm | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

(limited to 'sdl2/surface.scm')

diff --git a/sdl2/surface.scm b/sdl2/surface.scm
index a918bd7..3770a17 100644
--- a/sdl2/surface.scm
+++ b/sdl2/surface.scm
@@ -64,7 +64,8 @@
             surface-pitch
             surface-pixels
             convert-surface-format
-            blit-surface))
+            blit-surface
+            blit-scaled))
 
 
 ;;;
@@ -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)))
-- 
cgit v1.2.3