render: asset: Add material texture parsing and loading.

* chickadee/render/asset.scm (read-gltf): Parse and load all textures
referenced by materials.

1 files changed, 103 insertions, 54 deletions

diff --git a/chickadee/render/asset.scm b/chickadee/render/asset.scm
index 57ec95b..20034dd 100644
--- a/chickadee/render/asset.scm
+++ b/chickadee/render/asset.scm
@@ -25,10 +25,11 @@
   #:use-module (chickadee json)
   #:use-module (chickadee math matrix)
   #:use-module (chickadee math vector)
+  #:use-module (chickadee render buffer)
   #:use-module (chickadee render color)
   #:use-module (chickadee render scene)
   #:use-module (chickadee render shader)
-  #:use-module (chickadee render buffer)
+  #:use-module (chickadee render texture)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (rnrs base)
@@ -242,69 +243,111 @@
                          #:max max
                          #:min min
                          #:sparse sparse)))
-  ;; TODO: Parse textures.
-  (define (parse-metallic-roughness obj)
-    (let ((base-color
-           (assert-color
-            (or (number-array-ref/optional obj "baseColorFactor")
-                #(1.0 1.0 1.0 1.0))))
-          (base-color-texture #f)
-          (metallic-factor (or (number-ref/optional obj "metallicFactor")
-                               1.0))
-          (roughness-factor (or (number-ref/optional obj "roughnessFactor")
-                                1.0))
-          (texture #f))
-      (make-metallic-roughness #:base-color base-color
-                               #:base-color-texture base-color-texture
-                               #:metallic-factor metallic-factor
-                               #:roughness-factor roughness-factor
-                               #:texture texture)))
-  (define (parse-material obj)
-    (let ((name (or (string-ref/optional obj "name") "anonymous"))
-          (metallic-roughness
-           (match (object-ref/optional obj "pbrMetallicRoughness")
-             (#f #f)
-             (obj (parse-metallic-roughness obj))))
-          (normal-texture
-           (match (object-ref/optional obj "normalTexture")
-             (#f #f)
-             (obj #f)))
-          (occlusion-texture
-           (match (object-ref/optional obj "occlusionTexture")
-             (#f #f)
-             (obj #f)))
-          (emissive-texture
-           (match (object-ref/optional obj "emissiveTexture")
-             (#f #f)
-             (obj #f)))
-          (emissive-factor
-           (let ((v (or (array-ref/optional obj "emissiveFactor")
-                        #(0.0 0.0 0.0))))
-             (vec3 (vector-ref v 0) (vector-ref v 1) (vector-ref v 2))))
-          (alpha-mode (match (or (string-ref/optional obj "alphaMode")
-                                 "OPAQUE")
-                        ("OPAQUE" 'opaque)
-                        ("MASK" 'mask)
-                        ("BLEND" 'blend)))
-          (alpha-cutoff (or (number-ref/optional obj "alphaCutoff") 0.5))
-          (double-sided? (boolean-ref/optional obj "doubleSided"))
-          (extensions (object-ref/optional obj "extensions"))
-          (extras (assoc-ref obj "extras")))
+  (define (texture-filter n)
+    (match n
+      (9728 'nearest)
+      ((or #f 9729) 'linear)
+      (9984 'nearest-mipmap-nearest)
+      (9985 'linear-mipmap-nearest)
+      (9986 'nearest-mipmap-linear)
+      (9987 'linear-mipmap-linear)))
+  (define (texture-wrap n)
+    (match n
+      (10496 'clamp)
+      ((or #f 10497) 'repeat)
+      (33069 'clamp-to-border)
+      (33071 'clamp-to-edge)))
+  (define (parse-texture obj images samplers)
+    (let ((image (vector-ref images (number-ref obj "source")))
+          (sampler (vector-ref samplers (number-ref obj "sampler"))))
+      (load-image (scope-file (string-ref image "uri"))
+                  #:min-filter (texture-filter
+                                (number-ref/optional sampler "minFilter"))
+                  #:mag-filter (texture-filter
+                                (number-ref/optional sampler "magFilter"))
+                  #:wrap-s (texture-wrap (number-ref/optional sampler "wrapS"))
+                  #:wrap-t (texture-wrap (number-ref/optional sampler "wrapT")))))
+  (define (parse-material obj textures)
+    (let* ((name (or (string-ref/optional obj "name") "anonymous"))
+           (pbrmr (or (object-ref/optional obj "pbrMetallicRoughness") '()))
+           (base-color-factor
+            (let ((v (or (number-array-ref/optional pbrmr "baseColorFactor")
+                         #(1.0 1.0 1.0 1.0))))
+              (vec3 (vector-ref v 0) (vector-ref v 1) (vector-ref v 2))))
+           (base-color-texture
+            (match (object-ref/optional pbrmr "baseColorTexture")
+              (#f null-texture)
+              (obj
+               (vector-ref textures (number-ref obj "index")))))
+           (metallic-factor
+            (or (number-ref/optional pbrmr "metallicFactor")
+                1.0))
+           (roughness-factor
+            (or (number-ref/optional pbrmr "roughnessFactor")
+                1.0))
+           (metallic-roughness-texture
+            (match (object-ref/optional pbrmr "metallicRoughnessTexture")
+              (#f null-texture)
+              (obj
+               (vector-ref textures (number-ref obj "index")))))
+           (normal-factor
+            (let ((v (or (array-ref/optional obj "normalFactor")
+                         #(0.0 0.0 0.0))))
+              (vec3 (vector-ref v 0) (vector-ref v 1) (vector-ref v 2))))
+           (normal-texture
+            (match (object-ref/optional obj "normalTexture")
+              (#f null-texture)
+              (obj (vector-ref textures (number-ref obj "index")))))
+           (occlusion-factor
+            (let ((v (or (array-ref/optional obj "occlusionFactor")
+                         #(0.0 0.0 0.0))))
+              (vec3 (vector-ref v 0) (vector-ref v 1) (vector-ref v 2))))
+           (occlusion-texture
+            (match (object-ref/optional obj "occlusionTexture")
+              (#f null-texture)
+              (obj (vector-ref textures (number-ref obj "index")))))
+           (emissive-factor
+            (let ((v (or (array-ref/optional obj "emissiveFactor")
+                         #(0.0 0.0 0.0))))
+              (vec3 (vector-ref v 0) (vector-ref v 1) (vector-ref v 2))))
+           (emissive-texture
+            (match (object-ref/optional obj "emissiveTexture")
+              (#f null-texture)
+              (obj (vector-ref textures (number-ref obj "index")))))
+           (alpha-mode (match (or (string-ref/optional obj "alphaMode")
+                                  "BLEND")
+                         ("OPAQUE" 'opaque)
+                         ("MASK" 'mask)
+                         ("BLEND" 'blend)))
+           (alpha-cutoff (or (number-ref/optional obj "alphaCutoff") 0.5))
+           (double-sided? (boolean-ref/optional obj "doubleSided"))
+           (extensions (object-ref/optional obj "extensions"))
+           (extras (assoc-ref obj "extras")))
       (make-material #:name name
-                     #:metallic-roughness metallic-roughness
+                     #:base-color-factor base-color-factor
+                     #:base-color-texture base-color-texture
+                     #:metallic-factor metallic-factor
+                     #:roughness-factor roughness-factor
+                     #:metallic-roughness-texture metallic-roughness-texture
+                     #:normal-factor normal-factor
                      #:normal-texture normal-texture
+                     #:occlusion-factor occlusion-factor
                      #:occlusion-texture occlusion-texture
-                     #:emissive-texture emissive-texture
                      #:emissive-factor emissive-factor
+                     #:emissive-texture emissive-texture
                      #:alpha-mode alpha-mode
                      #:alpha-cutoff alpha-cutoff
                      #:double-sided? double-sided?)))
   (define (attribute-name->index name)
     (match name
-      ("POSITION" (attribute-location (hash-ref (shader-attributes (pbr-shader)) "position")))
+      ("POSITION"
+       (attribute-location
+        (hash-ref (shader-attributes (pbr-shader)) "position")))
       ("NORMAL" 1)
       ("TANGENT" 2)
-      ("TEXCOORD_0" 3)
+      ("TEXCOORD_0"
+       (attribute-location
+        (hash-ref (shader-attributes (pbr-shader)) "texcoord_0")))
       ("TEXCOORD_1" 4)
       ("COLOR_0" 5)
       ("JOINTS_0" 6)
@@ -420,7 +463,13 @@
          (accessors (vector-map (lambda (obj)
                                   (parse-accessor obj buffer-views))
                                 (or (assoc-ref tree "accessors") #())))
-         (materials (vector-map parse-material
+         (images (pk 'sources (or (assoc-ref tree "images") #())))
+         (samplers (pk 'samplers (or (assoc-ref tree "samplers") #())))
+         (textures (vector-map (lambda (obj)
+                                 (parse-texture obj images samplers))
+                               (or (assoc-ref tree "textures") #())))
+         (materials (vector-map (lambda (obj)
+                                  (parse-material obj textures))
                                 (or (assoc-ref tree "materials") #())))
          (meshes (vector-map (lambda (obj)
                                (parse-mesh obj materials accessors))