From db2c6ec9bc4d6b0026084b07705d421621858a48 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 25 Mar 2023 14:16:07 -0400
Subject: graphics: texture: make-texture now expects a pixbuf.

---
 chickadee/graphics/text.scm    |  3 ++-
 chickadee/graphics/texture.scm | 39 +++++++++++++++++++++------------------
 2 files changed, 23 insertions(+), 19 deletions(-)

(limited to 'chickadee')

diff --git a/chickadee/graphics/text.scm b/chickadee/graphics/text.scm
index ca33cb7..f1d4359 100644
--- a/chickadee/graphics/text.scm
+++ b/chickadee/graphics/text.scm
@@ -39,6 +39,7 @@
   #:use-module (chickadee math matrix)
   #:use-module (chickadee math rect)
   #:use-module (chickadee math vector)
+  #:use-module (chickadee pixbuf)
   #:use-module (chickadee graphics blend)
   #:use-module (chickadee graphics color)
   #:use-module (chickadee graphics engine)
@@ -198,7 +199,7 @@ non-smooth scaling will be used."
                char-set))
              (texture-filter (if smooth? 'linear 'nearest))
              ;; TODO: Use multiple textures if needed.
-             (texture (make-texture pixels texture-size texture-size
+             (texture (make-texture (bytevector->pixbuf pixels texture-size texture-size)
                                     #:min-filter texture-filter
                                     #:mag-filter texture-filter)))
         ;; Process kernings.
diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm
index af36703..dc002b9 100644
--- a/chickadee/graphics/texture.scm
+++ b/chickadee/graphics/texture.scm
@@ -229,7 +229,7 @@
     ((rgba)
      (pixel-format rgba))))
 
-(define* (make-texture pixels width height #:key
+(define* (make-texture pixbuf #:key
                        flip?
                        (min-filter 'nearest)
                        (mag-filter 'nearest)
@@ -248,13 +248,15 @@ symbols are: repeat (the default), mirrored-repeat, clamp,
 clamp-to-border, clamp-to-edge.  FORMAT specifies the pixel format.
 Currently only 32-bit RGBA format is supported."
   (assert-current-graphics-engine)
-  (let ((texture (%make-texture (gl-generate-texture) '2d #f
-                                min-filter mag-filter wrap-s wrap-t
-                                0 0 width height
-                                (make-rect 0.0 0.0 width height)
-                                (if flip?
-                                    (make-rect 0.0 1.0 1.0 -1.0)
-                                    (make-rect 0.0 0.0 1.0 1.0)))))
+  (let* ((width (pixbuf-width pixbuf))
+         (height (pixbuf-height pixbuf))
+         (texture (%make-texture (gl-generate-texture) '2d #f
+                                 min-filter mag-filter wrap-s wrap-t
+                                 0 0 width height
+                                 (make-rect 0.0 0.0 width height)
+                                 (if flip?
+                                     (make-rect 0.0 1.0 1.0 -1.0)
+                                     (make-rect 0.0 0.0 1.0 1.0)))))
     (graphics-engine-guard! texture)
     (with-graphics-state! ((g:texture-0 texture))
       ;; Ensure that we are using texture unit 0 because
@@ -276,7 +278,7 @@ Currently only 32-bit RGBA format is supported."
                            0 (pixel-format rgba) width height 0
                            (gl-pixel-format format)
                            (color-pointer-type unsigned-byte)
-                           (or pixels %null-pointer))
+                           (pixbuf-pixels pixbuf))
       ;; Generate mipmaps, if needed.
       (when (memq min-filter
                   '(nearest-mipmap-nearest
@@ -400,9 +402,7 @@ that should be used for minification and magnification.  Valid values
 are 'nearest and 'linear.  By default, 'nearest is used."
   (let* ((image* (if (image? image) image (make-image image)))
          (pixbuf (%load-image image* transparent-color flip?)))
-    (make-texture (pixbuf-pixels pixbuf)
-                  (pixbuf-width pixbuf)
-                  (pixbuf-height pixbuf)
+    (make-texture pixbuf
                   #:min-filter min-filter
                   #:mag-filter mag-filter
                   #:wrap-s wrap-s
@@ -448,16 +448,18 @@ are 'nearest and 'linear.  By default, 'nearest is used."
 
 (define %white-texture
   (delay
-    (make-texture (u32vector #xffffffff #xffffffff #xffffffff #xffffffff)
-                  2 2)))
+    (make-texture
+     (bytevector->pixbuf (u32vector #xffffffff #xffffffff #xffffffff #xffffffff)
+                         2 2))))
 
 (define (white-texture)
   (force %white-texture))
 
 (define %gray-texture
   (delay
-    (make-texture (u32vector #xff808080 #xff808080 #xff808080 #xff808080)
-                  2 2)))
+    (make-texture
+     (bytevector->pixbuf (u32vector #xff808080 #xff808080 #xff808080 #xff808080)
+                         2 2))))
 
 (define (gray-texture)
   (force %gray-texture))
@@ -473,8 +475,9 @@ are 'nearest and 'linear.  By default, 'nearest is used."
 ;; unchanged by this normal map.
 (define %flat-texture
   (delay
-    (make-texture (u32vector #xffff8080 #xffff8080 #xffff8080 #xffff8080)
-     2 2)))
+    (make-texture
+     (bytevector->pixbuf (u32vector #xffff8080 #xffff8080 #xffff8080 #xffff8080)
+                         2 2))))
 
 (define (flat-texture)
   (force %flat-texture))
-- 
cgit v1.2.3