Major rewrite of vertex buffer and vertex array abstractions.
authorDavid Thompson <dthompson2@worcester.edu>
Sun, 13 Aug 2017 17:23:01 +0000 (13:23 -0400)
committerDavid Thompson <dthompson2@worcester.edu>
Thu, 14 Sep 2017 02:02:39 +0000 (22:02 -0400)
.dir-locals.el
Makefile.am
chickadee/render.scm
chickadee/render/buffer.scm [new file with mode: 0644]
chickadee/render/shapes.scm
chickadee/render/sprite.scm
chickadee/render/vertex-buffer.scm [deleted file]

index f5d370b..bd99f3c 100644 (file)
@@ -8,7 +8,8 @@
    (eval . (put 'with-projection 'scheme-indent-function 1))
    (eval . (put 'with-framebuffer 'scheme-indent-function 1))
    (eval . (put 'with-viewport 'scheme-indent-function 1))
-   (eval . (put 'with-mapped-vertex-buffer 'scheme-indent-function 1))
+   (eval . (put 'with-mapped-buffer 'scheme-indent-function 1))
+   (eval . (put 'with-mapped-typed-buffer 'scheme-indent-function 1))
    (eval . (put 'uniform-let 'scheme-indent-function 1))
    (eval . (put 'call-with-surface 'scheme-indent-function 1))
    (eval . (put 'with-new-rect 'scheme-indent-function 1))
index 6400ab2..abbdba0 100644 (file)
@@ -59,7 +59,7 @@ SOURCES =                                     \
   chickadee/render/blend.scm                   \
   chickadee/render/texture.scm                 \
   chickadee/render/shader.scm                  \
-  chickadee/render/vertex-buffer.scm           \
+  chickadee/render/buffer.scm                  \
   chickadee/render/viewport.scm                        \
   chickadee/render/framebuffer.scm             \
   chickadee/render/shapes.scm                  \
index 9edab51..268a47c 100644 (file)
@@ -29,7 +29,7 @@
   #:use-module (chickadee render framebuffer)
   #:use-module (chickadee render shader)
   #:use-module (chickadee render texture)
-  #:use-module (chickadee render vertex-buffer)
+  #:use-module (chickadee render buffer)
   #:use-module (chickadee render viewport)
   #:export (current-viewport
             current-framebuffer
     (gpu-state-set! *blend-mode-state* (current-blend-mode))
     (gpu-state-set! *depth-test-state* (current-depth-test))
     (gpu-state-set! *shader-state* shader)
