diff options
| -rw-r--r-- | chickadee/graphics/buffer.scm | 229 | ||||
| -rw-r--r-- | chickadee/graphics/gpu.scm | 151 |
2 files changed, 215 insertions, 165 deletions
diff --git a/chickadee/graphics/buffer.scm b/chickadee/graphics/buffer.scm index 50b6d1c..179ae4d 100644 --- a/chickadee/graphics/buffer.scm +++ b/chickadee/graphics/buffer.scm @@ -27,13 +27,11 @@ #: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 graphics color) #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics gl) #:use-module (chickadee graphics gpu) #:export (make-buffer buffer? @@ -46,7 +44,6 @@ buffer-usage buffer-data null-buffer - g:buffer current-buffer map-buffer! unmap-buffer! @@ -70,7 +67,6 @@ vertex-array-attributes vertex-array-mode null-vertex-array - g:vertex-array current-vertex-array render-vertices render-vertices/instanced @@ -112,7 +108,7 @@ ;;; (define-record-type <buffer> - (%make-buffer id name length stride target usage data stream-cache) + (%make-buffer id name length stride target usage data) buffer? (id buffer-id) (name buffer-name) @@ -120,8 +116,7 @@ (stride buffer-stride) (target buffer-target) (usage buffer-usage) - (data buffer-data set-buffer-data!) - (stream-cache buffer-stream-cache)) + (data buffer-data set-buffer-data!)) (define (print-buffer buffer port) (format port @@ -136,24 +131,12 @@ (set-record-type-printer! <buffer> print-buffer) (define null-buffer - (%make-buffer 0 "null" 0 0 'vertex 'static #f #f)) + (%make-buffer 0 "null" 0 0 'vertex 'static #f)) (define (index-buffer? buffer) "Return #t if VIEW is an index buffer view." (eq? (buffer-target buffer) 'index)) -(define (buffer-usage-gl buffer) - (case (buffer-usage buffer) - ((static) - (version-1-5 static-draw)) - ((stream) - (version-1-5 stream-draw)))) - -(define (buffer-target-gl buffer) - (if (index-buffer? buffer) - (version-1-5 element-array-buffer) - (version-1-5 array-buffer))) - (define* (make-buffer data #:key (name "anonymous") (length (if data (bytevector-length data) 0)) @@ -184,74 +167,33 @@ never sent to the GPU." (assert-current-graphics-engine) ;; Weird bugs will occur when creating a new vertex buffer while a ;; vertex array is bound. - (with-graphics-state! ((vertex-array gpu-vertex-array:null)) - (let ((buffer (%make-buffer (fresh-gpu-buffer (current-gpu) target) - name length stride target usage #f - (and (eq? usage 'stream) - (make-hash-table))))) - (with-graphics-state! ((buffer (buffer-id buffer))) - (gl-buffer-data (buffer-target-gl buffer) - length - (if data - (bytevector->pointer data offset) - %null-pointer) - (buffer-usage-gl buffer)) - buffer)))) + (let ((gpu (current-gpu))) + (set-gpu-vertex-array! gpu gpu-vertex-array:null) + (let* ((id (fresh-gpu-buffer gpu target usage)) + (buffer (%make-buffer id name length stride target usage #f))) + (gpu-buffer-upload gpu id usage data length offset) + buffer))) (define (buffer-mapped? buffer) "Return #t if buffer data has been mapped from GPU." (if (buffer-data buffer) #t #f)) -;; For streaming buffers, we use buffer re-specification to achieve -;; good throughput. However, it requires getting a new data pointer -;; every frame and allocating a Scheme bytevector for that memory -;; region. Allocating this bytevector every frame causes significant -;; GC pressure. It turns out that GPU drivers tend to return the same -;; set of pointers over and over, or at least the driver I'm using -;; does this. So, by caching bytevectors for those memory regions we -;; avoid bytevector allocation after a frame or two of warmup. -(define (pointer->bytevector/cached buffer pointer length) - (let* ((cache (buffer-stream-cache buffer)) - (address (pointer-address pointer)) - (cached (hashv-ref cache address))) - ;; It could be that there is a cached bytevector for the address, - ;; but the bytevector is a different length. We must treat this - ;; as a cache miss and allocate a new bytevector. - (if (and cached (= (bytevector-length cached) length)) - cached - (let ((bv (pointer->bytevector pointer length))) - (hashv-set! cache address bv) - bv)))) - (define* (map-buffer! buffer #:optional (mode 'read-write)) "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." - (unless (buffer-mapped? buffer) ;; Don't map a buffer that is already mapped! - (let ((target (buffer-target-gl buffer)) - (length (buffer-length buffer))) - (with-graphics-state! ((buffer (buffer-id 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 - (case mode - ((read-write) - (version-1-5 read-write)) - ((read-only) - (version-1-5 read-only)) - ((write-only) - (version-1-5 write-only))))) - (bv (pointer->bytevector/cached buffer ptr length))) - (set-buffer-data! buffer bv)))))) + (unless (buffer-mapped? buffer) + (let ((bv (gpu-buffer-map (current-gpu) + (buffer-id buffer) + (buffer-length buffer) + mode))) + (set-buffer-data! buffer bv)))) (define (unmap-buffer! buffer) "Return the mapped vertex buffer data for BUFFER to the GPU." - (with-graphics-state! ((buffer (buffer-id buffer))) - (gl-unmap-buffer (buffer-target-gl buffer)) - (set-buffer-data! buffer #f))) + (gpu-buffer-unmap (current-gpu) (buffer-id buffer)) + (set-buffer-data! buffer #f)) (define (resize-buffer! buffer length) "Resize BUFFER to LENGTH bytes, preserving all existing mapped data @@ -299,13 +241,12 @@ resized." ((double) 8))) (define-record-type <vertex-attribute> - (%make-vertex-attribute name buffer offset offset-pointer component-type + (%make-vertex-attribute name buffer offset component-type normalized? length type divisor) vertex-attribute? (name vertex-attribute-name) (buffer vertex-attribute->buffer) (offset vertex-attribute-offset) - (offset-pointer vertex-attribute-offset-pointer) (component-type vertex-attribute-component-type) (normalized? vertex-attribute-normalized?) (length vertex-attribute-length) @@ -367,9 +308,8 @@ divisor of 0 means that a single element is used for every instance and is used for the data being instanced. A divisor of 1 means that each element is used for 1 instance. A divisor of 2 means that each element is used for 2 instances, and so on." - (let ((offset-ptr (make-pointer offset))) - (%make-vertex-attribute name buffer offset offset-ptr component-type - normalized? length type divisor))) + (%make-vertex-attribute name buffer offset component-type + normalized? length type divisor)) (define (display-vertex-attribute vertex-attribute port) (format port "#<vertex-attribute name: ~s buffer: ~a type: ~s component-type: ~s length: ~d offset: ~d divisor: ~d>" @@ -389,33 +329,6 @@ element is used for 2 instances, and so on." (define (vertex-attribute-data vertex-attribute) (buffer-data (vertex-attribute->buffer vertex-attribute))) -(define (vertex-attribute-type-gl vertex-attribute) - (case (vertex-attribute-component-type vertex-attribute) - ((byte) (data-type byte)) - ((unsigned-byte) (data-type unsigned-byte)) - ((short) (data-type short)) - ((unsigned-short) (data-type unsigned-short)) - ((int) (data-type int)) - ((unsigned-int) (data-type unsigned-int)) - ((float) (data-type float)) - ((double) (data-type double)))) - -(define (apply-vertex-attribute vertex-attribute attribute-index) - (with-graphics-state! ((buffer (buffer-id (vertex-attribute->buffer vertex-attribute)))) - ;; 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 - (vertex-attribute-type-size vertex-attribute) - (vertex-attribute-type-gl vertex-attribute) - (vertex-attribute-normalized? vertex-attribute) - (vertex-attribute-stride vertex-attribute) - (vertex-attribute-offset-pointer vertex-attribute)) - (let ((divisor (vertex-attribute-divisor vertex-attribute))) - (when divisor - (gl-vertex-attrib-divisor attribute-index divisor)))))) - ;;; ;;; Vertex Arrays @@ -439,6 +352,23 @@ element is used for 2 instances, and so on." (define null-vertex-array (%make-vertex-array 0 #f '() 'triangles)) +(define (apply-vertex-attribute array attribute index) + ;; If there is no attribute-index, we assume this is being bound for + ;; use as an index buffer. + (when index + (match attribute + (($ <vertex-attribute> _ buffer offset type normalized? _ _ divisor) + (gpu-vertex-array-apply-attribute (current-gpu) + (vertex-array-id array) + (buffer-id buffer) + index + (vertex-attribute-type-size attribute) + type + normalized? + (vertex-attribute-stride attribute) + offset + divisor))))) + (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 @@ -457,62 +387,47 @@ argument may be overridden. The following values are supported: - triangle-strip - triangle-fan" (assert-current-graphics-engine) - (let ((array (%make-vertex-array (fresh-gpu-vertex-array (current-gpu)) - indices - attributes - mode))) - (with-graphics-state! ((vertex-array (vertex-array-id array))) - (for-each (match-lambda - ((index . vertex-attribute) - (apply-vertex-attribute vertex-attribute index))) - attributes) - (when indices (apply-vertex-attribute indices #f)) - array))) - -(define (vertex-array-mode-gl array) - (case (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)))) + (let* ((gpu (current-gpu)) + (id (fresh-gpu-vertex-array gpu)) + (array (%make-vertex-array id indices attributes mode))) + (for-each (match-lambda + ((index . attribute) + (apply-vertex-attribute array attribute index))) + attributes) + (when indices (apply-vertex-attribute array indices #f)) + array)) (define (render-vertices array count offset) (with-graphics-state! ((vertex-array (vertex-array-id array))) - (let ((indices (vertex-array-indices array))) - (if indices - (begin - ;; This shouldn't be here but I get weird rendering issues - ;; otherwise whyyyyyy?? - (apply-vertex-attribute indices #f) - (gl-draw-elements (vertex-array-mode-gl array) - (or count - (vertex-attribute-length indices)) - (vertex-attribute-type-gl indices) - (vertex-attribute-offset-pointer indices))) - (gl-draw-arrays (vertex-array-mode-gl array) - offset - (or count - (vertex-attribute-length - (assv-ref (vertex-array-attributes array) - 0)))))))) + (let ((gpu (current-gpu)) + (indices (vertex-array-indices array)) + (mode (vertex-array-mode array))) + (match (vertex-array-indices array) + (#f + (let ((count* (or count + (vertex-attribute-length + (assv-ref (vertex-array-attributes array) + 0))))) + (gpu-draw gpu mode count* offset))) + (($ <vertex-attribute> _ buffer offset type normalized? length) + (gpu-draw/indexed gpu (buffer-id buffer) type mode + (or count length) offset)))))) (define (render-vertices/instanced array instances count offset) (with-graphics-state! ((vertex-array (vertex-array-id array))) - (let ((indices (vertex-array-indices array))) - (if indices - (begin - (apply-vertex-attribute indices #f) - (gl-draw-elements-instanced (vertex-array-mode-gl array) - (or count - (vertex-attribute-length indices)) - (vertex-attribute-type-gl indices) - (vertex-attribute-offset-pointer indices) - instances)) - (gl-draw-arrays-instanced (vertex-array-mode-gl array) - offset count instances))))) + (let ((gpu (current-gpu)) + (indices (vertex-array-indices array)) + (mode (vertex-array-mode array))) + (match (vertex-array-indices array) + (#f + (let ((count* (or count + (vertex-attribute-length + (assv-ref (vertex-array-attributes array) + 0))))) + (gpu-draw/instanced gpu mode count* offset instances))) + (($ <vertex-attribute> _ buffer offset type normalized? length) + (gpu-draw/instanced+indexed gpu (buffer-id buffer) type mode + (or count length) offset instances)))))) ;;; diff --git a/chickadee/graphics/gpu.scm b/chickadee/graphics/gpu.scm index cf922e3..3832256 100644 --- a/chickadee/graphics/gpu.scm +++ b/chickadee/graphics/gpu.scm @@ -25,6 +25,7 @@ #:use-module (chickadee math rect) #:use-module (gl) #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) #:use-module (srfi srfi-9) #:use-module (system foreign) #:export (blend-mode? @@ -123,6 +124,9 @@ free-gpu-buffer gpu-buffer? gpu-buffer-id + gpu-buffer-upload + gpu-buffer-map + gpu-buffer-unmap gpu-buffer-target gpu-buffer:null @@ -130,6 +134,7 @@ free-gpu-vertex-array gpu-vertex-array? gpu-vertex-array-id + gpu-vertex-array-apply-attribute gpu-vertex-array:null fresh-gpu-texture @@ -208,7 +213,11 @@ set-gpu-program! set-gpu-texture! gpu-gc - gpu-reset!)) + gpu-reset! + gpu-draw + gpu-draw/indexed + gpu-draw/instanced + gpu-draw/instanced+indexed)) ;;; @@ -259,6 +268,45 @@ (->scheme (%eaccessor obj))) ...)) +(define-enum-converters begin-mode + symbol->begin-mode + begin-mode->symbol + (points) + (lines) + (line-loop) + (line-strip) + (triangles) + (triangle-strip) + (triangle-fan)) + +(define-enum-converters data-type + symbol->data-type + data-type->symbol + (byte) + (unsigned-byte) + (short) + (unsigned-short) + (int) + (unsigned-int) + (float) + (double)) + +(define (symbol->buffer-target target) + (match target + ('vertex (version-1-5 array-buffer)) + ('index (version-1-5 element-array-buffer)))) + +(define (symbol->buffer-usage usage) + (match usage + ('static (version-1-5 static-draw)) + ('stream (version-1-5 stream-draw)))) + +(define (symbol->access-mode mode) + (match mode + ('read-write (version-1-5 read-write)) + ('read-only (version-1-5 read-only)) + ('write-only (version-1-5 write-only)))) + (define-enum-converters texture-min-filter symbol->texture-min-filter texture-min-filter->symbol @@ -709,17 +757,20 @@ (id gpu-renderbuffer-id)) (define-gpu-type <gpu-buffer> - (make-gpu-buffer (target) + (make-gpu-buffer (target usage) (gl-generate-buffer) - (match target - ('index (version-1-5 element-array-buffer)) - ('vertex (version-1-5 array-buffer)))) + (symbol->buffer-target target) + (symbol->buffer-usage usage) + (and (eq? usage 'stream) (make-hash-table))) (free-gpu-buffer (gl-delete-buffer id)) (bind-gpu-buffer (gl-bind-buffer target id)) - (gpu-buffer:null 0 (version-1-5 array-buffer)) + (gpu-buffer:null 0 (symbol->buffer-target 'vertex) + (symbol->buffer-usage 'static) #f) gpu-buffer? (id gpu-buffer-id) - (target gpu-buffer-target)) + (target gpu-buffer-target) + (usage gpu-buffer-usage) + (stream-cache gpu-buffer-stream-cache)) (define-gpu-type <gpu-vertex-array> (make-gpu-vertex-array () (gl-generate-vertex-array)) @@ -910,7 +961,7 @@ (define-fresh fresh-gpu-framebuffer make-gpu-framebuffer) (define-fresh fresh-gpu-renderbuffer make-gpu-renderbuffer) -(define-fresh fresh-gpu-buffer make-gpu-buffer target) +(define-fresh fresh-gpu-buffer make-gpu-buffer target usage) (define-fresh fresh-gpu-vertex-array make-gpu-vertex-array) (define-fresh fresh-gpu-texture make-gpu-texture target) (define-fresh fresh-gpu-shader make-gpu-shader type) @@ -1072,3 +1123,87 @@ (set-gpu-texture! gpu 0 texture) (set-active-texture-unit! 0) (gl-generate-mipmap (gpu-texture-target texture))) + +(define (gpu-buffer-upload gpu buffer usage data length offset) + (set-gpu-buffer! gpu buffer) + (gl-buffer-data (gpu-buffer-target buffer) + length + (if data + (bytevector->pointer data offset) + %null-pointer) + (symbol->buffer-usage usage))) + +;; For streaming buffers, we use buffer re-specification to achieve +;; good throughput. However, it requires getting a new data pointer +;; every frame and allocating a Scheme bytevector for that memory +;; region. Allocating this bytevector every frame causes significant +;; GC pressure. It turns out that GPU drivers tend to return the same +;; set of pointers over and over, or at least the driver I'm using +;; does this. So, by caching bytevectors for those memory regions we +;; avoid bytevector allocation after a frame or two of warmup. +(define (pointer->bytevector/cached buffer pointer length) + (let* ((cache (gpu-buffer-stream-cache buffer)) + (address (pointer-address pointer)) + (cached (hashv-ref cache address))) + ;; It could be that there is a cached bytevector for the address, + ;; but the bytevector is a different length. We must treat this + ;; as a cache miss and allocate a new bytevector. + (if (and cached (= (bytevector-length cached) length)) + cached + (let ((bv (pointer->bytevector pointer length))) + (hashv-set! cache address bv) + bv)))) + +(define (gpu-buffer-map gpu buffer length mode) + (let ((target (gpu-buffer-target buffer)) + (usage (gpu-buffer-usage buffer))) + (set-gpu-buffer! gpu buffer) + (when (= usage (version-1-5 stream-draw)) + ;; Orphan the buffer to avoid implicit synchronization. + ;; https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification + (gl-buffer-data target length %null-pointer (gpu-buffer-usage buffer))) + (let ((ptr (gl-map-buffer target (symbol->access-mode mode)))) + (pointer->bytevector/cached buffer ptr length)))) + +(define (gpu-buffer-unmap gpu buffer) + (set-gpu-buffer! gpu buffer) + (gl-unmap-buffer (gpu-buffer-target buffer))) + +(define *offset-cache* (make-hash-table)) + +(define (offset->pointer offset) + (or (hashv-ref *offset-cache* offset) + (let ((ptr (make-pointer offset))) + (hashv-set! *offset-cache* offset ptr) + ptr))) + +(define (gpu-vertex-array-apply-attribute gpu array buffer index size type + normalized? stride offset divisor) + (set-gpu-vertex-array! gpu array) + (set-gpu-buffer! gpu buffer) + (gl-enable-vertex-attrib-array index) + (gl-vertex-attrib-pointer index size (symbol->data-type type) normalized? + stride (offset->pointer offset)) + (when divisor + (gl-vertex-attrib-divisor index divisor))) + +(define (gpu-draw gpu mode count offset) + (gl-draw-arrays (symbol->begin-mode mode) offset count)) + +(define (gpu-draw/indexed gpu indices type mode count offset) + (set-gpu-buffer! gpu indices) + (gl-draw-elements (symbol->begin-mode mode) + count + (symbol->data-type type) + (offset->pointer offset))) + +(define (gpu-draw/instanced gpu mode count offset instances) + (gl-draw-arrays-instanced (symbol->begin-mode mode) offset count instances)) + +(define (gpu-draw/instanced+indexed gpu indices type mode count offset instances) + (set-gpu-buffer! gpu indices) + (gl-draw-elements-instanced (symbol->begin-mode mode) + count + (symbol->data-type type) + (offset->pointer offset) + instances)) |