diff options
Diffstat (limited to 'chickadee/graphics/buffer.scm')
| -rw-r--r-- | chickadee/graphics/buffer.scm | 261 |
1 files changed, 114 insertions, 147 deletions
diff --git a/chickadee/graphics/buffer.scm b/chickadee/graphics/buffer.scm index 66609a2..f5ec8c6 100644 --- a/chickadee/graphics/buffer.scm +++ b/chickadee/graphics/buffer.scm @@ -1,5 +1,5 @@ ;;; Chickadee Game Toolkit -;;; Copyright © 2016, 2017, 2019, 2020 David Thompson <davet@gnu.org> +;;; Copyright © 2016-2021 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 @@ -24,7 +24,6 @@ (define-module (chickadee graphics buffer) #:use-module (ice-9 format) #:use-module (ice-9 match) - #:use-module (oop goops) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-4) @@ -35,10 +34,9 @@ #:use-module (chickadee math matrix) #:use-module (chickadee math vector) #:use-module (chickadee graphics color) + #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) - #:use-module (chickadee graphics gpu) #:export (make-buffer - make-streaming-buffer buffer? index-buffer? buffer-mapped? @@ -49,11 +47,10 @@ buffer-usage buffer-data null-buffer - apply-buffer + current-buffer map-buffer! unmap-buffer! resize-buffer! - with-mapped-buffer make-dynamic-buffer dynamic-buffer? @@ -68,7 +65,6 @@ dynamic-buffer-import! make-buffer-view - make-streaming-buffer-view buffer-view? buffer-view->buffer buffer-view-name @@ -84,12 +80,12 @@ buffer-view-divisor make-vertex-array - apply-vertex-array vertex-array? vertex-array-indices vertex-array-attributes vertex-array-mode null-vertex-array + current-vertex-array render-vertices render-vertices/instanced @@ -142,18 +138,26 @@ (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 (bind-buffer buffer) + (gl-bind-buffer (buffer-target-gl buffer) + (buffer-id buffer))) + +(define-graphics-finalizer buffer-finalizer + #:predicate buffer? + #:free free-buffer) + +(define-graphics-state buffer + current-buffer + #:default null-buffer + #:bind bind-buffer) + (define (generate-buffer-gl) (let ((bv (u32vector 1))) (gl-gen-buffers 1 (bytevector->pointer bv)) @@ -165,13 +169,13 @@ (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)))) + ('static (version-1-5 static-draw)) + ('stream (version-1-5 stream-draw)))) (define (buffer-target-gl buffer) (if (index-buffer? buffer) - (arb-vertex-buffer-object element-array-buffer-arb) - (arb-vertex-buffer-object array-buffer-arb))) + (version-1-5 element-array-buffer) + (version-1-5 array-buffer))) (define* (make-buffer data #:key (name "anonymous") @@ -202,31 +206,23 @@ NAME is simply an arbitrary string for debugging purposes that is never sent to the GPU." ;; Weird bugs will occur when creating a new vertex buffer while a ;; vertex array is bound. - (set-gpu-vertex-array! (current-gpu) null-vertex-array) - (let ((buffer (gpu-guard - (%make-buffer (generate-buffer-gl) - name - length - stride - target - usage - #f)))) - (set-gpu-vertex-buffer! (current-gpu) buffer) - (gl-buffer-data (buffer-target-gl buffer) - length - (if data - (bytevector->pointer data offset) - %null-pointer) - (buffer-usage-gl buffer)) - (set-gpu-vertex-buffer! (current-gpu) 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)) + (with-graphics-state! ((vertex-array null-vertex-array)) + (let ((buffer (%make-buffer (generate-buffer-gl) + name + length + stride + target + usage + #f))) + (graphics-engine-guard! buffer) + (with-graphics-state! ((buffer buffer)) + (gl-buffer-data (buffer-target-gl buffer) + length + (if data + (bytevector->pointer data offset) + %null-pointer) + (buffer-usage-gl buffer))) + buffer))) (define (buffer-mapped? buffer) "Return #t if buffer data has been mapped from GPU." @@ -240,22 +236,22 @@ vertex buffer data back to the GPU." (unless (buffer-mapped? buffer) ;; Don't map a buffer that is already mapped! (let ((target (buffer-target-gl buffer)) (length (buffer-length buffer))) - (set-gpu-vertex-buffer! (current-gpu) buffer) - (when (eq? (buffer-usage buffer) 'stream) - ;; 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 (buffer-usage-gl buffer))) - (let ((ptr (gl-map-buffer target (match mode - ('read-write (version-1-5 read-write)) - ('read-only (version-1-5 read-only)) - ('write-only (version-1-5 write-only)))))) - (set-buffer-data! buffer (pointer->bytevector ptr length)))))) + (with-graphics-state! ((buffer buffer)) + (when (eq? (buffer-usage buffer) 'stream) + ;; 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 (buffer-usage-gl buffer))) + (let ((ptr (gl-map-buffer target (match mode + ('read-write (version-1-5 read-write)) + ('read-only (version-1-5 read-only)) + ('write-only (version-1-5 write-only)))))) + (set-buffer-data! buffer (pointer->bytevector ptr length))))))) (define (unmap-buffer! buffer) "Return the mapped vertex buffer data for BUFFER to the GPU." - (set-gpu-vertex-buffer! (current-gpu) buffer) - (gl-unmap-buffer (buffer-target-gl buffer)) - (set-buffer-data! buffer #f)) + (with-graphics-state! ((buffer buffer)) + (gl-unmap-buffer (buffer-target-gl buffer)) + (set-buffer-data! buffer #f))) (define (resize-buffer! buffer length) "Resize BUFFER to LENGTH bytes, preserving all existing mapped data @@ -277,14 +273,6 @@ resized." (bytevector-length new-bv))))))) (error "cannot resize static buffer"))) -(define-syntax-rule (with-mapped-buffer buffer body ...) - (dynamic-wind - (lambda () - (map-buffer! buffer)) - (lambda () body ...) - (lambda () - (unmap-buffer! buffer)))) - ;;; ;;; Dynamic Buffers @@ -465,35 +453,6 @@ element is used for 2 instances, and so on." (%make-buffer-view name buffer offset component-type normalized? length type max min sparse divisor)) -(define* (make-streaming-buffer-view type component-type length #:key - (name "anonymous") - (target 'vertex) - data - (divisor 0)) - "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. If the buffer will be used for instanced -rendering, the DIVISOR argument must be used to specify the rate at -which attributes advance when rendering multiple instances." - (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-buffer-view #:name name - #:buffer buffer - #:type type - #:component-type component-type - #:length length - #:divisor divisor))) - (define (display-buffer-view buffer-view port) (format port "#<buffer-view name: ~s buffer: ~a type: ~s component-type: ~s length: ~d offset: ~d divisor: ~d>" (buffer-view-name buffer-view) @@ -524,20 +483,20 @@ which attributes advance when rendering multiple instances." ('double (data-type double)))) (define* (apply-buffer-view buffer-view #:optional attribute-index) - (set-gpu-vertex-buffer! (current-gpu) (buffer-view->buffer buffer-view)) - ;; 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 - (buffer-view-type-size buffer-view) - (buffer-view-type-gl buffer-view) - (buffer-view-normalized? buffer-view) - (buffer-view-stride buffer-view) - (make-pointer (buffer-view-offset buffer-view))) - (let ((divisor (buffer-view-divisor buffer-view))) - (when divisor - (gl-vertex-attrib-divisor attribute-index divisor))))) + (with-graphics-state! ((buffer (buffer-view->buffer buffer-view))) + ;; 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 + (buffer-view-type-size buffer-view) + (buffer-view-type-gl buffer-view) + (buffer-view-normalized? buffer-view) + (buffer-view-stride buffer-view) + (make-pointer (buffer-view-offset buffer-view))) + (let ((divisor (buffer-view-divisor buffer-view))) + (when divisor + (gl-vertex-attrib-divisor attribute-index divisor)))))) ;;; @@ -562,8 +521,6 @@ which attributes advance when rendering multiple instances." (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)) @@ -572,12 +529,21 @@ which attributes advance when rendering multiple instances." (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 (bind-vertex-array va) + (gl-bind-vertex-array (vertex-array-id va))) + +(define-graphics-finalizer vertex-array-finalizer + #:predicate vertex-array? + #:free free-vertex-array) + +(define-graphics-state vertex-array + current-vertex-array + #:default null-vertex-array + #:bind bind-vertex-array) + (define* (make-vertex-array #:key indices attributes (mode 'triangles)) "Return a new vertex array using the index data within the typed buffer INDICES and the vertex attribute data within ATTRIBUTES, an @@ -595,18 +561,19 @@ argument may be overridden. The following values are supported: - triangles - triangle-strip - triangle-fan" - (let ((array (gpu-guard - (%make-vertex-array (generate-vertex-array) - indices - attributes - mode)))) - (set-gpu-vertex-array! (current-gpu) array) - (for-each (match-lambda - ((index . buffer-view) - (apply-buffer-view buffer-view index))) - attributes) - (when indices (apply-buffer-view indices)) - (set-gpu-vertex-array! (current-gpu) null-vertex-array) + (let ((array (%make-vertex-array (generate-vertex-array) + indices + attributes + mode))) + (graphics-engine-guard! array) + (with-graphics-state! ((vertex-array array)) + (for-each (match-lambda + ((index . buffer-view) + (apply-buffer-view buffer-view index))) + attributes) + (when indices (apply-buffer-view indices))) + ;; Restore the old array. Is this needed? + ;; (graphics-engine-commit!) array)) (define (vertex-array-mode-gl array) @@ -620,32 +587,32 @@ argument may be overridden. The following values are supported: ('triangle-fan (begin-mode triangle-fan)))) (define* (render-vertices array #:key count (offset 0)) - (set-gpu-vertex-array! (current-gpu) array) - (let ((indices (vertex-array-indices array))) - (if indices - (begin - (apply-buffer-view indices) - (gl-draw-elements (vertex-array-mode-gl array) - (or count - (buffer-view-length indices)) - (buffer-view-type-gl indices) - %null-pointer)) - (gl-draw-arrays (vertex-array-mode-gl array) offset count)))) + (with-graphics-state! ((vertex-array array)) + (let ((indices (vertex-array-indices array))) + (if indices + (begin + (apply-buffer-view indices) + (gl-draw-elements (vertex-array-mode-gl array) + (or count + (buffer-view-length indices)) + (buffer-view-type-gl indices) + %null-pointer)) + (gl-draw-arrays (vertex-array-mode-gl array) offset count))))) (define* (render-vertices/instanced array instances #:key count (offset 0)) - (set-gpu-vertex-array! (current-gpu) array) - (let ((indices (vertex-array-indices array))) - (if indices - (begin - (apply-buffer-view indices) - (gl-draw-elements-instanced (vertex-array-mode-gl array) - (or count - (buffer-view-length indices)) - (buffer-view-type-gl indices) - %null-pointer - instances)) - (gl-draw-arrays-instanced (vertex-array-mode-gl array) - offset count instances)))) + (with-graphics-state! ((vertex-array array)) + (let ((indices (vertex-array-indices array))) + (if indices + (begin + (apply-buffer-view indices) + (gl-draw-elements-instanced (vertex-array-mode-gl array) + (or count + (buffer-view-length indices)) + (buffer-view-type-gl indices) + %null-pointer + instances)) + (gl-draw-arrays-instanced (vertex-array-mode-gl array) + offset count instances))))) ;;; |