summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2017-08-13 13:23:01 -0400
committerDavid Thompson <dthompson2@worcester.edu>2017-09-13 22:02:39 -0400
commitb1f419114ea546bf3679e7a8dc49bdf268d5fd2a (patch)
tree56312151c0c8e4aa5149917b96d7e2786b54c818
parentd507d406b0fa9aac75042f320f141d7b54bccc9b (diff)
Major rewrite of vertex buffer and vertex array abstractions.
-rw-r--r--.dir-locals.el3
-rw-r--r--Makefile.am2
-rw-r--r--chickadee/render.scm5
-rw-r--r--chickadee/render/buffer.scm515
-rw-r--r--chickadee/render/shapes.scm31
-rw-r--r--chickadee/render/sprite.scm83
-rw-r--r--chickadee/render/vertex-buffer.scm261
7 files changed, 588 insertions, 312 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index f5d370b..bd99f3c 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -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))
diff --git a/Makefile.am b/Makefile.am
index 6400ab2..abbdba0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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 \
diff --git a/chickadee/render.scm b/chickadee/render.scm
index 9edab51..268a47c 100644
--- a/chickadee/render.scm
+++ b/chickadee/render.scm
@@ -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
@@ -160,7 +160,6 @@
(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))
@@ -170,7 +169,7 @@
(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
index 0000000..7f0c168
--- /dev/null
+++ b/chickadee/render/buffer.scm
@@ -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))))
+
+
+;;;
+;;; 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)))
+
+
+;;;
+;;; 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))
diff --git a/chickadee/render/shapes.scm b/chickadee/render/shapes.scm
index 5161e33..415eff8 100644
--- a/chickadee/render/shapes.scm
+++ b/chickadee/render/shapes.scm
@@ -30,20 +30,29 @@
#: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)
diff --git a/chickadee/render/sprite.scm b/chickadee/render/sprite.scm
index 1ea4dda..1291687 100644
--- a/chickadee/render/sprite.scm
+++ b/chickadee/render/sprite.scm
@@ -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
index 5286a44..0000000
--- a/chickadee/render/vertex-buffer.scm
+++ /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))))
-
-
-;;;
-;;; 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))