diff options
| author | David Thompson <dthompson2@worcester.edu> | 2019-01-08 21:19:52 -0500 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2019-01-08 21:29:48 -0500 |
| commit | 5ef8b648869d109ea840d20d5d59df1455687d49 (patch) | |
| tree | 20cbb18d0a516ff1f069df662650caf45f8e163d /sdl2 | |
| parent | c519f8238fc05bb4e0b12bf4650264fec36d7050 (diff) | |
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.
Diffstat (limited to 'sdl2')
| -rw-r--r-- | sdl2/bindings.scm | 3 | ||||
| -rw-r--r-- | sdl2/surface.scm | 17 |
2 files changed, 19 insertions, 1 deletions
diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm index 7c16abb..1f97186 100644 --- a/sdl2/bindings.scm +++ b/sdl2/bindings.scm @@ -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" '(* * * *)) + ;;; ;;; Audio 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))) |