From 8ec62773bb883dbf0ff143782fb4ae458cc89260 Mon Sep 17 00:00:00 2001
From: David Thompson <dave@izanagi>
Date: Sun, 16 Jun 2013 15:47:40 -0400
Subject: Add support for creating textures from RGB and RGBA surfaces.

---
 2d/texture.scm | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

diff --git a/2d/texture.scm b/2d/texture.scm
index 50ac21e..7a3a60d 100644
--- a/2d/texture.scm
+++ b/2d/texture.scm
@@ -43,10 +43,19 @@
   (width texture-width)
   (height texture-height))
 
+(define (surface-pixel-format surface)
+  "Returns the OpenGL pixel format for a surface. RGB and RGBA formats
+are supported."
+  (case (SDL:surface:depth surface)
+    ((24) (pixel-format rgb))
+    ((32) (pixel-format rgba))
+    (else (throw 'unsupported-pixel-format))))
+
 (define (surface->texture surface)
   "Translates an SDL surface into an OpenGL texture.
 Currently only works with RGBA format surfaces."
-  (let* ((texture-id (gl-generate-texture)))
+  (let ((texture-id (gl-generate-texture))
+        (pixel-format (surface-pixel-format surface)))
     (with-gl-bind-texture (texture-target texture-2d) texture-id
       (gl-texture-parameter (texture-target texture-2d)
                             (texture-parameter-name texture-min-filter)
@@ -56,11 +65,11 @@ Currently only works with RGBA format surfaces."
                             (texture-mag-filter linear))
       (gl-texture-image-2d (texture-target texture-2d)
                            0
-                           (pixel-format rgba)
+                           pixel-format
                            (SDL:surface:w surface)
                            (SDL:surface:h surface)
                            0
-                           (pixel-format rgba)
+                           pixel-format
                            (color-pointer-type unsigned-byte)
                            (SDL:surface-pixels surface)))
     (make-texture texture-id
-- 
cgit v1.2.3