render: Rename "typed buffer" to "buffer view".
[chickadee.git] / chickadee / render / buffer.scm
1 ;;; Chickadee Game Toolkit
2 ;;; Copyright © 2016, 2017 David Thompson <davet@gnu.org>
3 ;;;
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.
8 ;;;
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.
13 ;;;
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/>.
17
18 ;;; Commentary:
19 ;;
20 ;; GPU data buffers.
21 ;;
22 ;;; Code:
23
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)
32 #:use-module (gl)
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)
38 #:export (make-buffer
39 make-streaming-buffer
40 buffer?
41 index-buffer?
42 buffer-mapped?
43 buffer-name
44 buffer-length
45 buffer-stride
46 buffer-target
47 buffer-usage
48 buffer-data
49 null-buffer
50 map-buffer!
51 unmap-buffer!
52 with-mapped-buffer
53 *buffer-state*
54 make-buffer-view
55 make-streaming-buffer-view
56 buffer-view?
57 buffer-view->buffer
58 buffer-view->vector
59 buffer-view-name
60 buffer-view-offset
61 buffer-view-component-type
62 buffer-view-normalized?
63 buffer-view-count
64 buffer-view-type
65 buffer-view-max
66 buffer-view-min
67 buffer-view-sparse
68 buffer-view-data
69 buffer-view-divisor
70 map-buffer-view!
71 unmap-buffer-view!
72 with-mapped-buffer-view
73 make-vertex-array
74 vertex-array?
75 vertex-array-indices
76 vertex-array-attributes
77 vertex-array-mode
78 null-vertex-array
79 *vertex-array-state*
80 render-vertices
81 render-vertices/instanced))
82
83 ;;;
84 ;;; Buffers
85 ;;;
86
87 (define-record-type <buffer>
88 (%make-buffer id name length stride target usage data)
89 buffer?
90 (id buffer-id)
91 (name buffer-name)
92 (length buffer-length)
93 (stride buffer-stride)
94 (target buffer-target)
95 (usage buffer-usage)
96 (data buffer-data set-buffer-data!))
97
98 (set-record-type-printer! <buffer>
99 (lambda (buffer port)
100 (format port
101 "#<buffer id: ~d name: ~s usage: ~s target: ~s length: ~d stride: ~s>"
102 (buffer-id buffer)
103 (buffer-name buffer)
104 (buffer-usage buffer)
105 (buffer-target buffer)
106 (buffer-length buffer)
107 (buffer-stride buffer))))
108
109 (define null-buffer
110 (%make-buffer 0 "null" 0 0 'vertex 'static #f))
111
112 (define <<buffer>> (class-of null-buffer))
113
114 (define (free-buffer buffer)
115 (gl-delete-buffers 1 (u32vector (buffer-id buffer))))
116
117 (define-method (gpu-finalize (buffer <<buffer>>))
118 (free-buffer buffer))
119
120 (define (apply-buffer buffer)
121 (gl-bind-buffer (buffer-target-gl buffer)
122 (buffer-id buffer)))
123
124 (define *buffer-state*
125 (make-gpu-state apply-buffer null-buffer))
126
127 (define (generate-buffer-gl)
128 (let ((bv (u32vector 1)))
129 (gl-gen-buffers 1 (bytevector->pointer bv))
130 (u32vector-ref bv 0)))
131
132 (define (index-buffer? buffer)
133 "Return #t if VIEW is an index buffer view."
134 (eq? (buffer-target buffer) 'index))
135
136 (define (buffer-usage-gl buffer)
137 (match (buffer-usage buffer)
138 ('static (arb-vertex-buffer-object static-draw-arb))
139 ('stream (arb-vertex-buffer-object stream-draw-arb))))
140
141 (define (buffer-target-gl buffer)
142 (if (index-buffer? buffer)
143 (arb-vertex-buffer-object element-array-buffer-arb)
144 (arb-vertex-buffer-object array-buffer-arb)))
145
146 (define* (make-buffer data #:key
147 (name "anonymous")
148 (length (bytevector-length data))
149 (offset 0)
150 (stride 0)
151 (target 'vertex)
152 (usage 'static))
153 "Upload DATA, a bytevector, to the GPU. By default, the entire
154 bytevector is uploaded. A subset of the data may be uploaded by
155 specifying the OFFSET, the index of the first byte to be uploaded, and
156 LENGTH, the number of bytes to upload.
157
158 If DATA is #f, allocate LENGTH bytes of fresh GPU memory instead.
159
160 TARGET and USAGE are hints that tell the GPU how the buffer is
161 intended to be used.
162
163 TARGET may be:
164 - vertex: Vertex attribute data.
165 - index: Index buffer data.
166
167 USAGE may be:
168 - static: The buffer data will not be modified after creation.
169 - stream: The buffer data will be modified frequently.
170
171 NAME is simply an arbitrary string for debugging purposes that is
172 never sent to the GPU."
173 ;; Weird bugs will occur when creating a new vertex buffer while a
174 ;; vertex array is bound.
175 (gpu-state-set! *vertex-array-state* null-vertex-array)
176 (let ((buffer (gpu-guard
177 (%make-buffer (generate-buffer-gl)
178 name
179 length
180 stride
181 target
182 usage
183 #f))))
184 (gpu-state-set! *buffer-state* buffer)
185 (gl-buffer-data (buffer-target-gl buffer)
186 length
187 (if data
188 (bytevector->pointer data offset)
189 %null-pointer)
190 (buffer-usage-gl buffer))
191 (gpu-state-set! *buffer-state* null-buffer)
192 buffer))
193
194 (define* (make-streaming-buffer length #:key
195 (name "anonymous")
196 (target 'vertex))
197 "Return a new vertex buffer of LENGTH bytes, named NAME, suitable
198 for streaming data to the GPU every frame."
199 (make-buffer #f #:usage 'stream #:length length #:name name #:target target))
200
201 (define (buffer-mapped? buffer)
202 "Return #t if buffer data has been mapped from GPU."
203 (if (buffer-data buffer) #t #f))
204
205 (define* (map-buffer! buffer #:optional (mode 'read-write))
206 "Map the memory space for BUFFER from the GPU to the CPU, allowing
207 the vertex buffer to be updated with new vertex data. The
208 'unmap-buffer!' procedure must be called to submit the new
209 vertex buffer data back to the GPU."
210 (unless (buffer-mapped? buffer) ;; Don't map a buffer that is already mapped!
211 (let ((target (buffer-target-gl buffer))
212 (length (buffer-length buffer)))
213 (gpu-state-set! *buffer-state* buffer)
214 (when (eq? (buffer-usage buffer) 'stream)
215 ;; Orphan the buffer to avoid implicit synchronization.
216 ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
217 (gl-buffer-data target length %null-pointer (buffer-usage-gl buffer)))
218 (let ((ptr (gl-map-buffer target (match mode
219 ('read-write (version-1-5 read-write))
220 ('read-only (version-1-5 read-only))
221 ('write-only (version-1-5 write-only))))))
222 (set-buffer-data! buffer (pointer->bytevector ptr length))))))
223
224 (define (unmap-buffer! buffer)
225 "Return the mapped vertex buffer data for BUFFER to the GPU."
226 (gpu-state-set! *buffer-state* buffer)
227 (gl-unmap-buffer (buffer-target-gl buffer))
228 (set-buffer-data! buffer #f))
229
230 (define-syntax-rule (with-mapped-buffer buffer body ...)
231 (dynamic-wind
232 (lambda ()
233 (map-buffer! buffer))
234 (lambda () body ...)
235 (lambda ()
236 (unmap-buffer! buffer))))
237
238 \f
239 ;;;
240 ;;; Buffer Views
241 ;;;
242
243 (define-record-type <buffer-view>
244 (%make-buffer-view name buffer offset component-type
245 normalized? length type max min sparse divisor)
246 buffer-view?
247 (name buffer-view-name)
248 (buffer buffer-view->buffer)
249 (offset buffer-view-offset)
250 (component-type buffer-view-component-type)
251 (normalized? buffer-view-normalized?)
252 (length buffer-view-length)
253 (type buffer-view-type)
254 (max buffer-view-max)
255 (min buffer-view-min)
256 (sparse buffer-view-sparse)
257 (divisor buffer-view-divisor)) ; for instanced rendering
258
259 (define (buffer-view-stride buffer-view)
260 (or (buffer-stride (buffer-view->buffer buffer-view))
261 (* (type-size (buffer-view-type buffer-view))
262 (component-type-size (buffer-view-component-type buffer-view)))))
263
264 (define (num-elements byte-length byte-offset type component-type)
265 (inexact->exact
266 (floor
267 (/ (- byte-length byte-offset)
268 (* (component-type-size component-type)
269 (type-size type))))))
270
271
272 (define* (make-buffer-view #:key
273 (name "anonymous")
274 buffer
275 type
276 component-type
277 normalized?
278 (offset 0)
279 (length (num-elements (buffer-length buffer)
280 offset
281 type
282 component-type))
283 max
284 min
285 sparse
286 divisor)
287 "Return a new typed buffer view for BUFFER starting at byte index
288 OFFSET of LENGTH elements, where each element is of TYPE and composed
289 of COMPONENT-TYPE values.
290
291 Valid values for TYPE are:
292 - scalar: single number
293 - vec2: 2D vector
294 - vec3: 3D vector
295 - vec4: 4D vector
296 - mat2: 2x2 matrix
297 - mat3: 3x3 matrix
298 - mat4: 4x4 matrix
299
300 Valid values for COMPONENT-TYPE are:
301
302 - byte
303 - unsigned-byte
304 - short
305 - unsigned-short
306 - int
307 - unsigned-int
308 - float
309 - double
310
311 DIVISOR is only needed for instanced rendering applications and
312 represents how many instances each vertex element applies to. A
313 divisor of 0 means that a single element is used for every instance
314 and is used for the data being instanced. A divisor of 1 means that
315 each element is used for 1 instance. A divisor of 2 means that each
316 element is used for 2 instances, and so on."
317 (%make-buffer-view name buffer offset component-type
318 normalized? length type max min sparse divisor))
319
320 (define (type-size type)
321 (match type
322 ('scalar 1)
323 ('vec2 2)
324 ('vec3 3)
325 ((or 'vec4 'mat2) 4)
326 ('mat3 9)
327 ('mat4 16)))
328
329 (define (component-type-size component-type)
330 (match component-type
331 ('byte 1)
332 ('unsigned-byte 1)
333 ('short 2)
334 ('unsigned-short 2)
335 ('int 4)
336 ('unsigned-int 4)
337 ('float 4)
338 ('double 8)))
339
340 (define* (make-streaming-buffer-view type component-type length #:key
341 (name "anonymous")
342 (target 'vertex)
343 data
344 divisor)
345 "Return a new typed buffer to hold LENGTH elements of TYPE whose
346 components are comprised of COMPONENT-TYPE values. The underlying
347 untyped buffer is configured for GPU streaming. Optonally, a NAME can
348 be specified for the buffer. If the buffer will be used for instanced
349 rendering, the DIVISOR argument must be used to specify the rate at
350 which attributes advance when rendering multiple instances."
351 (let* ((buffer-length
352 (* length (type-size type) (component-type-size component-type)))
353 (buffer (if data
354 (make-buffer data
355 #:name name
356 #:length buffer-length
357 #:usage 'stream
358 #:target target)
359 (make-streaming-buffer buffer-length
360 #:name name
361 #:target target))))
362 (make-buffer-view #:name name
363 #:buffer buffer
364 #:type type
365 #:component-type component-type
366 #:length length
367 #:divisor divisor)))
368
369 (define (display-buffer-view buffer-view port)
370 (format port "#<buffer-view name: ~s buffer: ~a type: ~s component-type: ~s length: ~d offset: ~d>"
371 (buffer-view-name buffer-view)
372 (buffer-view->buffer buffer-view)
373 (buffer-view-type buffer-view)
374 (buffer-view-component-type buffer-view)
375 (buffer-view-length buffer-view)
376 (buffer-view-offset buffer-view)))
377
378 (set-record-type-printer! <buffer-view> display-buffer-view)
379
380 (define (buffer-view-type-size buffer-view)
381 (type-size (buffer-view-type buffer-view)))
382
383 (define (buffer-view-data buffer-view)
384 (buffer-data (buffer-view->buffer buffer-view)))
385
386 (define (buffer-view-type-gl buffer-view)
387 (match (buffer-view-component-type buffer-view)
388 ('byte (data-type byte))
389 ('unsigned-byte (data-type unsigned-byte))
390 ('short (data-type short))
391 ('unsigned-short (data-type unsigned-short))
392 ('int (data-type int))
393 ('unsigned-int (data-type unsigned-int))
394 ('float (data-type float))
395 ('double (data-type double))))
396
397 (define (map-buffer-view! buffer-view)
398 (map-buffer! (buffer-view->buffer buffer-view)))
399
400 (define (unmap-buffer-view! buffer-view)
401 (unmap-buffer! (buffer-view->buffer buffer-view)))
402
403 (define-syntax-rule (with-mapped-buffer-view buffer-view body ...)
404 (with-mapped-buffer (buffer-view->buffer buffer-view) body ...))
405
406 (define* (apply-buffer-view buffer-view #:optional attribute-index)
407 (gpu-state-set! *buffer-state* (buffer-view->buffer buffer-view))
408 ;; If there is no attribute-index, we assume this is being bound for
409 ;; use as an index buffer.
410 (when attribute-index
411 (gl-enable-vertex-attrib-array attribute-index)
412 (gl-vertex-attrib-pointer attribute-index
413 (buffer-view-type-size buffer-view)
414 (buffer-view-type-gl buffer-view)
415 (buffer-view-normalized? buffer-view)
416 (buffer-view-stride buffer-view)
417 (make-pointer (buffer-view-offset buffer-view)))
418 (let ((divisor (buffer-view-divisor buffer-view)))
419 (when divisor
420 (gl-vertex-attrib-divisor attribute-index divisor)))))
421
422 ;; TODO: Handle 4-byte alignment rule for the types that need it.
423 (define (buffer-view->vector buffer-view)
424 (define (component-parser type)
425 (match type
426 ('byte bytevector-s8-ref)
427 ('unsigned-byte bytevector-u8-ref)
428 ('short
429 (lambda (bv i)
430 (bytevector-s16-ref bv i (native-endianness))))
431 ('unsigned-short
432 (lambda (bv i)
433 (bytevector-u16-ref bv i (native-endianness))))
434 ('unsigned-int
435 (lambda (bv i)
436 (bytevector-u32-ref bv i (native-endianness))))
437 ('float bytevector-ieee-single-native-ref)))
438 (define (element-parser type component-type)
439 (let ((parse-component (component-parser component-type))
440 (component-type-size (component-type-size component-type)))
441 (match type
442 ('scalar parse-component)
443 ('vec2
444 (lambda (bv i)
445 (vec2 (parse-component bv i)
446 (parse-component bv (+ i component-type-size)))))
447 ('vec3
448 (lambda (bv i)
449 (vec3 (parse-component bv i)
450 (parse-component bv (+ i component-type-size))
451 (parse-component bv (+ i (* component-type-size 2))))))
452 ;; TODO: Use a proper vec4 type when it exists.
453 ('vec4
454 (lambda (bv i)
455 (vector (parse-component bv i)
456 (parse-component bv (+ i component-type-size))
457 (parse-component bv (+ i (* component-type-size 2)))
458 (parse-component bv (+ i (* component-type-size 3))))))
459 ;; TODO: Use proper matrix2 type when it exists.
460 ('mat2
461 (lambda (bv i)
462 (vector (vector (parse-component bv i)
463 (parse-component bv (+ i component-type-size)))
464 (vector (parse-component bv (+ i (* component-type-size 2)))
465 (parse-component bv (+ i (* component-type-size 3)))))))
466 ;; TODO: Use proper matrix3 type when it exists.
467 ('mat3
468 (lambda (bv i)
469 (vector (vector (parse-component bv i)
470 (parse-component bv (+ i component-type-size))
471 (parse-component bv (+ i (* component-type-size 2))))
472 (vector (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 ('mat4
476 (lambda (bv i)
477 (make-matrix4 (parse-component bv i)
478 (parse-component bv (+ i component-type-size))
479 (parse-component bv (+ i (* component-type-size 2)))
480 (parse-component bv (+ i (* component-type-size 3)))
481 (parse-component bv (+ i (* component-type-size 4)))
482 (parse-component bv (+ i (* component-type-size 5)))
483 (parse-component bv (+ i (* component-type-size 6)))
484 (parse-component bv (+ i (* component-type-size 7)))
485 (parse-component bv (+ i (* component-type-size 8)))
486 (parse-component bv (+ i (* component-type-size 9)))
487 (parse-component bv (+ i (* component-type-size 10)))
488 (parse-component bv (+ i (* component-type-size 11)))
489 (parse-component bv (+ i (* component-type-size 12)))
490 (parse-component bv (+ i (* component-type-size 13)))
491 (parse-component bv (+ i (* component-type-size 14)))
492 (parse-component bv (+ i (* component-type-size 15)))))))))
493 (with-mapped-buffer-view buffer-view
494 (let* ((data (buffer-view-data buffer-view))
495 (length (buffer-view-length buffer-view))
496 (offset (buffer-view-offset buffer-view))
497 (stride (buffer-view-stride buffer-view))
498 (type (buffer-view-type buffer-view))
499 (component-type (buffer-view-component-type buffer-view))
500 (type-byte-size (* (type-size type)
501 (component-type-size component-type)))
502 (v (make-vector length))
503 (parse-element (element-parser type component-type)))
504 (let loop ((i 0))
505 (when (< i length)
506 (let ((byte-index (+ (* i stride) offset)))
507 (vector-set! v i (parse-element data byte-index)))
508 (loop (+ i 1))))
509 v)))
510
511 \f
512 ;;;
513 ;;; Vertex Arrays
514 ;;;
515
516 (define-record-type <vertex-array>
517 (%make-vertex-array id indices attributes mode)
518 vertex-array?
519 (id vertex-array-id)
520 (indices vertex-array-indices)
521 (attributes vertex-array-attributes)
522 (mode vertex-array-mode))
523
524 (set-record-type-printer! <vertex-array>
525 (lambda (array port)
526 (format port
527 "#<vertex-array indices: ~a attributes: ~a mode: ~s>"
528 (vertex-array-indices array)
529 (vertex-array-attributes array)
530 (vertex-array-mode array))))
531
532 (define null-vertex-array (%make-vertex-array 0 #f '() 'triangles))
533
534 (define <<vertex-array>> (class-of null-vertex-array))
535
536 (define (generate-vertex-array)
537 (let ((bv (u32vector 1)))
538 (gl-gen-vertex-arrays 1 (bytevector->pointer bv))
539 (u32vector-ref bv 0)))
540
541 (define (free-vertex-array va)
542 (gl-delete-vertex-arrays 1 (u32vector (vertex-array-id va))))
543
544 (define-method (gpu-finalize (va <<vertex-array>>))
545 (free-vertex-array va))
546
547 (define (apply-vertex-array va)
548 (gl-bind-vertex-array (vertex-array-id va)))
549
550 (define *vertex-array-state*
551 (make-gpu-state apply-vertex-array null-vertex-array))
552
553 (define* (make-vertex-array #:key indices attributes (mode 'triangles))
554 "Return a new vertex array using the index data within the typed
555 buffer INDICES and the vertex attribute data within ATTRIBUTES, an
556 alist mapping shader attribute indices to typed buffers containing
557 vertex data.
558
559 By default, the vertex array is interpreted as containing a series of
560 triangles. If another primtive type is desired, the MODE keyword
561 argument may be overridden. The following values are supported:
562
563 - points
564 - lines
565 - line-loop
566 - line-strip
567 - triangles
568 - triangle-strip
569 - triangle-fan"
570 (let ((array (gpu-guard
571 (%make-vertex-array (generate-vertex-array)
572 indices
573 attributes
574 mode))))
575 (gpu-state-set! *vertex-array-state* array)
576 (for-each (match-lambda
577 ((index . buffer-view)
578 (apply-buffer-view buffer-view index)))
579 attributes)
580 (apply-buffer-view indices)
581 (gpu-state-set! *vertex-array-state* null-vertex-array)
582 array))
583
584 (define (vertex-array-mode-gl array)
585 (match (vertex-array-mode array)
586 ('points (begin-mode points))
587 ('lines (begin-mode lines))
588 ('line-loop (begin-mode line-loop))
589 ('line-strip (begin-mode line-strip))
590 ('triangles (begin-mode triangles))
591 ('triangle-strip (begin-mode triangle-strip))
592 ('triangle-fan (begin-mode triangle-fan))))
593
594 (define* (render-vertices array #:optional count)
595 (gpu-state-set! *vertex-array-state* array)
596 (let ((indices (vertex-array-indices array)))
597 (gl-draw-elements (vertex-array-mode-gl array)
598 (or count
599 (buffer-view-length indices))
600 (buffer-view-type-gl indices)
601 %null-pointer)))
602
603 (define* (render-vertices/instanced array instances #:optional count)
604 (gpu-state-set! *vertex-array-state* array)
605 (let ((indices (vertex-array-indices array)))
606 (gl-draw-elements-instanced (vertex-array-mode-gl array)
607 (or count
608 (buffer-view-length indices))
609 (buffer-view-type-gl indices)
610 %null-pointer
611 instances)))