From a1fe5d2aa86f3c25fb88313fe4ebd4f53d3f8ed3 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 16 Dec 2016 15:52:39 -0500
Subject: surface: Add SDL_CreateRGBSurface binding.

---
 sdl2/bindings.scm |  4 ++++
 sdl2/surface.scm  | 19 ++++++++++++++++++-
 2 files changed, 22 insertions(+), 1 deletion(-)

(limited to 'sdl2')

diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index e394586..ceabf06 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -899,6 +899,10 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
 ;;; Surface
 ;;;
 
+(define-foreign sdl-create-rgb-surface
+  '* "SDL_CreateRGBSurface"
+  (list uint32 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 4eb5212..919c6c3 100644
--- a/sdl2/surface.scm
+++ b/sdl2/surface.scm
@@ -30,7 +30,8 @@
   #:use-module (system foreign)
   #:use-module ((sdl2 bindings) #:prefix ffi:)
   #:use-module (sdl2)
-  #:export (surface?
+  #:export (make-rgb-surface
+            surface?
             delete-surface!
             call-with-surface
             load-bmp
@@ -48,6 +49,22 @@
     (format port "#<surface ~x>"
             (pointer-address (unwrap-surface surface)))))
 
+(define (make-rgb-surface width height depth)
+  "Create a new SDL surface with the dimensions WIDTH and HEIGHT and
+DEPTH bits per pixel."
+  (wrap-surface
+   (if (eq? (native-endianness) 'big)
+       (ffi:sdl-create-rgb-surface 0 width height depth
+                                   #xff000000
+                                   #x00ff0000
+                                   #x0000ff00
+                                   #x000000ff)
+       (ffi:sdl-create-rgb-surface 0 width height depth
+                                   #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