From 6b8bef2445f71bd777b41a94cb33558cbc5cd2fb Mon Sep 17 00:00:00 2001 From: David Thompson Date: Mon, 7 Jan 2019 22:53:13 -0500 Subject: surface: Add SDL_BlitSurface binding. * sdl2/bindings.scm (sdl-blit-surface): New procedure. * sdl2/surface.scm (blit-surface): New procedure. --- sdl2/bindings.scm | 3 +++ sdl2/surface.scm | 17 ++++++++++++++++- 2 files changed, 19 insertions(+), 1 deletion(-) (limited to 'sdl2') diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm index 84e49b8..7c16abb 100644 --- a/sdl2/bindings.scm +++ b/sdl2/bindings.scm @@ -943,6 +943,9 @@ RETURN-TYPE and accept arguments of ARG-TYPES." (define-foreign sdl-convert-surface-format '* "SDL_ConvertSurfaceFormat" (list '* uint32 uint32)) +(define-foreign sdl-blit-surface + int "SDL_UpperBlit" '(* * * *)) + ;;; ;;; Audio diff --git a/sdl2/surface.scm b/sdl2/surface.scm index bcdb588..a918bd7 100644 --- a/sdl2/surface.scm +++ b/sdl2/surface.scm @@ -63,7 +63,8 @@ surface-height surface-pitch surface-pixels - convert-surface-format)) + convert-surface-format + blit-surface)) ;;; @@ -434,3 +435,17 @@ Valid format types are: (if (null-pointer? ptr) (sdl-error "convert-surface-format" "failed to convert surface format") (wrap-surface ptr)))) + +(define (blit-surface src src-rect dst dst-rect) + "Blit the rectangle SRC-RECT from the surface SRC to DST-RECT of the +surface DST." + (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-surface" "failed to blit surface ~a to ~a" src dst))) -- cgit v1.2.3