From 9394b9f1a100cc7ecdf024c0c525e535b0301cd3 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 17 Dec 2021 08:57:30 -0500
Subject: Remove dependence on SDL2_image and use our own JPEG/PNG loading.

---
 chickadee/graphics/texture.scm | 68 ++++++++++++++++++++++++------------------
 guix.scm                       |  6 ++--
 2 files changed, 42 insertions(+), 32 deletions(-)

diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm
index e9a13ae..8b61af6 100644
--- a/chickadee/graphics/texture.scm
+++ b/chickadee/graphics/texture.scm
@@ -16,20 +16,23 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (chickadee graphics texture)
+  #:use-module (ice-9 exceptions)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-11)
   #:use-module (system foreign)
   #:use-module (gl)
   #:use-module ((gl enums) #:prefix gl:)
-  #:use-module ((sdl2 image) #:prefix sdl2:)
-  #:use-module ((sdl2 surface) #:prefix sdl2:)
   #:use-module (chickadee math rect)
   #:use-module (chickadee graphics color)
   #:use-module (chickadee graphics engine)
   #:use-module (chickadee graphics gl)
+  #:use-module (chickadee image jpeg)
+  #:use-module (chickadee image png)
   #:use-module (chickadee utils)
   #:export (make-texture
             make-texture-region
@@ -389,34 +392,41 @@ HEIGHT, 32 bit color bytevector."
         (bytevector-copy! pixels source-start buffer target-start row-width)))
     buffer))
 
+(define (file-extension file-name)
+  (last (string-split file-name #\.)))
+
 (define (call-with-loaded-image file-name transparent-color flip? proc)
-  (sdl2:call-with-surface (sdl2:load-image file-name)
-    (lambda (surface)
-      (sdl2:call-with-surface (sdl2:convert-surface-format surface 'abgr8888)
-        (lambda (surface)
-          (let ((width (sdl2:surface-width surface))
-                (height (sdl2:surface-height surface))
-                (pixels (sdl2:surface-pixels surface)))
-            ;; Zero the alpha channel of pixels that match the transparent
-            ;; color key.
-            (when transparent-color
-              (let ((r (inexact->exact (* (color-r transparent-color) 255)))
-                    (g (inexact->exact (* (color-g transparent-color) 255)))
-                    (b (inexact->exact (* (color-b transparent-color) 255)))
-                    (pixel-count (* width height 4)))
-                (for-range ((i pixel-count 0 4))
-                  (when (and (= r (bytevector-u8-ref pixels i))
-                             (= g (bytevector-u8-ref pixels (+ i 1)))
-                             (= b (bytevector-u8-ref pixels (+ i 2))))
-                    (bytevector-u8-set! pixels (+ i 3) 0)))))
-            (proc (if flip?
-                      (flip-pixels-vertically pixels width height)
-                      ;; Need to copy the pixels for some reason.
-                      ;; Noticed when implementing cube maps when all
-                      ;; 6 texture pieces were all showing up as the
-                      ;; last image loaded.
-                      (bytevector-copy pixels))
-                  width height)))))))
+  (let-values (((pixels width height)
+                (match (file-extension file-name)
+                  ((or "jpg" "jpeg")
+                   (load-jpeg file-name))
+                  ("png"
+                   (load-png file-name))
+                  (_
+                   (raise-exception
+                    (make-exception-with-message
+                     (string-append "image type not supported: "
+                                    file-name)))))))
+    ;; Zero the alpha channel of pixels that match the transparent
+    ;; color key.
+    (when transparent-color
+      (let ((r (inexact->exact (* (color-r transparent-color) 255)))
+            (g (inexact->exact (* (color-g transparent-color) 255)))
+            (b (inexact->exact (* (color-b transparent-color) 255)))
+            (pixel-count (* width height 4)))
+        (for-range ((i pixel-count 0 4))
+          (when (and (= r (bytevector-u8-ref pixels i))
+                     (= g (bytevector-u8-ref pixels (+ i 1)))
+                     (= b (bytevector-u8-ref pixels (+ i 2))))
+            (bytevector-u8-set! pixels (+ i 3) 0)))))
+    (proc (if flip?
+              (flip-pixels-vertically pixels width height)
+              ;; Need to copy the pixels for some reason.
+              ;; Noticed when implementing cube maps when all
+              ;; 6 texture pieces were all showing up as the
+              ;; last image loaded.
+              (bytevector-copy pixels))
+          width height)))
 
 (define* (load-image file #:key
                      (min-filter 'nearest)
diff --git a/guix.scm b/guix.scm
index 295ae85..d079ebd 100644
--- a/guix.scm
+++ b/guix.scm
@@ -108,12 +108,12 @@
          #:phases
          (modify-phases %standard-phases
            (add-after 'unpack 'bootstrap
-                      (lambda _
-                        (zero? (system* "sh" "bootstrap")))))))
+             (lambda _
+               (zero? (system* "sh" "bootstrap")))))))
       (native-inputs
        (list autoconf automake pkg-config texinfo))
       (inputs
-       (list target-guile sdl2 sdl2-image))
+       (list target-guile sdl2))
       (synopsis "Guile bindings for SDL2")
       (description "Guile-sdl2 provides pure Guile Scheme bindings to the
 SDL2 C shared library via the foreign function interface.")
-- 
cgit v1.2.3