From a2b8006c27d6ad8d7af701b94e869ab39c3a7ad4 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 5 May 2021 18:49:31 -0400
Subject: graphics: model: Add crude support for base64 glTF buffer data.

---
 chickadee/graphics/model.scm | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/chickadee/graphics/model.scm b/chickadee/graphics/model.scm
index 92be430..3024673 100644
--- a/chickadee/graphics/model.scm
+++ b/chickadee/graphics/model.scm
@@ -23,6 +23,7 @@
 
 (define-module (chickadee graphics model)
   #:use-module (chickadee array-list)
+  #:use-module (chickadee base64)
   #:use-module (chickadee json)
   #:use-module (chickadee math matrix)
   #:use-module (chickadee math vector)
@@ -641,7 +642,7 @@
       value))
   (define (object-ref/optional obj key)
     (let ((value (assoc-ref obj key)))
-      (unless (or (not value) (pair? value))
+      (unless (or (not value) (pair? value) (null? value))
         (error "expected object for optional key" key value))
       value))
   (define (array-ref obj key)
@@ -728,8 +729,8 @@
         (if (absolute-file-name? other-file)
             other-file
             (string-append gltf-root "/" other-file)))))
+  (define base64-prefix "data:application/octet-stream;base64,")
   (define (parse-buffer obj)
-    ;; TODO: support base64 encoded buffer data as uri
     ;; TODO: support glb-stored buffers:
     ;;   https://github.com/KhronosGroup/glTF/blob/master/specification/2.0/README.md#glb-stored-buffer
     (let* ((uri (string-ref/optional obj "uri"))
@@ -737,11 +738,15 @@
            (name (or (string-ref/optional obj "name") "anonymous"))
            (extensions (object-ref/optional obj "extensions"))
            (extras (assoc-ref obj "extras"))
-           (data (if uri
-                     (call-with-input-file (scope-file uri)
-                       (lambda (port)
-                         (get-bytevector-n port length)))
-                     (make-bytevector length))))
+           (data (cond
+                  ((string-prefix? base64-prefix uri)
+                   (base64-decode (substring uri (string-length base64-prefix))))
+                  (uri
+                   (call-with-input-file (scope-file uri)
+                     (lambda (port)
+                       (get-bytevector-n port length))))
+                  (else
+                   (make-bytevector length)))))
       data))
   (define (parse-buffer-view obj buffers)
     (let ((name (string-ref/optional obj "name"))
-- 
cgit v1.2.3