1 ;;; Chickadee Game Toolkit
2 ;;; Copyright © 2016, 2017 David Thompson <davet@gnu.org>
4 ;;; Chickadee is free software: you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published
6 ;;; by the Free Software Foundation, either version 3 of the License,
7 ;;; or (at your option) any later version.
9 ;;; Chickadee is distributed in the hope that it will be useful, but
10 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;;; General Public License for more details.
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program. If not, see
16 ;;; <http://www.gnu.org/licenses/>.
24 (define-module (chickadee render buffer
)
25 #:use-module
(ice-9 format
)
26 #:use-module
(ice-9 match
)
27 #:use-module
(oop goops
)
28 #:use-module
(rnrs bytevectors
)
29 #:use-module
(srfi srfi-4
)
30 #:use-module
(srfi srfi-9
)
31 #:use-module
(srfi srfi-9 gnu
)
33 #:use-module
(system foreign
)
34 #:use-module
(chickadee math matrix
)
35 #:use-module
(chickadee math vector
)
36 #:use-module
(chickadee render gl
)
37 #:use-module
(chickadee render gpu
)
54 make-streaming-typed-buffer
60 typed-buffer-component-type
61 typed-buffer-normalized?
71 with-mapped-typed-buffer
75 vertex-array-attributes
80 render-vertices
/instanced
))
86 (define-record-type <buffer
>
87 (%make-buffer id name length stride target usage data
)
91 (length buffer-length
)
92 (stride buffer-stride
)
93 (target buffer-target
)
95 (data buffer-data set-buffer-data
!))
97 (set-record-type-printer! <buffer
>
100 "#<buffer id: ~d name: ~s usage: ~s target: ~s length: ~d stride: ~s>"
103 (buffer-usage buffer
)
104 (buffer-target buffer
)
105 (buffer-length buffer
)
106 (buffer-stride buffer
))))
109 (%make-buffer
0 "null" 0 0 'vertex
'static
#f
))
111 (define <<buffer
>> (class-of null-buffer
))
113 (define (free-buffer buffer
)
114 (gl-delete-buffers 1 (u32vector (buffer-id buffer
))))
116 (define-method (gpu-finalize (buffer <<buffer
>>))
117 (free-buffer buffer
))
119 (define (apply-buffer buffer
)
120 (gl-bind-buffer (buffer-target-gl buffer
)
123 (define *buffer-state
*
124 (make-gpu-state apply-buffer null-buffer
))
126 (define (generate-buffer-gl)
127 (let ((bv (u32vector 1)))
128 (gl-gen-buffers 1 (bytevector->pointer bv
))
129 (u32vector-ref bv
0)))
131 (define (index-buffer? buffer
)
132 "Return #t if VIEW is an index buffer view."
133 (eq?
(buffer-target buffer
) 'index
))
135 (define (buffer-usage-gl buffer
)
136 (match (buffer-usage buffer
)
137 ('static
(arb-vertex-buffer-object static-draw-arb
))
138 ('stream
(arb-vertex-buffer-object stream-draw-arb
))))
140 (define (buffer-target-gl buffer
)
141 (if (index-buffer? buffer
)
142 (arb-vertex-buffer-object element-array-buffer-arb
)
143 (arb-vertex-buffer-object array-buffer-arb
)))
145 (define* (make-buffer data
#:key
147 (length (bytevector-length data
))
152 "Upload DATA, a bytevector, to the GPU. By default, the entire
153 bytevector is uploaded. A subset of the data may be uploaded by
154 specifying the OFFSET, the index of the first byte to be uploaded, and
155 LENGTH, the number of bytes to upload.
157 If DATA is #f, allocate LENGTH bytes of fresh GPU memory instead.
159 TARGET and USAGE are hints that tell the GPU how the buffer is
163 - vertex: Vertex attribute data.
164 - index: Index buffer data.
167 - static: The buffer data will not be modified after creation.
168 - stream: The buffer data will be modified frequently.
170 NAME is simply an arbitrary string for debugging purposes that is
171 never sent to the GPU."
172 ;; Weird bugs will occur when creating a new vertex buffer while a
173 ;; vertex array is bound.
174 (gpu-state-set! *vertex-array-state
* null-vertex-array
)
175 (let ((buffer (gpu-guard
176 (%make-buffer
(generate-buffer-gl)
183 (gpu-state-set! *buffer-state
* buffer
)
184 (gl-buffer-data (buffer-target-gl buffer
)
187 (bytevector->pointer data offset
)
189 (buffer-usage-gl buffer
))
190 (gpu-state-set! *buffer-state
* null-buffer
)
193 (define* (make-streaming-buffer length
#:key
196 "Return a new vertex buffer of LENGTH bytes, named NAME, suitable
197 for streaming data to the GPU every frame."
198 (make-buffer #f
#:usage
'stream
#:length length
#:name name
#:target target
))
200 (define (map-buffer! buffer
)
201 "Map the memory space for BUFFER from the GPU to the CPU, allowing
202 the vertex buffer to be updated with new vertex data. The
203 'unmap-buffer!' procedure must be called to submit the new
204 vertex buffer data back to the GPU."
205 (let ((target (buffer-target-gl buffer
))
206 (length (buffer-length buffer
))
207 (usage (buffer-usage-gl buffer
)))
208 (gpu-state-set! *buffer-state
* buffer
)
209 (when (eq? usage
'stream
)
210 ;; Orphan the buffer to avoid implicit synchronization.
211 ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
212 (gl-buffer-data target length %null-pointer usage
))
213 (let ((ptr (gl-map-buffer target
(version-1-5 read-write
))))
214 (set-buffer-data! buffer
(pointer->bytevector ptr length
)))))
216 (define (unmap-buffer! buffer
)
217 "Return the mapped vertex buffer data for BUFFER to the GPU."
218 (gpu-state-set! *buffer-state
* buffer
)
219 (gl-unmap-buffer (buffer-target-gl buffer
))
220 (set-buffer-data! buffer
#f
))
222 (define-syntax-rule (with-mapped-buffer buffer body ...
)
225 (map-buffer! buffer
))
228 (unmap-buffer! buffer
))))
235 (define-record-type <typed-buffer
>
236 (%make-typed-buffer name buffer offset component-type
237 normalized? length type max min sparse divisor
)
239 (name typed-buffer-name
)
240 (buffer typed-buffer-
>buffer
)
241 (offset typed-buffer-offset
)
242 (component-type typed-buffer-component-type
)
243 (normalized? typed-buffer-normalized?
)
244 (length typed-buffer-length
)
245 (type typed-buffer-type
)
246 (max typed-buffer-max
)
247 (min typed-buffer-min
)
248 (sparse typed-buffer-sparse
)
249 (divisor typed-buffer-divisor
)) ; for instanced rendering
251 (define (typed-buffer-stride typed-buffer
)
252 (or (buffer-stride (typed-buffer->buffer typed-buffer
))
253 (* (type-size (typed-buffer-type typed-buffer
))
254 (component-type-size (typed-buffer-component-type typed-buffer
)))))
256 (define (num-elements byte-length byte-offset type component-type
)
259 (/ (- byte-length byte-offset
)
260 (* (component-type-size component-type
)
261 (type-size type
))))))
264 (define* (make-typed-buffer #:key
271 (length (num-elements (buffer-length buffer
)
279 "Return a new typed buffer view for BUFFER starting at byte index
280 OFFSET of LENGTH elements, where each element is of TYPE and composed
281 of COMPONENT-TYPE values.
283 Valid values for TYPE are:
284 - scalar: single number
292 Valid values for COMPONENT-TYPE are:
303 DIVISOR is only needed for instanced rendering applications and
304 represents how many instances each vertex element applies to. A
305 divisor of 0 means that a single element is used for every instance
306 and is used for the data being instanced. A divisor of 1 means that
307 each element is used for 1 instance. A divisor of 2 means that each
308 element is used for 2 instances, and so on."
309 (%make-typed-buffer name buffer offset component-type
310 normalized? length type max min sparse divisor
))
312 (define (type-size type
)
321 (define (component-type-size component-type
)
322 (match component-type
332 (define* (make-streaming-typed-buffer type component-type length
#:key
337 "Return a new typed buffer to hold LENGTH elements of TYPE whose
338 components are comprised of COMPONENT-TYPE values. The underlying
339 untyped buffer is configured for GPU streaming. Optonally, a NAME can
340 be specified for the buffer. If the buffer will be used for instanced
341 rendering, the DIVISOR argument must be used to specify the rate at
342 which attributes advance when rendering multiple instances."
343 (let* ((buffer-length
344 (* length
(type-size type
) (component-type-size component-type
)))
348 #:length buffer-length
351 (make-streaming-buffer buffer-length
354 (make-typed-buffer #:name name
357 #:component-type component-type
361 (define (display-typed-buffer typed-buffer port
)
362 (format port
"#<typed-buffer name: ~s buffer: ~a type: ~s component-type: ~s length: ~d offset: ~d>"
363 (typed-buffer-name typed-buffer
)
364 (typed-buffer->buffer typed-buffer
)
365 (typed-buffer-type typed-buffer
)
366 (typed-buffer-component-type typed-buffer
)
367 (typed-buffer-length typed-buffer
)
368 (typed-buffer-offset typed-buffer
)))
370 (set-record-type-printer! <typed-buffer
> display-typed-buffer
)
372 (define (typed-buffer-type-size typed-buffer
)
373 (type-size (typed-buffer-type typed-buffer
)))
375 (define (typed-buffer-data typed-buffer
)
376 (buffer-data (typed-buffer->buffer typed-buffer
)))
378 (define (typed-buffer-type-gl typed-buffer
)
379 (match (typed-buffer-component-type typed-buffer
)
380 ('byte
(data-type byte
))
381 ('unsigned-byte
(data-type unsigned-byte
))
382 ('short
(data-type short
))
383 ('unsigned-short
(data-type unsigned-short
))
384 ('int
(data-type int
))
385 ('unsigned-int
(data-type unsigned-int
))
386 ('float
(data-type float
))
387 ('double
(data-type double
))))
389 (define (map-typed-buffer! typed-buffer
)
390 (map-buffer! (typed-buffer->buffer typed-buffer
)))
392 (define (unmap-typed-buffer! typed-buffer
)
393 (unmap-buffer! (typed-buffer->buffer typed-buffer
)))
395 (define-syntax-rule (with-mapped-typed-buffer typed-buffer body ...
)
396 (with-mapped-buffer (typed-buffer->buffer typed-buffer
) body ...
))
398 (define* (apply-typed-buffer typed-buffer
#:optional attribute-index
)
399 (gpu-state-set! *buffer-state
* (typed-buffer->buffer typed-buffer
))
400 ;; If there is no attribute-index, we assume this is being bound for
401 ;; use as an index buffer.
402 (when attribute-index
403 (gl-enable-vertex-attrib-array attribute-index
)
404 (gl-vertex-attrib-pointer attribute-index
405 (typed-buffer-type-size typed-buffer
)
406 (typed-buffer-type-gl typed-buffer
)
407 (typed-buffer-normalized? typed-buffer
)
408 (typed-buffer-stride typed-buffer
)
409 (make-pointer (typed-buffer-offset typed-buffer
)))
410 (let ((divisor (typed-buffer-divisor typed-buffer
)))
412 (gl-vertex-attrib-divisor attribute-index divisor
)))))
414 ;; TODO: Handle 4-byte alignment rule for the types that need it.
415 (define (typed-buffer->vector typed-buffer
)
416 (define (component-parser type
)
418 ('byte bytevector-s8-ref
)
419 ('unsigned-byte bytevector-u8-ref
)
422 (bytevector-s16-ref bv i
(native-endianness))))
425 (bytevector-u16-ref bv i
(native-endianness))))
428 (bytevector-u32-ref bv i
(native-endianness))))
429 ('float bytevector-ieee-single-native-ref
)))
430 (define (element-parser type component-type
)
431 (let ((parse-component (component-parser component-type
))
432 (component-type-size (component-type-size component-type
)))
434 ('scalar parse-component
)
437 (vec2 (parse-component bv i
)
438 (parse-component bv
(+ i component-type-size
)))))
441 (vec3 (parse-component bv i
)
442 (parse-component bv
(+ i component-type-size
))
443 (parse-component bv
(+ i
(* component-type-size
2))))))
444 ;; TODO: Use a proper vec4 type when it exists.
447 (vector (parse-component bv i
)
448 (parse-component bv
(+ i component-type-size
))
449 (parse-component bv
(+ i
(* component-type-size
2)))
450 (parse-component bv
(+ i
(* component-type-size
3))))))
451 ;; TODO: Use proper matrix2 type when it exists.
454 (vector (vector (parse-component bv i
)
455 (parse-component bv
(+ i component-type-size
)))
456 (vector (parse-component bv
(+ i
(* component-type-size
2)))
457 (parse-component bv
(+ i
(* component-type-size
3)))))))
458 ;; TODO: Use proper matrix3 type when it exists.
461 (vector (vector (parse-component bv i
)
462 (parse-component bv
(+ i component-type-size
))
463 (parse-component bv
(+ i
(* component-type-size
2))))
464 (vector (parse-component bv
(+ i
(* component-type-size
3)))
465 (parse-component bv
(+ i
(* component-type-size
4)))
466 (parse-component bv
(+ i
(* component-type-size
5)))))))
469 (make-matrix4 (parse-component bv i
)
470 (parse-component bv
(+ i component-type-size
))
471 (parse-component bv
(+ i
(* component-type-size
2)))
472 (parse-component bv
(+ i
(* component-type-size
3)))
473 (parse-component bv
(+ i
(* component-type-size
4)))
474 (parse-component bv
(+ i
(* component-type-size
5)))
475 (parse-component bv
(+ i
(* component-type-size
6)))
476 (parse-component bv
(+ i
(* component-type-size
7)))
477 (parse-component bv
(+ i
(* component-type-size
8)))
478 (parse-component bv
(+ i
(* component-type-size
9)))
479 (parse-component bv
(+ i
(* component-type-size
10)))
480 (parse-component bv
(+ i
(* component-type-size
11)))
481 (parse-component bv
(+ i
(* component-type-size
12)))
482 (parse-component bv
(+ i
(* component-type-size
13)))
483 (parse-component bv
(+ i
(* component-type-size
14)))
484 (parse-component bv
(+ i
(* component-type-size
15)))))))))
485 (with-mapped-typed-buffer typed-buffer
486 (let* ((data (typed-buffer-data typed-buffer
))
487 (length (typed-buffer-length typed-buffer
))
488 (offset (typed-buffer-offset typed-buffer
))
489 (stride (typed-buffer-stride typed-buffer
))
490 (type (typed-buffer-type typed-buffer
))
491 (component-type (typed-buffer-component-type typed-buffer
))
492 (type-byte-size (* (type-size type
)
493 (component-type-size component-type
)))
494 (v (make-vector length
))
495 (parse-element (element-parser type component-type
)))
498 (let ((byte-index (+ (* i stride
) offset
)))
499 (vector-set! v i
(parse-element data byte-index
)))
508 (define-record-type <vertex-array
>
509 (%make-vertex-array id indices attributes mode
)
512 (indices vertex-array-indices
)
513 (attributes vertex-array-attributes
)
514 (mode vertex-array-mode
))
516 (set-record-type-printer! <vertex-array
>
519 "#<vertex-array indices: ~a attributes: ~a mode: ~s>"
520 (vertex-array-indices array
)
521 (vertex-array-attributes array
)
522 (vertex-array-mode array
))))
524 (define null-vertex-array
(%make-vertex-array
0 #f
'() 'triangles
))
526 (define <<vertex-array
>> (class-of null-vertex-array
))
528 (define (generate-vertex-array)
529 (let ((bv (u32vector 1)))
530 (gl-gen-vertex-arrays 1 (bytevector->pointer bv
))
531 (u32vector-ref bv
0)))
533 (define (free-vertex-array va
)
534 (gl-delete-vertex-arrays 1 (u32vector (vertex-array-id va
))))
536 (define-method (gpu-finalize (va <<vertex-array
>>))
537 (free-vertex-array va
))
539 (define (apply-vertex-array va
)
540 (gl-bind-vertex-array (vertex-array-id va
)))
542 (define *vertex-array-state
*
543 (make-gpu-state apply-vertex-array null-vertex-array
))
545 (define* (make-vertex-array #:key indices attributes
(mode 'triangles
))
546 "Return a new vertex array using the index data within the typed
547 buffer INDICES and the vertex attribute data within ATTRIBUTES, an
548 alist mapping shader attribute indices to typed buffers containing
551 By default, the vertex array is interpreted as containing a series of
552 triangles. If another primtive type is desired, the MODE keyword
553 argument may be overridden. The following values are supported:
562 (let ((array (gpu-guard
563 (%make-vertex-array
(generate-vertex-array)
567 (gpu-state-set! *vertex-array-state
* array
)
568 (for-each (match-lambda
569 ((index . typed-buffer
)
570 (apply-typed-buffer typed-buffer index
)))
572 (apply-typed-buffer indices
)
573 (gpu-state-set! *vertex-array-state
* null-vertex-array
)
576 (define (vertex-array-mode-gl array
)
577 (match (vertex-array-mode array
)
578 ('points
(begin-mode points
))
579 ('lines
(begin-mode lines
))
580 ('line-loop
(begin-mode line-loop
))
581 ('line-strip
(begin-mode line-strip
))
582 ('triangles
(begin-mode triangles
))
583 ('triangle-strip
(begin-mode triangle-strip
))
584 ('triangle-fan
(begin-mode triangle-fan
))))
586 (define* (render-vertices array
#:optional count
)
587 (gpu-state-set! *vertex-array-state
* array
)
588 (let ((indices (vertex-array-indices array
)))
589 (gl-draw-elements (vertex-array-mode-gl array
)
591 (typed-buffer-length indices
))
592 (typed-buffer-type-gl indices
)
595 (define* (render-vertices/instanced array instances
#:optional count
)
596 (gpu-state-set! *vertex-array-state
* array
)
597 (let ((indices (vertex-array-indices array
)))
598 (gl-draw-elements-instanced (vertex-array-mode-gl array
)
600 (typed-buffer-length indices
))
601 (typed-buffer-type-gl indices
)