graphics: Add mesh module.

2 files changed, 432 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index 4b5d802..f7f4453 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -81,6 +81,7 @@ SOURCES = 					\
   chickadee/graphics/tile-map.scm		\
   chickadee/graphics/particles.scm		\
   chickadee/graphics/light.scm			\
+  chickadee/graphics/mesh.scm			\
   chickadee/graphics/phong.scm			\
   chickadee/graphics/pbr.scm			\
   chickadee/graphics/model.scm			\
diff --git a/chickadee/graphics/mesh.scm b/chickadee/graphics/mesh.scm
new file mode 100644
index 0000000..ab7ad45
--- /dev/null
+++ b/chickadee/graphics/mesh.scm
@@ -0,0 +1,431 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2021 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; 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 mesh rendering and generation.
+;;
+;;; Code:
+
+(define-module (chickadee graphics mesh)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee graphics blend)
+  #:use-module (chickadee graphics buffer)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics depth)
+  #:use-module (chickadee graphics engine)
+  #:use-module (chickadee graphics multisample)
+  #:use-module (chickadee graphics light)
+  #:use-module (chickadee graphics polygon)
+  #:use-module (chickadee graphics shader)
+  #:use-module (chickadee graphics stencil)
+  #:use-module (chickadee graphics texture)
+  #:use-module (chickadee utils)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:export (make-material
+            material?
+            material-name
+            material-shader
+            material-blend-mode
+            material-polygon-mode
+            material-cull-face-mode
+            material-depth-test
+            material-stencil-test
+            material-multisample?
+            material-texture-0
+            material-texture-1
+            material-texture-2
+            material-texture-3
+            material-texture-4
+            material-properties
+
+            make-primitive
+            primitive?
+            primitive-name
+            primitive-vertex-array
+            primitive-material
+
+            make-mesh
+            mesh?
+            mesh-name
+            mesh-primitives
+            draw-mesh
+
+            build-mesh
+            make-plane
+            make-tesselated-plane
+            make-cube
+            make-sphere))
+
+
+;;;
+;;; Materials
+;;;
+
+(define-record-type <material>
+  (%make-material name shader blend-mode polygon-mode cull-face-mode
+                  depth-test stencil-test multisample?
+                  texture-0 texture-1 texture-2 texture-3 texture-4
+                  properties)
+  material?
+  (name material-name)
+  (shader material-shader)
+  (blend-mode material-blend-mode)
+  (polygon-mode material-polygon-mode)
+  (cull-face-mode material-cull-face-mode)
+  (depth-test material-depth-test)
+  (stencil-test material-stencil-test)
+  (multisample? material-multisample?)
+  (texture-0 material-texture-0)
+  (texture-1 material-texture-1)
+  (texture-2 material-texture-2)
+  (texture-3 material-texture-3)
+  (texture-4 material-texture-4)
+  (properties material-properties))
+
+(define* (make-material #:key
+                        (name "anonymous")
+                        (shader null-shader)
+                        (blend-mode blend:replace)
+                        (polygon-mode fill-polygon-mode)
+                        (cull-face-mode back-cull-face-mode)
+                        (depth-test (make-depth-test))
+                        (stencil-test default-stencil-test)
+                        multisample?
+                        (texture-0 null-texture)
+                        (texture-1 null-texture)
+                        (texture-2 null-texture)
+                        (texture-3 null-texture)
+                        (texture-4 null-texture)
+                        properties)
+  (%make-material name shader blend-mode polygon-mode cull-face-mode
+                  depth-test stencil-test multisample? texture-0
+                  texture-1 texture-2 texture-3 texture-4 properties))
+
+(define %camera-position (vec3 0.0 0.0 0.0))
+
+(define (material-apply material vertex-array model-matrix view-matrix
+                        camera-position ambient-light light-vector)
+  (with-graphics-state ((g:blend-mode (material-blend-mode material))
+                        (g:cull-face-mode (material-cull-face-mode material))
+                        (g:depth-test (material-depth-test material))
+                        (g:multisample? (material-multisample? material))
+                        (g:polygon-mode (material-polygon-mode material))
+                        (g:stencil-test (material-stencil-test material))
+                        (g:texture-0 (material-texture-0 material))
+                        (g:texture-1 (material-texture-1 material))
+                        (g:texture-2 (material-texture-2 material))
+                        (g:texture-3 (material-texture-3 material))
+                        (g:texture-4 (material-texture-4 material)))
+    (shader-apply (material-shader material) vertex-array
+                  #:model model-matrix
+                  #:view view-matrix
+                  #:projection (current-projection)
+                  #:camera-position camera-position
+                  #:ambient-light ambient-light
+                  #:lights light-vector
+                  #:material (material-properties material))))
+
+
+;;;
+;;; Primitives
+;;;
+
+;; A primitive represents a single draw call: Some material applied to
+;; some vertex data.
+(define-record-type <primitive>
+  (make-primitive name vertex-array material)
+  primitive?
+  (name primitive-name)
+  (vertex-array primitive-vertex-array)
+  (material primitive-material))
+
+(define (draw-primitive primitive model-matrix view-matrix camera-position
+                        ambient-light light-vector)
+  (material-apply (primitive-material primitive)
+                  (primitive-vertex-array primitive)
+                  model-matrix
+                  view-matrix
+                  camera-position
+                  ambient-light
+                  light-vector))
+
+
+;;;
+;;; Meshes
+;;;
+
+;; A mesh is just a glorified list of primitives.
+(define-record-type <mesh>
+  (%make-mesh name primitives light-vector)
+  mesh?
+  (name mesh-name)
+  (primitives mesh-primitives)
+  (light-vector mesh-light-vector))
+
+(define (make-mesh name primitives)
+  (%make-mesh name primitives (make-vector %max-lights %disabled-light)))
+
+(define %identity-matrix (make-identity-matrix4))
+(define %origin (vec3 0.0 0.0 0.0))
+
+(define* (draw-mesh mesh #:key (model-matrix %identity-matrix)
+                    (view-matrix %identity-matrix)
+                    (camera-position %origin)
+                    (ambient-light black)
+                    (lights '()))
+  ;; Populate light vector to pass on to shader.
+  (let ((light-vector (mesh-light-vector mesh)))
+    (let loop ((i 0)
+               (lights lights))
+      (when (< i %max-lights)
+        (match lights
+          (()
+           (vector-set! light-vector i %disabled-light)
+           (loop (+ i 1) '()))
+          ((light . rest)
+           (vector-set! light-vector i light)
+           (loop (+ i 1) rest)))))
+    (for-each (lambda (primitive)
+                (draw-primitive primitive model-matrix view-matrix camera-position
+                                ambient-light light-vector))
+              (mesh-primitives mesh))))
+
+
+;;;
+;;; Programattically generated meshes
+;;;
+
+(define-record-type <vertex>
+  (vertex position uv normal)
+  vertex?
+  (position vertex-position)
+  (uv vertex-uv)
+  (normal vertex-normal))
+
+(define (build-mesh name vertices material)
+  (let* ((index (make-hash-table))
+         ;; Build index and count unique verts.
+         (count
+          (fold (lambda (vertex count)
+                  (if (hashq-ref index vertex)
+                      count
+                      (begin
+                        (hashq-set! index vertex count)
+                        (+ count 1))))
+                0
+                vertices))
+         ;; 8 floats per vertex.
+         (stride (* 8 4))
+         (verts (make-bytevector (* count stride)))
+         (indices (make-u32vector (length vertices))))
+    ;; Pack verts.
+    (hash-for-each (lambda (vertex i)
+                     (let ((p (vertex-position vertex))
+                           (uv (vertex-uv vertex))
+                           (n (vertex-normal vertex))
+                           (offset (* i stride)))
+                       (bytevector-ieee-single-native-set! verts offset
+                                                           (vec3-x p))
+                       (bytevector-ieee-single-native-set! verts (+ offset 4)
+                                                           (vec3-y p))
+                       (bytevector-ieee-single-native-set! verts (+ offset 8)
+                                                           (vec3-z p))
+                       (bytevector-ieee-single-native-set! verts (+ offset 12)
+                                                           (vec2-x uv))
+                       (bytevector-ieee-single-native-set! verts (+ offset 16)
+                                                           (vec2-y uv))
+                       (bytevector-ieee-single-native-set! verts (+ offset 20)
+                                                           (vec3-x n))
+                       (bytevector-ieee-single-native-set! verts (+ offset 24)
+                                                           (vec3-y n))
+                       (bytevector-ieee-single-native-set! verts (+ offset 28)
+                                                           (vec3-z n))))
+                   index)
+    ;; Pack indices.
+    (let loop ((i 0)
+               (vertices vertices))
+      (match vertices
+        (() #t)
+        ((vertex . rest)
+         (u32vector-set! indices i (hashq-ref index vertex))
+         (loop (+ i 1) rest))))
+    (let* ((vertex-buffer (make-buffer verts #:stride stride))
+           (index-buffer (make-buffer indices #:target 'index))
+           (positions (make-buffer-view #:buffer vertex-buffer
+                                        #:type 'vec3
+                                        #:component-type 'float))
+           (uvs (make-buffer-view #:buffer vertex-buffer
+                                  #:offset 12
+                                  #:type 'vec2
+                                  #:component-type 'float))
+           (normals (make-buffer-view #:buffer vertex-buffer
+                                      #:offset 20
+                                      #:type 'vec3
+                                      #:component-type 'float))
+           (vertex-array
+            (make-vertex-array #:indices
+                               (make-buffer-view #:buffer index-buffer
+                                                 #:type 'scalar
+                                                 #:component-type 'unsigned-int)
+                               #:attributes `((0 . ,positions)
+                                              (1 . ,uvs)
+                                              (2 . ,normals)))))
+      (make-mesh name (list (make-primitive name vertex-array material))))))
+
+(define (make-plane length width material)
+  (let* ((hl (/ length 2.0))
+         (hw (/ width 2.0))
+         (bottom-left (vertex (vec3 (- hw) 0.0 (- hl))
+                              (vec2 0.0 0.0)
+                              (vec3 0.0 1.0 0.0)))
+         (bottom-right (vertex (vec3 hw 0.0 (- hl))
+                               (vec2 1.0 0.0)
+                               (vec3 0.0 1.0 0.0)))
+         (top-right (vertex (vec3 hw 0.0 hl)
+                            (vec2 1.0 1.0)
+                            (vec3 0.0 1.0 0.0)))
+         (top-left (vertex (vec3 (- hw) 0.0 hl)
+                           (vec2 0.0 1.0)
+                           (vec3 0.0 1.0 0.0))))
+    (build-mesh "plane"
+                (list bottom-left
+                      top-left
+                      top-right
+                      bottom-left
+                      top-right
+                      bottom-right)
+                material)))
+
+(define (make-tesselated-plane length width resolution material)
+  (let ((hl (/ length 2.0))
+        (hw (/ width 2.0))
+        (stepl (/ length resolution))
+        (stepw (/ width resolution))
+        (uvstep (/ 1.0 resolution))
+        (cache (make-vector (* resolution resolution) #f)))
+    (define (get-vertex x z)
+      (or (vector-ref cache (+ (* resolution z) x))
+          (let ((v (vertex (vec3 (- (* x stepw) hw) 0.0 (- (* z stepl) hl))
+                           (vec2 (* x uvstep) (* z uvstep))
+                           (vec3 0.0 1.0 0.0))))
+            (vector-set! cache (+ (* resolution z) x) v)
+            v)))
+    (build-mesh "tesselated plane"
+                (let loop ((x 0)
+                           (z 0))
+                  (cond
+                   ((= z (- resolution 1))
+                    '())
+                   ((= x (- resolution 1))
+                    (loop 0 (+ z 1)))
+                   (else
+                    (cons* (get-vertex x z)
+                           (get-vertex x (+ z 1))
+                           (get-vertex (+ x 1) (+ z 1))
+                           (get-vertex x z)
+                           (get-vertex (+ x 1) (+ z 1))
+                           (get-vertex (+ x 1) z)
+                           (loop (+ x 1) z)))))
+                material)))
+
+(define (make-cube size material)
+  (let* ((hs (/ size 2.0))
+         (bottom0 (vertex (vec3 (- hs) (- hs) (- hs))
+                          (vec2 0.0 0.0)
+                          (vec3 0.0 -1.0 0.0)))
+         (bottom1 (vertex (vec3 hs (- hs) (- hs))
+                          (vec2 1.0 0.0)
+                          (vec3 0.0 -1.0 0.0)))
+         (bottom2 (vertex (vec3 hs (- hs) hs)
+                          (vec2 1.0 1.0)
+                          (vec3 0.0 -1.0 0.0)))
+         (bottom3 (vertex (vec3 (- hs) (- hs) hs)
+                          (vec2 0.0 1.0)
+                          (vec3 0.0 -1.0 0.0)))
+         (top0 (vertex (vec3 (- hs) hs (- hs))
+                       (vec2 0.0 0.0)
+                       (vec3 0.0 1.0 0.0)))
+         (top1 (vertex (vec3 hs hs (- hs))
+                       (vec2 1.0 0.0)
+                       (vec3 0.0 1.0 0.0)))
+         (top2 (vertex (vec3 hs hs hs)
+                       (vec2 1.0 1.0)
+                       (vec3 0.0 1.0 0.0)))
+         (top3 (vertex (vec3 (- hs) hs hs)
+                       (vec2 0.0 1.0)
+                       (vec3 0.0 1.0 0.0)))
+         (left0 (vertex (vec3 (- hs) (- hs) (- hs))
+                        (vec2 0.0 0.0)
+                        (vec3 -1.0 0.0 0.0)))
+         (left1 (vertex (vec3 (- hs) hs (- hs))
+                        (vec2 1.0 0.0)
+                        (vec3 -1.0 0.0 0.0)))
+         (left2 (vertex (vec3 (- hs) hs hs)
+                        (vec2 1.0 1.0)
+                        (vec3 -1.0 0.0 0.0)))
+         (left3 (vertex (vec3 (- hs) (- hs) hs)
+                        (vec2 0.0 1.0)
+                        (vec3 -1.0 0.0 0.0)))
+         (right0 (vertex (vec3 hs (- hs) (- hs))
+                         (vec2 0.0 0.0)
+                         (vec3 1.0 0.0 0.0)))
+         (right1 (vertex (vec3 hs hs (- hs))
+                         (vec2 1.0 0.0)
+                         (vec3 1.0 0.0 0.0)))
+         (right2 (vertex (vec3 hs hs hs)
+                         (vec2 1.0 1.0)
+                         (vec3 1.0 0.0 0.0)))
+         (right3 (vertex (vec3 hs (- hs) hs)
+                         (vec2 0.0 1.0)
+                         (vec3 1.0 0.0 0.0)))
+         (front0 (vertex (vec3 (- hs) (- hs) hs)
+                         (vec2 0.0 0.0)
+                         (vec3 0.0 0.0 1.0)))
+         (front1 (vertex (vec3 hs (- hs) hs)
+                         (vec2 1.0 0.0)
+                         (vec3 0.0 0.0 1.0)))
+         (front2 (vertex (vec3 hs hs hs)
+                         (vec2 1.0 1.0)
+                         (vec3 0.0 0.0 1.0)))
+         (front3 (vertex (vec3 (- hs) hs hs)
+                         (vec2 0.0 1.0)
+                         (vec3 0.0 0.0 1.0)))
+         (back0 (vertex (vec3 (- hs) (- hs) (- hs))
+                        (vec2 0.0 0.0)
+                        (vec3 0.0 0.0 -1.0)))
+         (back1 (vertex (vec3 hs (- hs) (- hs))
+                        (vec2 1.0 0.0)
+                        (vec3 0.0 0.0 -1.0)))
+         (back2 (vertex (vec3 hs hs (- hs))
+                        (vec2 1.0 1.0)
+                        (vec3 0.0 0.0 -1.0)))
+         (back3 (vertex (vec3 (- hs) hs (- hs))
+                        (vec2 0.0 1.0)
+                        (vec3 0.0 0.0 -1.0))))
+    (build-mesh "cube"
+                (list bottom0 bottom3 bottom2 bottom0 bottom2 bottom1
+                      top0 top3 top2 top0 top2 top1
+                      left0 left3 left2 left0 left2 left1
+                      right0 right3 right2 right0 right2 right1
+                      front0 front3 front2 front0 front2 front1
+                      back0 back3 back2 back0 back2 back1)
+                material)))