-    (gpu-state-set! *vertex-array-state* vertex-array)
     (let loop ((i 0))
       (when (< i 32)
         (texture-set! i (current-texture i))
                      (when (eq? 'sampler-2d (uniform-type uniform))
                        (set-uniform-value! uniform (uniform-value uniform))))
                    (shader-uniforms shader))
-    (render-vertices count)))
+    (render-vertices vertex-array count)))
 
 (define-syntax-rule (gpu-apply shader vertex-array uniforms ...)
   (gpu-apply* shader vertex-array #f uniforms ...))
diff --git a/chickadee/render/buffer.scm b/chickadee/render/buffer.scm
new file mode 100644 (file)
index 0000000..7f0c168
--- /dev/null
@@ -0,0 +1,515 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016, 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:
+;;
+;; GPU data buffers.
+;;
+;;; Code:
+
+(define-module (chickadee render buffer)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (oop goops)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-4)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (gl)
+  #:use-module (system foreign)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render gl)
+  #:use-module (chickadee render gpu)
+  #:export (make-buffer
+            make-streaming-buffer
+            buffer?
+            index-buffer?
+            buffer-name
+            buffer-length
+            buffer-stride
+            buffer-target
+            buffer-usage
+            buffer-data
+            null-buffer
+            map-buffer!
+            unmap-buffer!
+            with-mapped-buffer
+            *buffer-state*
+            make-typed-buffer
+            make-streaming-typed-buffer
+            typed-buffer?
+            typed-buffer->buffer
+            typed-buffer->vector
+            typed-buffer-name
+            typed-buffer-view
+            typed-buffer-offset
+            typed-buffer-component-type
+            typed-buffer-normalized?
+            typed-buffer-count
+            typed-buffer-type
+            typed-buffer-max
+            typed-buffer-min
+            typed-buffer-sparse
+            typed-buffer-data
+            map-typed-buffer!
+            unmap-typed-buffer!
+            with-mapped-typed-buffer
+            make-vertex-array
+            vertex-array?
+            vertex-array-indices
+            vertex-array-attributes
+            vertex-array-mode
+            null-vertex-array
+            *vertex-array-state*
+            render-vertices))
+
+;;;
+;;; Buffers
+;;;
+
+(define-record-type <buffer>
+  (%make-buffer id name length stride target usage data)
+  buffer?
+  (id buffer-id)
+  (name buffer-name)
+  (length buffer-length)
+  (stride buffer-stride)
+  (target buffer-target)
+  (usage buffer-usage)
+  (data buffer-data set-buffer-data!))
+
+(set-record-type-printer! <buffer>
+                          (lambda (buffer port)
+                            (format port
+                                    "#<buffer id: ~d name: ~s usage: ~s target: ~s length: ~d stride: ~s>"
+                                    (buffer-id buffer)
+                                    (buffer-name buffer)
+                                    (buffer-usage buffer)
+                                    (buffer-target buffer)
+                                    (buffer-length buffer)
+                                    (buffer-stride buffer))))
+
+(define null-buffer
+  (%make-buffer 0 "null" 0 0 'vertex 'static #f))
+
+(define <<buffer>> (class-of null-buffer))
+
+(define (free-buffer buffer)
+  (gl-delete-buffers 1 (u32vector (buffer-id buffer))))
+
+(define-method (gpu-finalize (buffer <<buffer>>))
+  (free-buffer buffer))
+
+(define (apply-buffer buffer)
+  (gl-bind-buffer (buffer-target-gl buffer)
+                  (buffer-id buffer)))
+
+(define *buffer-state*
+  (make-gpu-state apply-buffer null-buffer))
+
+(define (generate-buffer-gl)
+  (let ((bv (u32vector 1)))
+    (gl-gen-buffers 1 (bytevector->pointer bv))
+    (u32vector-ref bv 0)))
+
+(define (index-buffer? buffer)
+  "Return #t if VIEW is an index buffer view."
+  (eq? (buffer-target buffer) 'index))
+
+(define (buffer-usage-gl buffer)
+  (match (buffer-usage buffer)
+    ('static (arb-vertex-buffer-object static-draw-arb))
+    ('stream (arb-vertex-buffer-object stream-draw-arb))))
+
+(define (buffer-target-gl buffer)
+  (if (index-buffer? buffer)
+      (arb-vertex-buffer-object element-array-buffer-arb)
+      (arb-vertex-buffer-object array-buffer-arb)))
+
+(define* (make-buffer data #:key
+                      (name "anonymous")
+                      (length (bytevector-length data))
+                      (offset 0)
+                      (stride 0)
+                      (target 'vertex)
+                      (usage 'static))
+  "Upload BV, a bytevector of TYPE elements, to the GPU as a vertex
+buffer.
+
+USAGE provides a hint to the GPU as to how the vertex buffer will be
+used:
+
+- static: The vertex buffer will not be modified after creation.
+- stream: The vertex buffer will be modified frequently."
+  ;; Weird bugs will occur when creating a new vertex buffer while a
+  ;; vertex array is bound.
+  (gpu-state-set! *vertex-array-state* null-vertex-array)
+  (let ((buffer (gpu-guard
+                 (%make-buffer (generate-buffer-gl)
+                               name
+                               length
+                               stride
+                               target
+                               usage
+                               #f))))
+    (gpu-state-set! *buffer-state* buffer)
+    (gl-buffer-data (buffer-target-gl buffer)
+                    length
+                    %null-pointer
+                    (buffer-usage-gl buffer))
+    (when data
+      (gl-buffer-sub-data (buffer-target-gl buffer)
+                          0
+                          length
+                          (bytevector->pointer data offset)))
+    (gpu-state-set! *buffer-state* null-buffer)
+    buffer))
+
+(define* (make-streaming-buffer length #:key
+                                (name "anonymous")
+                                (target 'vertex))
+  "Return a new vertex buffer of LENGTH bytes, named NAME, suitable
+for streaming data to the GPU every frame."
+  (make-buffer #f #:usage 'stream #:length length #:name name #:target target))
+
+(define (map-buffer! buffer)
+  "Map the memory space for BUFFER from the GPU to the CPU, allowing
+the vertex buffer to be updated with new vertex data.  The
+'unmap-buffer!' procedure must be called to submit the new
+vertex buffer data back to the GPU."
+  (let ((target (buffer-target-gl buffer))
+        (length (buffer-length buffer))
+        (usage (buffer-usage-gl buffer)))
+    (gpu-state-set! *buffer-state* buffer)
+    ;; Orphan the buffer to avoid implicit synchronization.
+    ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
+    (gl-buffer-data target length %null-pointer usage)
+    (let ((ptr (gl-map-buffer target (version-1-5 read-write))))
+      (set-buffer-data! buffer (pointer->bytevector ptr length)))))
+
+(define (unmap-buffer! buffer)
+  "Return the mapped vertex buffer data for BUFFER to the GPU."
+  (gpu-state-set! *buffer-state* buffer)
+  (gl-unmap-buffer (buffer-target-gl buffer))
+  (set-buffer-data! buffer #f))
+
+(define-syntax-rule (with-mapped-buffer buffer body ...)
+  (dynamic-wind
+    (lambda ()
+      (map-buffer! buffer))
+    (lambda () body ...)
+    (lambda ()
+      (unmap-buffer! buffer))))
+
+\f
+;;;
+;;; Typed Buffers
+;;;
+
+(define-record-type <typed-buffer>
+  (%make-typed-buffer name buffer offset component-type
+                      normalized? length type max min sparse)
+  typed-buffer?
+  (name typed-buffer-name)
+  (buffer typed-buffer->buffer)
+  (offset typed-buffer-offset)
+  (component-type typed-buffer-component-type)
+  (normalized? typed-buffer-normalized?)
+  (length typed-buffer-length)
+  (type typed-buffer-type)
+  (max typed-buffer-max)
+  (min typed-buffer-min)
+  (sparse typed-buffer-sparse))
+
+(define (typed-buffer-stride typed-buffer)
+  (or (buffer-stride (typed-buffer->buffer typed-buffer))
+      (* (type-size (typed-buffer-type typed-buffer))
+         (component-type-size (typed-buffer-component-type typed-buffer)))))
+
+(define* (make-typed-buffer #:key
+                            (name "anonymous")
+                            buffer
+                            (offset 0)
+                            component-type
+                            normalized?
+                            (length (buffer-length buffer))
+                            type
+                            max
+                            min
+                            sparse)
+  (%make-typed-buffer name buffer offset component-type
+                      normalized? length type max min sparse))
+
+(define (type-size type)
+  (match type
+    ('scalar 1)
+    ('vec2 2)
+    ('vec3 3)
+    ((or 'vec4 'mat2) 4)
+    ('mat3 9)
+    ('mat4 16)))
+
+(define (component-type-size component-type)
+  (match component-type
+    ('byte 1)
+    ('unsigned-byte 1)
+    ('short 2)
+    ('unsigned-short 2)
+    ('unsigned-int 4)
+    ('float 4)))
+
+(define* (make-streaming-typed-buffer type component-type length #:key
+                                      (name "anonymous")
+                                      (target 'vertex)
+                                      data)
+  "Return a new typed buffer to hold LENGTH elements of TYPE whose
+components are comprised of COMPONENT-TYPE values.  The underlying
+untyped buffer is configured for GPU streaming.  Optonally, a NAME can
+be specified for the buffer."
+  (let* ((buffer-length
+          (* length (type-size type) (component-type-size component-type)))
+         (buffer (if data
+                     (make-buffer data
+                                  #:name name
+                                  #:length buffer-length
+                                  #:usage 'stream
+                                  #:target target)
+                     (make-streaming-buffer buffer-length
+                                            #:name name
+                                            #:target target))))
+    (make-typed-buffer #:name name
+                       #:buffer buffer
+                       #:type type
+                       #:component-type component-type
+                       #:length length)))
+
+(define (display-typed-buffer typed-buffer port)
+  (format port "#<typed-buffer name: ~s buffer: ~a type: ~s component-type: ~s length: ~d offset: ~d>"
+          (typed-buffer-name typed-buffer)
+          (typed-buffer->buffer typed-buffer)
+          (typed-buffer-type typed-buffer)
+          (typed-buffer-component-type typed-buffer)
+          (typed-buffer-length typed-buffer)
+          (typed-buffer-offset typed-buffer)))
+
+(set-record-type-printer! <typed-buffer> display-typed-buffer)
+
+(define (typed-buffer-type-size typed-buffer)
+  (type-size (typed-buffer-type typed-buffer)))
+
+(define (typed-buffer-data typed-buffer)
+  (buffer-data (typed-buffer->buffer typed-buffer)))
+
+(define (typed-buffer-type-gl typed-buffer)
+  (match (typed-buffer-component-type typed-buffer)
+    ('byte (data-type byte))
+    ('unsigned-byte (data-type unsigned-byte))
+    ('short (data-type short))
+    ('unsigned-short (data-type unsigned-short))
+    ('unsigned-int (data-type unsigned-int))
+    ('float (data-type float))))
+
+(define (map-typed-buffer! typed-buffer)
+  (map-buffer! (typed-buffer->buffer typed-buffer)))
+
+(define (unmap-typed-buffer! typed-buffer)
+  (unmap-buffer! (typed-buffer->buffer typed-buffer)))
+
+(define-syntax-rule (with-mapped-typed-buffer typed-buffer body ...)
+  (with-mapped-buffer (typed-buffer->buffer typed-buffer) body ...))
+
+(define* (apply-typed-buffer typed-buffer #:optional attribute-index)
+  (gpu-state-set! *buffer-state* (typed-buffer->buffer typed-buffer))
+  ;; If there is no attribute-index, we assume this is being bound for
+  ;; use as an index buffer.
+  (when attribute-index
+    (gl-enable-vertex-attrib-array attribute-index)
+    (gl-vertex-attrib-pointer attribute-index
+                              (typed-buffer-type-size typed-buffer)
+                              (typed-buffer-type-gl typed-buffer)
+                              (typed-buffer-normalized? typed-buffer)
+                              (typed-buffer-stride typed-buffer)
+                              (let ((offset (typed-buffer-offset typed-buffer)))
+                                (if (zero? offset)
+                                    %null-pointer
+                                    (bytevector->pointer (s32vector offset)))))))
+
+;; TODO: Handle 4-byte alignment rule for the types that need it.
+(define (typed-buffer->vector typed-buffer)
+  (define (component-parser type)
+    (match type
+      ('byte bytevector-s8-ref)
+      ('unsigned-byte bytevector-u8-ref)
+      ('short
+       (lambda (bv i)
+         (bytevector-s16-ref bv i (native-endianness))))
+      ('unsigned-short
+       (lambda (bv i)
+         (bytevector-u16-ref bv i (native-endianness))))
+      ('unsigned-int
+       (lambda (bv i)
+         (bytevector-u32-ref bv i (native-endianness))))
+      ('float bytevector-ieee-single-native-ref)))
+  (define (element-parser type component-type)
+    (let ((parse-component (component-parser component-type))
+          (component-type-size (component-type-size component-type)))
+      (match type
+        ('scalar parse-component)
+        ('vec2
+         (lambda (bv i)
+           (vec2 (parse-component bv i)
+                 (parse-component bv (+ i component-type-size)))))
+        ('vec3
+         (lambda (bv i)
+           (vec3 (parse-component bv i)
+                 (parse-component bv (+ i component-type-size))
+                 (parse-component bv (+ i (* component-type-size 2))))))
+        ;; TODO: Use a proper vec4 type when it exists.
+        ('vec4
+         (lambda (bv i)
+           (vector (parse-component bv i)
+                   (parse-component bv (+ i component-type-size))
+                   (parse-component bv (+ i (* component-type-size 2)))
+                   (parse-component bv (+ i (* component-type-size 3))))))
+        ;; TODO: Use proper matrix2 type when it exists.
+        ('mat2
+         (lambda (bv i)
+           (vector (vector (parse-component bv i)
+                           (parse-component bv (+ i component-type-size)))
+                   (vector (parse-component bv (+ i (* component-type-size 2)))
+                           (parse-component bv (+ i (* component-type-size 3)))))))
+        ;; TODO: Use proper matrix3 type when it exists.
+        ('mat3
+         (lambda (bv i)
+           (vector (vector (parse-component bv i)
+                           (parse-component bv (+ i component-type-size))
+                           (parse-component bv (+ i (* component-type-size 2))))
+                   (vector (parse-component bv (+ i (* component-type-size 3)))
+                           (parse-component bv (+ i (* component-type-size 4)))
+                           (parse-component bv (+ i (* component-type-size 5)))))))
+        ('mat4
+         (lambda (bv i)
+           (make-matrix4 (parse-component bv i)
+                         (parse-component bv (+ i component-type-size))
+                         (parse-component bv (+ i (* component-type-size 2)))
+                         (parse-component bv (+ i (* component-type-size 3)))
+                         (parse-component bv (+ i (* component-type-size 4)))
+                         (parse-component bv (+ i (* component-type-size 5)))
+                         (parse-component bv (+ i (* component-type-size 6)))
+                         (parse-component bv (+ i (* component-type-size 7)))
+                         (parse-component bv (+ i (* component-type-size 8)))
+                         (parse-component bv (+ i (* component-type-size 9)))
+                         (parse-component bv (+ i (* component-type-size 10)))
+                         (parse-component bv (+ i (* component-type-size 11)))
+                         (parse-component bv (+ i (* component-type-size 12)))
+                         (parse-component bv (+ i (* component-type-size 13)))
+                         (parse-component bv (+ i (* component-type-size 14)))
+                         (parse-component bv (+ i (* component-type-size 15)))))))))
+  (with-mapped-typed-buffer typed-buffer
+    (let* ((data (typed-buffer-data typed-buffer))
+           (length (typed-buffer-length typed-buffer))
+           (offset (typed-buffer-offset typed-buffer))
+           (stride (typed-buffer-stride typed-buffer))
+           (type (typed-buffer-type typed-buffer))
+           (component-type (typed-buffer-component-type typed-buffer))
+           (type-byte-size (* (type-size type)
+                              (component-type-size component-type)))
+           (v (make-vector length))
+           (parse-element (element-parser type component-type)))
+      (let loop ((i 0))
+        (when (< i length)
+          (let ((byte-index (+ (* i stride) offset)))
+            (vector-set! v i (parse-element data byte-index)))
+          (loop (+ i 1))))
+      v)))
+
+\f
+;;;
+;;; Vertex Arrays
+;;;
+
+(define-record-type <vertex-array>
+  (%make-vertex-array id indices attributes mode)
+  vertex-array?
+  (id vertex-array-id)
+  (indices vertex-array-indices)
+  (attributes vertex-array-attributes)
+  (mode vertex-array-mode))
+
+(set-record-type-printer! <vertex-array>
+                          (lambda (array port)
+                            (format port
+                                    "#<vertex-array indices: ~a attributes: ~a mode: ~s>"
+                                    (vertex-array-indices array)
+                                    (vertex-array-attributes array)
+                                    (vertex-array-mode array))))
+
+(define null-vertex-array (%make-vertex-array 0 #f '() 'triangles))
+
+(define <<vertex-array>> (class-of null-vertex-array))
+
+(define (generate-vertex-array)
+  (let ((bv (u32vector 1)))
+    (gl-gen-vertex-arrays 1 (bytevector->pointer bv))
+    (u32vector-ref bv 0)))
+
+(define (free-vertex-array va)
+  (gl-delete-vertex-arrays 1 (u32vector (vertex-array-id va))))
+
+(define-method (gpu-finalize (va <<vertex-array>>))
+  (free-vertex-array va))
+
+(define (apply-vertex-array va)
+  (gl-bind-vertex-array (vertex-array-id va)))
+
+(define *vertex-array-state*
+  (make-gpu-state apply-vertex-array null-vertex-array))
+
+(define* (make-vertex-array #:key indices attributes (mode 'triangles))
+  (let ((array (gpu-guard
+                (%make-vertex-array (generate-vertex-array)
+                                    indices
+                                    attributes
+                                    mode))))
+    (gpu-state-set! *vertex-array-state* array)
+    (for-each (match-lambda
+                ((index . typed-buffer)
+                 (apply-typed-buffer typed-buffer index)))
+              attributes)
+    (apply-typed-buffer indices)
+    (gpu-state-set! *vertex-array-state* null-vertex-array)
+    array))
+
+(define (vertex-array-mode-gl array)
+  (match (vertex-array-mode array)
+    ('points (begin-mode points))
+    ('lines (begin-mode lines))
+    ('line-loop (begin-mode line-loop))
+    ('line-strip (begin-mode line-strip))
+    ('triangles (begin-mode triangles))
+    ('triangle-strip (begin-mode triangle-strip))
+    ('triangle-fan (begin-mode triangle-fan))))
+
+(define* (render-vertices array #:optional count)
+  (gpu-state-set! *vertex-array-state* array)
+  (gl-draw-elements (vertex-array-mode-gl array)
+                    (or count
+                        (typed-buffer-length
+                         (vertex-array-indices array)))
+                    (data-type unsigned-int)
+                    %null-pointer))
index 5161e33..415eff8 100644 (file)
   #:use-module (chickadee render)
   #:use-module (chickadee render color)
   #:use-module (chickadee render shader)
-  #:use-module (chickadee render vertex-buffer)
+  #:use-module (chickadee render buffer)
   #:export (draw-line))
 
 (define draw-line
   (let* ((vertex-buffer
-          (delay (make-streaming-vertex-buffer 'vec2 4)))
+          (delay
+            (make-streaming-typed-buffer 'vec2 'float 4
+                                         #:name "line-typed-buffer")))
          (texcoord-buffer
-          (delay (make-streaming-vertex-buffer 'vec2 4)))
+          (delay
+            (make-streaming-typed-buffer 'vec2 'float 4
+                                         #:name "line-typed-buffer")))
          (index-buffer
-          (delay (make-vertex-buffer 'index 'static (u32vector 0 3 2 0 2 1))))
+          (delay
+            (make-typed-buffer #:type 'scalar
+                               #:component-type 'unsigned-int
+                               #:buffer (make-buffer (u32vector 0 3 2 0 2 1)
+                                                     #:target 'index))))
          (vertex-array
-          (delay (make-vertex-array (force index-buffer)
-                                    (force vertex-buffer)
-                                    (force texcoord-buffer))))
+          (delay
+            (make-vertex-array #:indices (force index-buffer)
+                               #:attributes `((0 . ,(force vertex-buffer))
+                                              (1 . ,(force texcoord-buffer))))))
          (default-shader
            (delay
              (strings->shader
@@ -169,8 +178,8 @@ may use SHADER to override the built-in line segment shader."
              (vy4 (+ (+ y2 ypad) (- xpad)))
              (s4 (+ length padding))
              (t4 padding))
-        (with-mapped-vertex-buffer (force vertex-buffer)
-          (let ((bv (vertex-buffer-data (force vertex-buffer))))
+        (with-mapped-typed-buffer (force vertex-buffer)
+          (let ((bv (typed-buffer-data (force vertex-buffer))))
             (f32vector-set! bv 0 vx1)
             (f32vector-set! bv 1 vy1)
             (f32vector-set! bv 2 vx2)
@@ -179,8 +188,8 @@ may use SHADER to override the built-in line segment shader."
             (f32vector-set! bv 5 vy3)
             (f32vector-set! bv 6 vx4)
             (f32vector-set! bv 7 vy4)))
-        (with-mapped-vertex-buffer (force texcoord-buffer)
-          (let ((bv (vertex-buffer-data (force texcoord-buffer))))
+        (with-mapped-typed-buffer (force texcoord-buffer)
+          (let ((bv (typed-buffer-data (force texcoord-buffer))))
             (f32vector-set! bv 0 s1)
             (f32vector-set! bv 1 t1)
             (f32vector-set! bv 2 s2)
index 1ea4dda..1291687 100644 (file)
@@ -26,7 +26,7 @@
   #:use-module (chickadee render)
   #:use-module (chickadee render shader)
   #:use-module (chickadee render texture)
-  #:use-module (chickadee render vertex-buffer)
+  #:use-module (chickadee render buffer)
   #:export (draw-sprite
             with-batched-sprites
             draw-nine-patch))
@@ -59,26 +59,37 @@ void main (void) {
 ")))
 
 (define draw-sprite-unbatched
-  (let* ((vertex-buffer
-          (delay (make-streaming-vertex-buffer 'vec2 4)))
+  (let* ((position-buffer
+          (delay
+            (make-streaming-typed-buffer 'vec2 'float 4
+                                         #:name "unbatched-sprite-vertices")))
          (texcoord-buffer
-          (delay (make-streaming-vertex-buffer 'vec2 4)))
+          (delay
+            (make-streaming-typed-buffer 'vec2 'float 4
+                                         #:name "unbatched-sprite-texcoords")))
          (index-buffer
-          (delay (make-vertex-buffer 'index 'static (u32vector 0 3 2 0 2 1))))
+          (delay
+            (make-typed-buffer #:name "unbatched-sprite-indices"
+                               #:type 'scalar
+                               #:component-type 'unsigned-int
+                               #:buffer (make-buffer (u32vector 0 3 2 0 2 1)
+                                                     #:target 'index))))
          (vertex-array
-          (delay (make-vertex-array (force index-buffer)
-                                    (force vertex-buffer)
-                                    (force texcoord-buffer))))
+          (delay
+            (make-vertex-array #:indices (force index-buffer)
+                               #:attributes
+                               `((0 . ,(force position-buffer))
+                                 (1 . ,(force texcoord-buffer))))))
          (tmp-matrix (make-null-matrix4))
          (mvp (make-null-matrix4))
          (position (vec2 0 0)))
     (lambda (texture region scale rotation blend-mode shader texture-region)
-      (with-mapped-vertex-buffer (force vertex-buffer)
+      (with-mapped-typed-buffer (force position-buffer)
         (let* ((x1 0)
                (y1 0)
                (x2 (rect-width region))
                (y2 (rect-height region))
-               (bv (vertex-buffer-data (force vertex-buffer))))
+               (bv (typed-buffer-data (force position-buffer))))
           (f32vector-set! bv 0 x1)
           (f32vector-set! bv 1 y1)
           (f32vector-set! bv 2 x2)
@@ -87,12 +98,12 @@ void main (void) {
           (f32vector-set! bv 5 y2)
           (f32vector-set! bv 6 x1)
           (f32vector-set! bv 7 y2)))
-      (with-mapped-vertex-buffer (force texcoord-buffer)
+      (with-mapped-typed-buffer (force texcoord-buffer)
         (let ((s1 (rect-left texture-region))
               (t1 (rect-bottom texture-region))
               (s2 (rect-right texture-region))
               (t2 (rect-top texture-region))
-              (bv (vertex-buffer-data (force texcoord-buffer))))
+              (bv (typed-buffer-data (force texcoord-buffer))))
           (f32vector-set! bv 0 s1)
           (f32vector-set! bv 1 t1)
           (f32vector-set! bv 2 s2)
@@ -137,10 +148,16 @@ void main (void) {
   (vertex-array sprite-batch-vertex-array set-sprite-batch-vertex-array!))
 
 (define (init-sprite-batch batch capacity)
-  (let* ((index (make-streaming-vertex-buffer 'index (* capacity 6)))
-         (pos (make-streaming-vertex-buffer 'vec2  (* capacity 4)))
-         (tex (make-streaming-vertex-buffer 'vec2  (* capacity 4)))
-         (va (make-vertex-array index pos tex)))
+  (let* ((index (make-streaming-typed-buffer 'scalar
+                                             'unsigned-int
+                                             (* capacity 6)
+                                             #:target 'index))
+         (pos (make-streaming-typed-buffer 'vec2 'float (* capacity 4)
+                                           #:name "batched-sprite-vertices"))
+         (tex (make-streaming-typed-buffer 'vec2 'float (* capacity 4)
+                                           #:name "batched-sprite-vertices"))
+         (va (make-vertex-array #:indices index
+                                #:attributes `((0 . ,pos) (1 . ,tex)))))
     (set-sprite-batch-capacity! batch capacity)
     (set-sprite-batch-index-buffer! batch index)
     (set-sprite-batch-position-buffer! batch pos)
@@ -160,18 +177,18 @@ void main (void) {
   (let ((old-index (sprite-batch-index-buffer batch))
         (old-verts (sprite-batch-position-buffer batch))
         (old-tex (sprite-batch-texture-buffer batch)))
-    (unmap-vertex-buffer! old-index)
-    (unmap-vertex-buffer! old-verts)
-    (unmap-vertex-buffer! old-tex)
+    (unmap-typed-buffer! old-index)
+    (unmap-typed-buffer! old-verts)
+    (unmap-typed-buffer! old-tex)
     (init-sprite-batch batch (* (sprite-batch-capacity batch) 2))
     (sprite-batch-begin! batch)
     (let ((new-index (sprite-batch-index-buffer batch))
           (new-verts (sprite-batch-position-buffer batch))
           (new-tex (sprite-batch-texture-buffer batch)))
       (define (copy from to)
-        (bytevector-copy! (vertex-buffer-data from) 0
-                          (vertex-buffer-data to) 0
-                          (bytevector-length (vertex-buffer-data from))))
+        (bytevector-copy! (typed-buffer-data from) 0
+                          (typed-buffer-data to) 0
+                          (bytevector-length (typed-buffer-data from))))
       (copy old-index new-index)
       (copy old-verts new-verts)
       (copy old-tex new-tex))))
@@ -184,18 +201,18 @@ void main (void) {
   (set-sprite-batch-size! batch 0))
 
 (define (sprite-batch-begin! batch)
-  (map-vertex-buffer! (sprite-batch-index-buffer batch))
-  (map-vertex-buffer! (sprite-batch-position-buffer batch))
-  (map-vertex-buffer! (sprite-batch-texture-buffer batch)))
+  (map-typed-buffer! (sprite-batch-index-buffer batch))
+  (map-typed-buffer! (sprite-batch-position-buffer batch))
+  (map-typed-buffer! (sprite-batch-texture-buffer batch)))
 
 (define (sprite-batch-flush! batch)
   "Render the contents of BATCH and clear the cache."
   (unless (zero? (sprite-batch-size batch))
     (with-blend-mode (sprite-batch-blend-mode batch)
       (with-texture 0 (sprite-batch-texture batch)
-        (unmap-vertex-buffer! (sprite-batch-index-buffer batch))
-        (unmap-vertex-buffer! (sprite-batch-position-buffer batch))
-        (unmap-vertex-buffer! (sprite-batch-texture-buffer batch))
+        (unmap-typed-buffer! (sprite-batch-index-buffer batch))
+        (unmap-typed-buffer! (sprite-batch-position-buffer batch))
+        (unmap-typed-buffer! (sprite-batch-texture-buffer batch))
         (gpu-apply* (sprite-batch-shader batch)
                     (sprite-batch-vertex-array batch)
                     (* (sprite-batch-size batch) 6)
@@ -228,13 +245,9 @@ void main (void) {
         (set-sprite-batch-blend-mode! batch blend-mode)
         (set-sprite-batch-shader! batch shader))
       (let ((size (sprite-batch-size batch)))
-        (let* (;;(index-offset (* size 6))
-               ;;(index-vertex-offset (* size 4))
-               ;;(vertex-offset (* size 8)) ;; 4 vertices, 2 floats per vertex
-               ;;(texture-offset (* size 8))
-               (indices (vertex-buffer-data (sprite-batch-index-buffer batch)))
-               (vertices (vertex-buffer-data (sprite-batch-position-buffer batch)))
-               (texcoords (vertex-buffer-data (sprite-batch-texture-buffer batch)))
+        (let* ((indices (typed-buffer-data (sprite-batch-index-buffer batch)))
+               (vertices (typed-buffer-data (sprite-batch-position-buffer batch)))
+               (texcoords (typed-buffer-data (sprite-batch-texture-buffer batch)))
                (rx (rect-x region))
                (ry (rect-y region))
                (local-x1 0.0)
diff --git a/chickadee/render/vertex-buffer.scm b/chickadee/render/vertex-buffer.scm
deleted file mode 100644 (file)
index 5286a44..0000000
+++ /dev/null
@@ -1,261 +0,0 @@
-;;; Chickadee Game Toolkit
-;;; Copyright © 2016 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:
-;;
-;; Vertex buffers and vertex arrays.
-;;
-;;; Code:
-
-(define-module (chickadee render vertex-buffer)
-  #:use-module (ice-9 format)
-  #:use-module (ice-9 match)
-  #:use-module (oop goops)
-  #:use-module (rnrs bytevectors)
-  #:use-module (srfi srfi-4)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-9 gnu)
-  #:use-module (gl)
-  #:use-module (system foreign)
-  #:use-module (chickadee render gl)
-  #:use-module (chickadee render gpu)
-  #:export (make-vertex-buffer
-            make-streaming-vertex-buffer
-            vertex-buffer?
-            index-buffer?
-            vertex-buffer-type
-            vertex-buffer-usage
-            vertex-buffer-data
-            null-vertex-buffer
-            map-vertex-buffer!
-            unmap-vertex-buffer!
-            with-mapped-vertex-buffer
-            *vertex-buffer-state*
-
-            make-vertex-array
-            vertex-array?
-            vertex-array-index-buffer
-            vertex-array-attribute-buffers
-            null-vertex-array
-            *vertex-array-state*
-
-            render-vertices))
-
-;;;
-;;; Vertex Buffers
-;;;
-
-(define-record-type <vertex-buffer>
-  (%make-vertex-buffer id type usage data)
-  vertex-buffer?
-  (id vertex-buffer-id)
-  (type vertex-buffer-type)
-  (usage vertex-buffer-usage)
-  (data vertex-buffer-data set-vertex-buffer-data!))
-
-(set-record-type-printer! <vertex-buffer>
-  (lambda (vb port)
-    (format port
-            "#<vertex-buffer type: ~a usage: ~a>"
-            (vertex-buffer-type vb)
-            (vertex-buffer-usage vb))))
-
-(define (index-buffer? vb)
-  "Return #t if VB is of type 'index'."
-  (eq? (vertex-buffer-type vb) 'index))
-
-(define null-vertex-buffer (%make-vertex-buffer 0 #f 'static #f))
-
-(define <<vertex-buffer>> (class-of null-vertex-buffer))
-
-(define (free-vertex-buffer vb)
-  (gl-delete-buffers 1 (u32vector (vertex-buffer-id vb))))
-
-(define-method (gpu-finalize (vb <<vertex-buffer>>))
-  (free-vertex-buffer vb))
-
-(define (vertex-buffer-length vb)
-  (bytevector-length (vertex-buffer-data vb)))
-
-(define (type-size type)
-  (match type
-    ((or 'float 'index) 1)
-    ('vec2 2)
-    ('vec3 3)
-    ('vec4 4)))
-
-(define (vertex-buffer-attribute-size vb)
-  (type-size (vertex-buffer-type vb)))
-
-(define (apply-vertex-buffer vb)
-  (gl-bind-buffer (vertex-buffer-target-gl vb)
-                  (vertex-buffer-id vb)))
-
-(define *vertex-buffer-state*
-  (make-gpu-state apply-vertex-buffer null-vertex-buffer))
-
-(define (vertex-buffer-target-gl vb)
-  (if (index-buffer? vb)
-      (arb-vertex-buffer-object element-array-buffer-arb)
-      (arb-vertex-buffer-object array-buffer-arb)))
-
-(define (vertex-buffer-usage-gl vb)
-  (match (vertex-buffer-usage vb)
-    ('static (arb-vertex-buffer-object static-draw-arb))
-    ('stream (arb-vertex-buffer-object stream-draw-arb))))
-
-(define (generate-vertex-buffer-gl)
-  (let ((bv (u32vector 1)))
-    (gl-gen-buffers 1 (bytevector->pointer bv))
-    (u32vector-ref bv 0)))
-
-(define (make-vertex-buffer type usage bv)
-  "Upload BV, a bytevector of TYPE elements, to the GPU as a vertex
-buffer.
-
-USAGE provides a hint to the GPU as to how the vertex buffer will be
-used:
-
-- static: The vertex buffer will not be updated after creation.
-- stream: The vertex buffer will be dynamically updated frequently."
-  ;; Weird bugs will occur when creating a new vertex buffer while a
-  ;; vertex array is bound.
-  (gpu-state-set! *vertex-array-state* null-vertex-array)
-  (let ((vb (gpu-guard
-             (%make-vertex-buffer (generate-vertex-buffer-gl)
-                                  type
-                                  usage
-                                  bv))))
-    (gpu-state-set! *vertex-buffer-state* vb)
-    (gl-buffer-data (vertex-buffer-target-gl vb)
-                    (bytevector-length bv)
-                    (bytevector->pointer bv)
-                    (vertex-buffer-usage-gl vb))
-    (gpu-state-set! *vertex-buffer-state* null-vertex-buffer)
-    vb))
-
-(define (make-streaming-vertex-buffer type length)
-  "Return a new vertex buffer of LENGTH elements suitable for
-streaming data to the GPU every frame.  TYPE is a symbol specifying
-the element type, either 'float', 'index', 'vec2', 'vec3', or 'vec4'."
-  (make-vertex-buffer type 'stream
-                      ;; TODO: Don't assume all numbers are 32-bit.
-                      (make-bytevector (* (type-size type) length 4))))
-
-(define (map-vertex-buffer! vb)
-  "Map the memory space for VB from the GPU to the CPU, allowing the
-vertex buffer to be updated with new vertex data.  The
-'unmap-vertex-buffer!' procedure must be called to submit the new
-vertex buffer data back to the GPU."
-  (let ((target (vertex-buffer-target-gl vb))
-        (length (vertex-buffer-length vb))
-        (usage (vertex-buffer-usage-gl vb)))
-    (gpu-state-set! *vertex-buffer-state* vb)
-    ;; Orphan the buffer to avoid implicit synchronization.
-    ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
-    (gl-buffer-data target length %null-pointer usage)
-    (let ((ptr (gl-map-buffer target (version-1-5 read-write))))
-      (set-vertex-buffer-data! vb (pointer->bytevector ptr length)))))
-
-(define (unmap-vertex-buffer! vb)
-  "Return the mapped vertex buffer data for VB to the GPU."
-  (gpu-state-set! *vertex-buffer-state* vb)
-  (gl-unmap-buffer (vertex-buffer-target-gl vb)))
-
-(define-syntax-rule (with-mapped-vertex-buffer vb body ...)
-  (dynamic-wind
-    (lambda ()
-      (map-vertex-buffer! vb))
-    (lambda () body ...)
-    (lambda ()
-      (unmap-vertex-buffer! vb))))
-
-\f
-;;;
-;;; Vertex Arrays
-;;;
-
-(define-record-type <vertex-array>
-  (%make-vertex-array id index-buffer attribute-buffers)
-  vertex-array?
-  (id vertex-array-id)
-  (index-buffer vertex-array-index-buffer)
-  (attribute-buffers vertex-array-attribute-buffers))
-
-(set-record-type-printer! <vertex-array>
-  (lambda (va port)
-    (format port
-            "#<vertex-array index-buffer: ~a attribute-buffers: ~a>"
-            (vertex-array-index-buffer va)
-            (vertex-array-attribute-buffers va))))
-
-(define null-vertex-array (%make-vertex-array 0 #f '()))
-
-(define <<vertex-array>> (class-of null-vertex-array))
-
-(define (generate-vertex-array)
-  (let ((bv (u32vector 1)))
-    (gl-gen-vertex-arrays 1 (bytevector->pointer bv))
-    (u32vector-ref bv 0)))
-
-(define (free-vertex-array va)
-  (gl-delete-vertex-arrays 1 (u32vector (vertex-array-id va))))
-
-(define-method (gpu-finalize (va <<vertex-array>>))
-  (free-vertex-array va))
-
-(define (apply-vertex-array va)
-  (gl-bind-vertex-array (vertex-array-id va)))
-
-(define *vertex-array-state*
-  (make-gpu-state apply-vertex-array null-vertex-array))
-
-(define (make-vertex-array index-buffer . attribute-buffers)
-  (let ((va (gpu-guard
-             (%make-vertex-array (generate-vertex-array)
-                                 index-buffer
-                                 attribute-buffers))))
-    (gpu-state-set! *vertex-array-state* va)
-    ;; Configure all attribute buffers starting from attribute
-    ;; location 0.
-    (let loop ((attrs attribute-buffers)
-               (index 0))
-      (match attrs
-        (() #f)
-        ((attr . rest)
-         (gl-enable-vertex-attrib-array index)
-         (gpu-state-set! *vertex-buffer-state* attr)
-         (gl-vertex-attrib-pointer index
-                                   (vertex-buffer-attribute-size attr)
-                                   (data-type float)
-                                   #f
-                                   0
-                                   %null-pointer)
-         (loop rest (1+ index)))))
-    (gpu-state-set! *vertex-buffer-state* index-buffer)
-    (gpu-state-set! *vertex-array-state* null-vertex-array)
-    va))
-
-(define* (render-vertices #:optional count)
-  (gl-draw-elements (begin-mode triangles)
-                    (or count
-                        (u32vector-length
-                         (vertex-buffer-data
-                          (vertex-array-index-buffer
-                           (gpu-state-ref *vertex-array-state*)))))
-                    (data-type unsigned-int)
-                    %null-pointer))