diff options
| -rw-r--r-- | .dir-locals.el | 3 | ||||
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | chickadee/render.scm | 5 | ||||
| -rw-r--r-- | chickadee/render/buffer.scm | 515 | ||||
| -rw-r--r-- | chickadee/render/shapes.scm | 31 | ||||
| -rw-r--r-- | chickadee/render/sprite.scm | 83 | ||||
| -rw-r--r-- | chickadee/render/vertex-buffer.scm | 261 |
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)) |