diff options
| author | David Thompson <dthompson2@worcester.edu> | 2016-12-16 21:49:11 -0500 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2016-12-16 21:52:36 -0500 |
| commit | 2fb7f399f322122f2d5e5f436673fe386242505e (patch) | |
| tree | 712fa4458c551c9630afc7c465a4a9bd96bd2ac8 | |
| parent | a1fe5d2aa86f3c25fb88313fe4ebd4f53d3f8ed3 (diff) | |
surface: Add SDL_CreateRGBSurfaceFrom binding.
| -rw-r--r-- | sdl2/bindings.scm | 4 | ||||
| -rw-r--r-- | sdl2/surface.scm | 20 |
2 files changed, 24 insertions, 0 deletions
diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm index ceabf06..e3167a0 100644 --- a/sdl2/bindings.scm +++ b/sdl2/bindings.scm @@ -903,6 +903,10 @@ RETURN-TYPE and accept arguments of ARG-TYPES." '* "SDL_CreateRGBSurface" (list uint32 int int int uint32 uint32 uint32 uint32)) +(define-foreign sdl-create-rgb-surface-from + '* "SDL_CreateRGBSurfaceFrom" + (list '* int int int int uint32 uint32 uint32 uint32)) + (define-foreign sdl-free-surface void "SDL_FreeSurface" '(*)) diff --git a/sdl2/surface.scm b/sdl2/surface.scm index 919c6c3..8017d78 100644 --- a/sdl2/surface.scm +++ b/sdl2/surface.scm @@ -31,6 +31,7 @@ #:use-module ((sdl2 bindings) #:prefix ffi:) #:use-module (sdl2) #:export (make-rgb-surface + bytevector->surface surface? delete-surface! call-with-surface @@ -65,6 +66,25 @@ DEPTH bits per pixel." #x00ff0000 #xff000000)))) +(define (bytevector->surface bv width height depth pitch) + "Convert BV, a bytevector of pixel data with dimenions WIDTHxHEIGHT, +to an SDL surface. Each pixel is DEPTH bits in size, and each row of +pixels is PITCH bytes in size." + (wrap-surface + (if (eq? (native-endianness) 'big) + (ffi:sdl-create-rgb-surface-from (bytevector->pointer bv) + width height depth pitch + #xff000000 + #x00ff0000 + #x0000ff00 + #x000000ff) + (ffi:sdl-create-rgb-surface-from (bytevector->pointer bv) + width height depth pitch + #x000000ff + #x0000ff00 + #x00ff0000 + #xff000000)))) + (define (delete-surface! surface) "Free the memory used by SURFACE." (ffi:sdl-free-surface (unwrap-surface surface))) |