Add beginnings of glTF parser and loader.

* chickadee/render/asset.scm: New file.
* chickadee/render/scene.scm: New file.
* data/shaders/pbr/pbr-frag.glsl: New file.
* data/shaders/pbr/pbr-vert.glsl: New file.

5 files changed, 704 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index b8e6f19..e80bb90 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -66,6 +66,8 @@ SOURCES = 					\
   chickadee/render/shapes.scm			\
   chickadee/render/sprite.scm			\
   chickadee/render/font.scm			\
+  chickadee/render/scene.scm			\
+  chickadee/render/asset.scm			\
   chickadee/render.scm				\
   chickadee/window.scm				\
   chickadee/scripting/agenda.scm		\
@@ -88,6 +90,11 @@ EXTRA_DIST += 					\
   examples/fonts/good_neighbors_starling.png	\
   examples/fonts/good_neighbors_starling.xml
 
+shadersdir = $(pkgdatadir)/shaders
+dist_shaders_DATA = 				\
+  data/shaders/pbr/pbr-vert.glsl			\
+  data/shaders/pbr/pbr-frag.glsl
+
 info_TEXINFOS = doc/chickadee.texi
 
 chickadee_TEXINFOS =				\
diff --git a/chickadee/render/asset.scm b/chickadee/render/asset.scm
new file mode 100644
index 0000000..57ec95b
--- /dev/null
+++ b/chickadee/render/asset.scm
@@ -0,0 +1,441 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2017 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Implementation of the glTF 2.0 specification
+;;
+;;; Code:
+
+(define-module (chickadee render asset)
+  #:use-module (chickadee json)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render color)
+  #:use-module (chickadee render scene)
+  #:use-module (chickadee render shader)
+  #:use-module (chickadee render buffer)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs base)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module ((srfi srfi-43) #:select (vector-every))
+  #:export (load-asset
+            asset?
+            asset-copyright
+            asset-generator
+            asset-scenes
+            asset-default-scene
+            draw-asset))
+
+(define-record-type <asset>
+  (make-asset copyright generator scenes default-scene)
+  asset?
+  (copyright asset-copyright)
+  (generator asset-generator)
+  (scenes asset-scenes)
+  (default-scene asset-default-scene))
+
+(define (display-asset asset port)
+  (format port "#<asset generator: ~s scene: ~s>"
+          (asset-generator asset)
+          (scene-name (asset-default-scene asset))))
+
+(set-record-type-printer! <asset> display-asset)
+
+(define (read-gltf port file)
+  (define (object-ref obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (pair? value)
+        (error "expected object for key" key value))
+      value))
+  (define (object-ref/optional obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (or (not value) (pair? value))
+        (error "expected object for optional key" key value))
+      value))
+  (define (array-ref obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (vector? value)
+        (error "expected array for key" key value))
+      value))
+  (define (array-ref/optional obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (or (not value) (vector? value))
+        (error "expected array for optional key" key value))
+      value))
+  (define (string-ref obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (string? value)
+        (error "expected string for key" key value))
+      value))
+  (define (string-ref/optional obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (or (not value) (string? value))
+        (error "expected string for optional key" key value))
+      value))
+  (define (number-ref obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (number? value)
+        (error "expected number for key" key value))
+      value))
+  (define (number-ref/optional obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (or (not value) (number? value))
+        (error "expected number for key" key value))
+      value))
+  (define (boolean-ref/optional obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (boolean? value)
+        (error "expected boolean for key" key value))
+      value))
+  (define (number-array-ref/optional obj key)
+    (let ((value (assoc-ref obj key)))
+      (unless (or (not value)
+                  (and (vector? value) (vector-every number? value)))
+        (error "expected numeric array for key" key value))
+      value))
+  (define (matrix-ref/optional obj key)
+    (let ((value (assoc-ref obj key)))
+      (cond
+       ((not value) #f)
+       ((and (vector? value)
+             (= (vector-length value) 16)
+             (vector-every number? value))
+        ;; glTF matrices are in column-major order.
+        (make-matrix4 (vector-ref value 0)
+                      (vector-ref value 4)
+                      (vector-ref value 8)
+                      (vector-ref value 12)
+                      (vector-ref value 1)
+                      (vector-ref value 5)
+                      (vector-ref value 9)
+                      (vector-ref value 13)
+                      (vector-ref value 2)
+                      (vector-ref value 6)
+                      (vector-ref value 10)
+                      (vector-ref value 14)
+                      (vector-ref value 3)
+                      (vector-ref value 7)
+                      (vector-ref value 11)
+                      (vector-ref value 15)))
+       (else
+        (error "expected 4x4 matrix for key" key value)))))
+  (define (assert-color v)
+    (if (and (= (vector-length v) 4)
+             (vector-every (lambda (x) (and (>= x 0.0) (<= x 1.0))) v))
+        (make-color (vector-ref v 0)
+                    (vector-ref v 1)
+                    (vector-ref v 2)
+                    (vector-ref v 3))
+        (error "not a color vector" v)))
+  (define scope-file
+    (let ((gltf-root (dirname
+                      (if (absolute-file-name? file)
+                          file
+                          (string-append (getcwd) "/" file)))))
+      (lambda (file)
+        (if (absolute-file-name? file)
+            file
+            (string-append gltf-root "/" file)))))
+  (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"))
+           (length (number-ref obj "byteLength"))
+           (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))
+  (define (parse-buffer-view obj buffers)
+    (let ((name (string-ref/optional obj "name"))
+          (data (vector-ref buffers (number-ref obj "buffer")))
+          (offset (or (number-ref/optional obj "byteOffset") 0))
+          (length (number-ref obj "byteLength"))
+          (stride (number-ref/optional obj "byteStride"))
+          (target (match (or (number-ref/optional obj "target") 34962)
+                    (34962 'vertex)
+                    (34963 'index)))
+          (extensions (object-ref/optional obj "extensions"))
+          (extras (assoc-ref obj "extras")))
+      (make-buffer data
+                   #:name name
+                   #:offset offset
+                   #:length length
+                   #:stride stride
+                   #:target target)))
+  (define (parse-accessor obj buffer-views)
+    (define (type-length type)
+      (match type
+        ('scalar 1)
+        ('vec2 2)
+        ('vec3 3)
+        ('vec4 4)
+        ('mat2 4)
+        ('mat3 9)
+        ('mat4 16)))
+    (let ((name (or (string-ref/optional obj "name") "anonymous"))
+          (view (match (number-ref/optional obj "bufferView")
+                  (#f #f)
+                  (n (vector-ref buffer-views n))))
+          (offset (or (number-ref/optional obj "byteOffset") 0))
+          (component-type (match (number-ref obj "componentType")
+                            (5120 'byte)
+                            (5121 'unsigned-byte)
+                            (5122 'short)
+                            (5123 'unsigned-short)
+                            (5125 'unsigned-int)
+                            (5126 'float)))
+          (normalized? (boolean-ref/optional obj "normalized"))
+          (length (number-ref obj "count"))
+          (type (match (string-ref obj "type")
+                  ("SCALAR" 'scalar)
+                  ("VEC2" 'vec2)
+                  ("VEC3" 'vec3)
+                  ("VEC4" 'vec4)
+                  ("MAT2" 'mat2)
+                  ("MAT3" 'mat3)
+                  ("MAT4" 'mat4)))
+          (max (number-array-ref/optional obj "max"))
+          (min (number-array-ref/optional obj "min"))
+          (sparse (object-ref/optional obj "sparse"))
+          (extensions (object-ref/optional obj "extensions"))
+          (extras (assoc-ref obj "extras")))
+      (unless (>= length 1)
+        (error "count must be greater than 0" length))
+      (when (and (vector? max)
+                 (not (= (vector-length max) (type-length type))))
+        (error "not enough elements for max" max type))
+      (when (and (vector? min)
+                 (not (= (vector-length min) (type-length type))))
+        (error "not enough elements for min" min type))
+      (make-typed-buffer #:name name
+                         #:buffer view
+                         #:offset offset
+                         #:component-type component-type
+                         #:normalized? normalized?
+                         #:length length
+                         #:type type
+                         #: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")))
+      (make-material #:name name
+                     #:metallic-roughness metallic-roughness
+                     #:normal-texture normal-texture
+                     #:occlusion-texture occlusion-texture
+                     #:emissive-texture emissive-texture
+                     #:emissive-factor emissive-factor
+                     #: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")))
+      ("NORMAL" 1)
+      ("TANGENT" 2)
+      ("TEXCOORD_0" 3)
+      ("TEXCOORD_1" 4)
+      ("COLOR_0" 5)
+      ("JOINTS_0" 6)
+      ("WEIGHTS_0" 7)))
+  (define (parse-primitive obj materials accessors)
+    (let ((attributes (map (match-lambda
+                             ((name . n)
+                              (cons (attribute-name->index name)
+                                    (vector-ref accessors n))))
+                           (object-ref obj "attributes")))
+          (indices (match (number-ref/optional obj "indices")
+                     (#f #f)
+                     (n (vector-ref accessors n))))
+          ;; TODO: Set a default material when none is given.
+          (material (match (number-ref/optional obj "material")
+                      (#f #f)
+                      (n (vector-ref materials n))))
+          (mode (match (or (number-ref/optional obj "mode") 4)
+                  (0 'points)
+                  (1 'lines)
+                  (2 'line-loop)
+                  (3 'line-strip)
+                  (4 'triangles)
+                  (5 'triangle-strip)
+                  (6 'triangle-fan)))
+          ;; TODO: Support morph targets.
+          (targets #f))
+      (make-primitive #:vertex-array
+                      (make-vertex-array #:indices indices
+                                         #:attributes attributes
+                                         #:mode mode)
+                      #:material material
+                      #:targets targets)))
+  (define (parse-mesh obj materials accessors)
+    (let ((name (or (string-ref/optional obj "name") "anonymous"))
+          (primitives
+           (map (lambda (obj)
+                  (parse-primitive obj materials accessors))
+                (vector->list (array-ref obj "primitives"))))
+          (weights (number-array-ref/optional obj "weights")))
+      (make-mesh #:name name
+                 #:primitives primitives
+                 #:weights weights)))
+  (define (parse-node obj parse-child meshes)
+    ;; TODO: Parse all fields of nodes.
+    (let ((name (or (string-ref/optional obj "name") "anonymous"))
+          ;; TODO: Parse camera.
+          (camera #f)
+          ;; TODO: Parse skin.
+          (skin #f)
+          (matrix (or (matrix-ref/optional obj "matrix")
+                      (make-identity-matrix4)))
+          (mesh (match (number-ref/optional obj "mesh")
+                  (#f #f)
+                  (n (vector-ref meshes n))))
+          ;; TODO: Parse rotation, scale, translation
+          (rotation #f)
+          (scale #f)
+          (translation #f)
+          ;; TODO: Parse weights.
+          (weights #f)
+          (children (map parse-child
+                         (vector->list
+                          (or (array-ref/optional obj "children")
+                              #())))))
+      (make-scene-node #:name name
+                       #:children children
+                       #:camera camera
+                       #:skin skin
+                       #:matrix matrix
+                       #:mesh mesh
+                       #:rotation rotation
+                       #:scale scale
+                       #:translation translation
+                       #:weights weights)))
+  (define (parse-nodes array meshes)
+    (define nodes (make-vector (vector-length array) #f))
+    (define (parse-node* i)
+      (let ((node (vector-ref nodes i)))
+        (or node
+            (let ((node (parse-node (vector-ref array i)
+                                    parse-node*
+                                    meshes)))
+              (vector-set! nodes i node)
+              node))))
+    (let loop ((i 0))
+      (when (< i (vector-length array))
+        (parse-node* i)
+        (loop (+ i 1))))
+    nodes)
+  (define (parse-scene obj nodes)
+    (let ((name (or (string-ref/optional obj "name") "anonymous"))
+          (children
+           (map (lambda (i) (vector-ref nodes i))
+                (vector->list
+                 (or (number-array-ref/optional obj "nodes")
+                     #())))))
+      (make-scene #:name name #:nodes children)))
+  (let* ((tree (read-json port))
+         (asset (object-ref tree "asset"))
+         (version (string-ref asset "version"))
+         (copyright (string-ref/optional asset "copyright"))
+         (generator (string-ref/optional asset "generator"))
+         (minimum-version (string-ref/optional asset "minVersion"))
+         (extensions (object-ref/optional asset "extensions"))
+         ;; TODO: Figure out how to parse extras in a user-defined way
+         (extras (assoc-ref asset "extras"))
+         (buffers (vector-map parse-buffer
+                              (or (assoc-ref tree "buffers") #())))
+         (buffer-views (vector-map (lambda (obj)
+                                     (parse-buffer-view obj buffers))
+                                   (or (assoc-ref tree "bufferViews") #())))
+         (accessors (vector-map (lambda (obj)
+                                  (parse-accessor obj buffer-views))
+                                (or (assoc-ref tree "accessors") #())))
+         (materials (vector-map parse-material
+                                (or (assoc-ref tree "materials") #())))
+         (meshes (vector-map (lambda (obj)
+                               (parse-mesh obj materials accessors))
+                             (or (assoc-ref tree "meshes") #())))
+         (nodes (parse-nodes (or (assoc-ref tree "nodes") #()) meshes))
+         (scenes (map (lambda (obj)
+                        (parse-scene obj nodes))
+                      (vector->list
+                       (or (assoc-ref tree "scenes") #()))))
+         (default-scene (list-ref scenes
+                                  (or (number-ref/optional tree "scene")
+                                      0))))
+    (unless (string=? version "2.0")
+      (error "unsupported glTF version" version))
+    (make-asset copyright generator scenes default-scene)))
+
+(define (load-asset file)
+  (call-with-input-file file (lambda (port) (read-gltf port file))))
diff --git a/chickadee/render/scene.scm b/chickadee/render/scene.scm
new file mode 100644
index 0000000..279d4e6
--- /dev/null
+++ b/chickadee/render/scene.scm
@@ -0,0 +1,242 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2017 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; 3D scene graph with physically based rendering.
+;;
+;;; Code:
+
+(define-module (chickadee render scene)
+  #:use-module (chickadee config)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee math quaternion)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render)
+  #:use-module (chickadee render color)
+  #:use-module (chickadee render buffer)
+  #:use-module (chickadee render texture)
+  #:use-module (chickadee render shader)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:export (make-metallic-roughness
+            default-metallic-roughness
+            metallic-roughness?
+            metallic-roughness-base-color
+            metallic-roughness-base-color-texture
+            metallic-roughness-metallic-factor
+            metallic-roughness-roughness-factor
+            metallic-roughness-texture
+            make-material
+            default-material
+            material?
+            material-name
+            material-metallic-roughness
+            material-normal-texture
+            material-occlusion-texture
+            material-emissive-texture
+            material-emissive-factor
+            material-alpha-mode
+            material-alpha-cutoff
+            material-double-sided?
+            pbr-shader
+            make-primitive
+            primitive?
+            primitive-vertex-array
+            primitive-material
+            primitive-targets
+            make-mesh
+            mesh?
+            mesh-name
+            mesh-primitives
+            mesh-weights
+            make-scene-node
+            scene-node?
+            scene-node-name
+            scene-node-children
+            scene-node-camera
+            scene-node-skin
+            scene-node-matrix
+            scene-node-mesh
+            scene-node-rotation
+            scene-node-scale
+            scene-node-translation
+            scene-node-weights
+            make-scene
+            scene?
+            scene-name
+            scene-nodes
+            draw-scene))
+
+(define-record-type <metallic-roughness>
+  (%make-metallic-roughness base-color base-color-texture metallic-factor
+                            roughness-factor texture)
+  metallic-roughness?
+  (base-color metallic-roughness-base-color)
+  (base-color-texture metallic-roughness-base-color-texture)
+  (metallic-factor metallic-roughness-metallic-factor)
+  (roughness-factor metallic-roughness-roughness-factor)
+  (texture metallic-roughness-texture))
+
+(define* (make-metallic-roughness #:key
+                                  (base-color white)
+                                  base-color-texture
+                                  (metallic-factor 1.0)
+                                  (roughness-factor 1.0)
+                                  texture)
+  (%make-metallic-roughness base-color base-color-texture metallic-factor
+                            roughness-factor texture))
+
+(define default-metallic-roughness (make-metallic-roughness))
+
+(define-record-type <material>
+  (%make-material name metallic-roughness normal-texture occlusion-texture
+                  emissive-texture emissive-factor alpha-mode alpha-cutoff
+                  double-sided?)
+  material?
+  (name material-name)
+  (metallic-roughness material-metallic-roughness)
+  (normal-texture material-normal-texture)
+  (occlusion-texture material-occlusion-texture)
+  (emissive-texture material-emissive-texture)
+  (emissive-factor material-emissive-factor)
+  (alpha-mode material-alpha-mode)
+  (alpha-cutoff material-alpha-cutoff)
+  (double-sided? material-double-sided?))
+
+(define* (make-material #:key
+                        (name "anonymous")
+                        (metallic-roughness default-metallic-roughness)
+                        normal-texture
+                        occlusion-texture
+                        emissive-texture
+                        (emissive-factor (vec3 0.0 0.0 0.0))
+                        (alpha-mode 'opaque)
+                        (alpha-cutoff 0.5)
+                        double-sided?)
+  (%make-material name metallic-roughness normal-texture occlusion-texture
+                  emissive-texture emissive-factor alpha-mode alpha-cutoff
+                  double-sided?))
+
+(define default-material (make-material))
+
+(define pbr-shader
+  (let ((shader
+         (delay
+           (load-shader (scope-datadir "shaders/pbr/pbr-vert.glsl")
+                        (scope-datadir "shaders/pbr/pbr-frag.glsl")))))
+    (lambda ()
+      (force shader))))
+
+(define-record-type <primitive>
+  (%make-primitive vertex-array material targets)
+  primitive?
+  (vertex-array primitive-vertex-array)
+  (material primitive-material)
+  (targets primitive-targets))
+
+(define* (make-primitive #:key
+                         vertex-array
+                         (material default-material)
+                         targets)
+  (%make-primitive vertex-array material targets))
+
+(define-record-type <mesh>
+  (%make-mesh name primitives weights)
+  mesh?
+  (name mesh-name)
+  (primitives mesh-primitives)
+  (weights mesh-weights))
+
+(define* (make-mesh #:key
+                    (name "anonymous")
+                    primitives
+                    weights)
+  (%make-mesh name primitives weights))
+
+(define-record-type <scene-node>
+  (%make-scene-node name children camera skin matrix mesh
+                    rotation scale translation weights)
+  node?
+  (name scene-node-name)
+  (children scene-node-children)
+  (camera scene-node-camera)
+  (skin scene-node-skin)
+  (matrix scene-node-matrix)
+  (mesh scene-node-mesh)
+  (rotation scene-node-rotation)
+  (scale scene-node-scale)
+  (translation scene-node-translation)
+  (weights scene-node-weights))
+
+(define* (make-scene-node #:key
+                          (name "anonymous")
+                          (children #())
+                          camera
+                          skin
+                          (matrix (make-identity-matrix4))
+                          mesh
+                          (rotation (quaternion 0.0 0.0 0.0 1.0))
+                          (scale (vec3 1.0 1.0 1.0))
+                          (translation (vec3 0.0 0.0 0.0))
+                          weights)
+  (%make-scene-node name children camera skin matrix mesh
+                    rotation scale translation weights))
+
+(define-record-type <scene>
+  (%make-scene name nodes)
+  scene?
+  (name scene-name)
+  (nodes scene-nodes))
+
+(define* (make-scene #:key (name "anonymous") (nodes '()))
+  (%make-scene name nodes))
+
+(define modelview
+  (make-matrix4 1.0 0.0 0.0 0.0
+                0.0 1.0 0.0 0.0
+                0.0 0.0 1.0 0.0
+                0.0 0.0 1.0 1.0)
+  ;;(make-identity-matrix4)
+  )
+
+(define (draw-primitive primitive matrix)
+  ;; TODO: Use material.
+  ;; TODO: Actually use physically based rendering.
+  (gpu-apply (pbr-shader)
+             (primitive-vertex-array primitive)
+             #:mvp (matrix4* modelview (current-projection))
+             ))
+
+(define (draw-mesh mesh matrix)
+  (for-each (lambda (primitive)
+              (draw-primitive primitive matrix))
+            (mesh-primitives mesh)))
+
+(define (draw-scene-node node matrix)
+  ;; TODO: Apply transformation matrix.
+  (let ((world-matrix (matrix4* matrix (scene-node-matrix node))))
+    (when (scene-node-mesh node)
+      (draw-mesh (scene-node-mesh node) world-matrix))
+    (for-each (lambda (node)
+                (draw-scene-node node world-matrix))
+              (scene-node-children node))))
+
+(define (draw-scene scene)
+  (for-each (lambda (scene)
+              (draw-scene-node scene (make-identity-matrix4)))
+            (scene-nodes scene)))
diff --git a/data/shaders/pbr/pbr-frag.glsl b/data/shaders/pbr/pbr-frag.glsl
new file mode 100644
index 0000000..9699da6
--- /dev/null
+++ b/data/shaders/pbr/pbr-frag.glsl
@@ -0,0 +1,5 @@
+#version 330
+
+void main (void) {
+  gl_FragColor = vec4(1.0, 0.0, 0.0, 1.0);
+}
diff --git a/data/shaders/pbr/pbr-vert.glsl b/data/shaders/pbr/pbr-vert.glsl
new file mode 100644
index 0000000..d3d7eca
--- /dev/null
+++ b/data/shaders/pbr/pbr-vert.glsl
@@ -0,0 +1,9 @@
+#version 330
+
+in vec3 position;
+in vec3 normal;
+uniform mat4 mvp;
+
+void main(void) {
+    gl_Position = mvp * vec4(position.xyz, 1.0);
+}