summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/graphics/buffer.scm229
-rw-r--r--chickadee/graphics/gpu.scm151
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))