From 2fb7f399f322122f2d5e5f436673fe386242505e Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 16 Dec 2016 21:49:11 -0500
Subject: surface: Add SDL_CreateRGBSurfaceFrom binding.

---
 sdl2/bindings.scm |  4 ++++
 sdl2/surface.scm  | 20 ++++++++++++++++++++
 2 files changed, 24 insertions(+)

(limited to 'sdl2')

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)))
-- 
cgit v1.2.3