render: sprite: Allow passing custom transformation matrices.
[chickadee.git] / chickadee / render / sprite.scm
1 ;;; Chickadee Game Toolkit
2 ;;; Copyright © 2016 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 (define-module (chickadee render sprite)
19 #:use-module (rnrs bytevectors)
20 #:use-module (srfi srfi-4)
21 #:use-module (srfi srfi-9)
22 #:use-module (srfi srfi-11)
23 #:use-module (chickadee math matrix)
24 #:use-module (chickadee math rect)
25 #:use-module (chickadee math vector)
26 #:use-module (chickadee render)
27 #:use-module (chickadee render shader)
28 #:use-module (chickadee render texture)
29 #:use-module (chickadee render buffer)
30 #:export (draw-sprite
31 with-batched-sprites
32 draw-nine-patch))
33
34 (define default-shader
35 (delay
36 (strings->shader
37 "
38 #version 330
39
40 in vec2 position;
41 in vec2 tex;
42 out vec2 frag_tex;
43 uniform mat4 mvp;
44
45 void main(void) {
46 frag_tex = tex;
47 gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
48 }
49 "
50 "
51 #version 330
52
53 in vec2 frag_tex;
54 uniform sampler2D color_texture;
55
56 void main (void) {
57 gl_FragColor = texture2D(color_texture, frag_tex);
58 }
59 ")))
60
61 (define draw-sprite-unbatched
62 (let* ((position-buffer
63 (delay
64 (make-streaming-typed-buffer 'vec2 'float 4
65 #:name "unbatched-sprite-vertices")))
66 (texcoord-buffer
67 (delay
68 (make-streaming-typed-buffer 'vec2 'float 4
69 #:name "unbatched-sprite-texcoords")))
70 (index-buffer
71 (delay
72 (make-typed-buffer #:name "unbatched-sprite-indices"
73 #:type 'scalar
74 #:component-type 'unsigned-int
75 #:buffer (make-buffer (u32vector 0 3 2 0 2 1)
76 #:target 'index))))
77 (vertex-array
78 (delay
79 (make-vertex-array #:indices (force index-buffer)
80 #:attributes
81 `((0 . ,(force position-buffer))
82 (1 . ,(force texcoord-buffer))))))
83 (mvp (make-null-matrix4)))
84 (lambda (texture region world-matrix blend-mode shader texture-region)
85 (with-mapped-typed-buffer (force position-buffer)
86 (let* ((x1 (rect-x region))
87 (y1 (rect-y region))
88 (x2 (+ x1 (rect-width region)))
89 (y2 (+ y1 (rect-height region)))
90 (bv (typed-buffer-data (force position-buffer))))
91 (f32vector-set! bv 0 x1)
92 (f32vector-set! bv 1 y1)
93 (f32vector-set! bv 2 x2)
94 (f32vector-set! bv 3 y1)
95 (f32vector-set! bv 4 x2)
96 (f32vector-set! bv 5 y2)
97 (f32vector-set! bv 6 x1)
98 (f32vector-set! bv 7 y2)))
99 (with-mapped-typed-buffer (force texcoord-buffer)
100 (let ((s1 (rect-left texture-region))
101 (t1 (rect-bottom texture-region))
102 (s2 (rect-right texture-region))
103 (t2 (rect-top texture-region))
104 (bv (typed-buffer-data (force texcoord-buffer))))
105 (f32vector-set! bv 0 s1)
106 (f32vector-set! bv 1 t1)
107 (f32vector-set! bv 2 s2)
108 (f32vector-set! bv 3 t1)
109 (f32vector-set! bv 4 s2)
110 (f32vector-set! bv 5 t2)
111 (f32vector-set! bv 6 s1)
112 (f32vector-set! bv 7 t2)))
113 (with-blend-mode blend-mode
114 (with-texture 0 texture
115 (gpu-apply shader (force vertex-array)
116 #:mvp (if world-matrix
117 (begin
118 (matrix4-mult! mvp world-matrix
119 (current-projection))
120 mvp)
121 (current-projection))))))))
122
123 \f
124 ;;;
125 ;;; Sprite Batch
126 ;;;
127
128 (define-record-type <sprite-batch>
129 (%make-sprite-batch texture blend-mode shader size capacity index-buffer
130 position-buffer texture-buffer vertex-array)
131 sprite-batch?
132 (texture sprite-batch-texture set-sprite-batch-texture!)
133 (blend-mode sprite-batch-blend-mode set-sprite-batch-blend-mode!)
134 (shader sprite-batch-shader set-sprite-batch-shader!)
135 (size sprite-batch-size set-sprite-batch-size!)
136 (capacity sprite-batch-capacity set-sprite-batch-capacity!)
137 (index-buffer sprite-batch-index-buffer set-sprite-batch-index-buffer!)
138 (position-buffer sprite-batch-position-buffer set-sprite-batch-position-buffer!)
139 (texture-buffer sprite-batch-texture-buffer set-sprite-batch-texture-buffer!)
140 (vertex-array sprite-batch-vertex-array set-sprite-batch-vertex-array!))
141
142 (define (init-sprite-batch batch capacity)
143 (let* ((index (make-streaming-typed-buffer 'scalar
144 'unsigned-int
145 (* capacity 6)
146 #:target 'index))
147 (pos (make-streaming-typed-buffer 'vec2 'float (* capacity 4)
148 #:name "batched-sprite-vertices"))
149 (tex (make-streaming-typed-buffer 'vec2 'float (* capacity 4)
150 #:name "batched-sprite-vertices"))
151 (va (make-vertex-array #:indices index
152 #:attributes `((0 . ,pos) (1 . ,tex)))))
153 (set-sprite-batch-capacity! batch capacity)
154 (set-sprite-batch-index-buffer! batch index)
155 (set-sprite-batch-position-buffer! batch pos)
156 (set-sprite-batch-texture-buffer! batch tex)
157 (set-sprite-batch-vertex-array! batch va)))
158
159 (define (make-sprite-batch capacity)
160 "Make a sprite batch that can hold CAPACITY sprites."
161 (let ((batch (%make-sprite-batch #f #f #f 0 0 #f #f #f #f)))
162 (init-sprite-batch batch capacity)
163 batch))
164
165 (define (sprite-batch-full? batch)
166 (= (sprite-batch-capacity batch) (sprite-batch-size batch)))
167
168 (define (double-sprite-batch-size! batch)
169 (let* ((old-index (sprite-batch-index-buffer batch))
170 (old-verts (sprite-batch-position-buffer batch))
171 (old-tex (sprite-batch-texture-buffer batch))
172 (old-index-data (typed-buffer-data old-index))
173 (old-verts-data (typed-buffer-data old-verts))
174 (old-tex-data (typed-buffer-data old-tex)))
175 (unmap-typed-buffer! old-index)
176 (unmap-typed-buffer! old-verts)
177 (unmap-typed-buffer! old-tex)
178 (init-sprite-batch batch (* (sprite-batch-capacity batch) 2))
179 (sprite-batch-begin! batch)
180 (let ((new-index (sprite-batch-index-buffer batch))
181 (new-verts (sprite-batch-position-buffer batch))
182 (new-tex (sprite-batch-texture-buffer batch)))
183 (define (copy from to)
184 (bytevector-copy! from 0
185 (typed-buffer-data to) 0
186 (bytevector-length from)))
187 (copy old-index-data new-index)
188 (copy old-verts-data new-verts)
189 (copy old-tex-data new-tex))))
190
191 (define (sprite-batch-reset! batch)
192 "Reset BATCH to size 0."
193 (set-sprite-batch-texture! batch #f)
194 (set-sprite-batch-blend-mode! batch #f)
195 (set-sprite-batch-shader! batch #f)
196 (set-sprite-batch-size! batch 0))
197
198 (define (sprite-batch-begin! batch)
199 (map-typed-buffer! (sprite-batch-index-buffer batch))
200 (map-typed-buffer! (sprite-batch-position-buffer batch))
201 (map-typed-buffer! (sprite-batch-texture-buffer batch)))
202
203 (define (sprite-batch-flush! batch)
204 "Render the contents of BATCH and clear the cache."
205 (unless (zero? (sprite-batch-size batch))
206 (with-blend-mode (sprite-batch-blend-mode batch)
207 (with-texture 0 (sprite-batch-texture batch)
208 (unmap-typed-buffer! (sprite-batch-index-buffer batch))
209 (unmap-typed-buffer! (sprite-batch-position-buffer batch))
210 (unmap-typed-buffer! (sprite-batch-texture-buffer batch))
211 (gpu-apply* (sprite-batch-shader batch)
212 (sprite-batch-vertex-array batch)
213 (* (sprite-batch-size batch) 6)
214 #:mvp (current-projection))
215 (sprite-batch-reset! batch)))))
216
217 (define sprite-batch-add!
218 (let ((world1 (vec2 0.0 0.0))
219 (world2 (vec2 0.0 0.0))
220 (world3 (vec2 0.0 0.0))
221 (world4 (vec2 0.0 0.0))
222 (offset-bv (make-u32vector 1)))
223 (define (set-offset offset)
224 (u32vector-set! offset-bv 0 offset))
225 (define (offset)
226 (u32vector-ref offset-bv 0))
227 (lambda (batch texture region world-matrix blend-mode
228 shader texture-region)
229 ;; Expand the buffers when necessary.
230 (when (sprite-batch-full? batch)
231 (double-sprite-batch-size! batch))
232 ;; Flush the batch if any GL state needs changing.
233 (unless (and (eq? (sprite-batch-texture batch) texture)
234 (eq? (sprite-batch-blend-mode batch) blend-mode)
235 (eq? (sprite-batch-shader batch) shader))
236 (sprite-batch-flush! batch)
237 (sprite-batch-begin! batch)
238 (set-sprite-batch-texture! batch texture)
239 (set-sprite-batch-blend-mode! batch blend-mode)
240 (set-sprite-batch-shader! batch shader))
241 (let ((size (sprite-batch-size batch)))
242 (let* ((indices (typed-buffer-data (sprite-batch-index-buffer batch)))
243 (vertices (typed-buffer-data (sprite-batch-position-buffer batch)))
244 (texcoords (typed-buffer-data (sprite-batch-texture-buffer batch)))
245 (local-x1 (rect-x region))
246 (local-y1 (rect-y region))
247 (local-x2 (+ local-x1 (rect-width region)))
248 (local-y2 (+ local-y1 (rect-height region)))
249 (s1 (rect-left texture-region))
250 (t1 (rect-bottom texture-region))
251 (s2 (rect-right texture-region))
252 (t2 (rect-top texture-region)))
253 (set-vec2-x! world1 local-x1)
254 (set-vec2-y! world1 local-y1)
255 (set-vec2-x! world2 local-x2)
256 (set-vec2-y! world2 local-y1)
257 (set-vec2-x! world3 local-x2)
258 (set-vec2-y! world3 local-y2)
259 (set-vec2-x! world4 local-x1)
260 (set-vec2-y! world4 local-y2)
261 (when world-matrix
262 (transform! world-matrix world1)
263 (transform! world-matrix world2)
264 (transform! world-matrix world3)
265 (transform! world-matrix world4))
266 ;; Add indices.
267 (set-offset (* size 4))
268 (let ((index-vertex-offset (offset)))
269 (set-offset (* size 6))
270 (u32vector-set! indices (offset) index-vertex-offset)
271 (u32vector-set! indices (+ (offset) 1) (+ index-vertex-offset 3))
272 (u32vector-set! indices (+ (offset) 2) (+ index-vertex-offset 2))
273 (u32vector-set! indices (+ (offset) 3) index-vertex-offset)
274 (u32vector-set! indices (+ (offset) 4) (+ index-vertex-offset 2))
275 (u32vector-set! indices (+ (offset) 5) (+ index-vertex-offset 1)))
276 ;; Add vertices.
277 (set-offset (* size 8)) ;; 4 vertices, 2 floats per vertex
278 ;; Bottom-left
279 (f32vector-set! vertices (offset) (vec2-x world1))
280 (f32vector-set! vertices (+ (offset) 1) (vec2-y world1))
281 ;; Bottom-right
282 (f32vector-set! vertices (+ (offset) 2) (vec2-x world2))
283 (f32vector-set! vertices (+ (offset) 3) (vec2-y world2))
284 ;; Top-right
285 (f32vector-set! vertices (+ (offset) 4) (vec2-x world3))
286 (f32vector-set! vertices (+ (offset) 5) (vec2-y world3))
287 ;; Top-left
288 (f32vector-set! vertices (+ (offset) 6) (vec2-x world4))
289 (f32vector-set! vertices (+ (offset) 7) (vec2-y world4))
290 ;; Add texture coordinates.
291 (set-offset (* size 8))
292 ;; Bottom-left
293 (f32vector-set! texcoords (offset) s1)
294 (f32vector-set! texcoords (+ (offset) 1) t1)
295 ;; Bottom-right
296 (f32vector-set! texcoords (+ (offset) 2) s2)
297 (f32vector-set! texcoords (+ (offset) 3) t1)
298 ;; Top-right
299 (f32vector-set! texcoords (+ (offset) 4) s2)
300 (f32vector-set! texcoords (+ (offset) 5) t2)
301 ;; Top-left
302 (f32vector-set! texcoords (+ (offset) 6) s1)
303 (f32vector-set! texcoords (+ (offset) 7) t2)
304 (set-sprite-batch-size! batch (1+ size)))))))
305
306 (define *batch?* #f)
307 (define %batch (delay (make-sprite-batch 256)))
308
309 (define (draw-sprite-batched texture region world-matrix blend-mode shader
310 texture-region)
311 (sprite-batch-add! (force %batch) texture region world-matrix blend-mode
312 shader texture-region))
313
314 (define-syntax-rule (with-batched-sprites body ...)
315 "Use batched rendering for all draw-sprite calls within BODY."
316 (if *batch?*
317 (begin body ...)
318 (dynamic-wind
319 (lambda ()
320 (set! *batch?* #t))
321 (lambda ()
322 (sprite-batch-reset! (force %batch))
323 body ...
324 (sprite-batch-flush! (force %batch)))
325 (lambda ()
326 (set! *batch?* #f)))))
327
328 (define texture-gl-size
329 (@@ (chickadee render texture) texture-gl-size))
330 (define texture-region-gl-size
331 (@@ (chickadee render texture) texture-region-gl-size))
332 (define texture-region-gl-rect
333 (@@ (chickadee render texture) texture-region-gl-rect))
334
335 (define %default-texcoords (make-rect 0.0 0.0 1.0 1.0))
336 (define %default-offset (vec2 0.0 0.0))
337
338 (define draw-sprite
339 (let ((rect (make-rect 0.0 0.0 0.0 0.0))
340 (tmp-matrix (make-null-matrix4))
341 (%matrix (make-null-matrix4)))
342 (lambda* (texture
343 region
344 #:key
345 (scale 1.0)
346 (rotation 0)
347 matrix
348 (offset %default-offset)
349 (blend-mode 'alpha)
350 (texcoords
351 (if (texture-region? texture)
352 (texture-region-gl-rect texture)
353 %default-texcoords))
354 (shader (force default-shader)))
355 "Draw TEXTURE over the area defined by the rect REGION. Instead
356 of a rect, REGION may be a vec2 representing the position of the
357 sprite, in which case the width and height of the sprite corresponds
358 to the size of the texture. TEXTURE may be a texture or a texture
359 region.
360
361 ROTATION specifies the angle to rotate the sprite, in radians. SCALE
362 specifies the scaling factor. No scaling or rotation is applied by
363 default. Alternatively, MATRIX may be specified, in which case
364 ROTATION and SCALE are ignored and the given transformation matrix is
365 used instead. All transformations are applied relative to the lower
366 left corner of the sprite by default. This can be changed by
367 specifying an OFFSET vector.
368
369 By default, alpha
370 blending is used but can be changed by setting BLEND-MODE. Finally,
371 advanced users may pass SHADER to change the way the sprite is
372 rendered entirely."
373 (let* ((size (if (texture-region? texture)
374 (texture-region-gl-size texture)
375 (texture-gl-size texture)))
376 (texture (if (texture-region? texture)
377 (texture-region-texture texture)
378 texture))
379 (matrix (cond
380 (matrix matrix) ; user-specified matrix
381 ((or rotation scale) ; compute matrix on-the-fly
382 (matrix4-identity! %matrix)
383 (unless (zero? rotation)
384 (matrix4-rotate-z! tmp-matrix rotation)
385 (matrix4-mult! %matrix %matrix tmp-matrix))
386 (unless (= scale 1.0)
387 (matrix4-scale! tmp-matrix scale)
388 (matrix4-mult! %matrix %matrix tmp-matrix))
389 (matrix4-translate! tmp-matrix region)
390 (matrix4-mult! %matrix %matrix tmp-matrix)
391 %matrix)
392 ;; No transformation needed, in which case we
393 ;; use no matrix at all in order to save cycles
394 ;; and not waste time multiplying against the
395 ;; identity matrix.
396 (else #f))))
397 (cond
398 ((and (rect? region)
399 (not matrix)
400 (zero? rotation) ; no rotation
401 (= scale 1.0)) ; no scale
402 ;; We won't be using a transformation matrix.
403 ;; Just apply the offset.
404 (set-rect-x! rect (- (rect-x region) (vec2-x offset)))
405 (set-rect-y! rect (- (rect-y region) (vec2-y offset)))
406 (set-rect-width! rect (rect-width region))
407 (set-rect-height! rect (rect-height region)))
408 ((rect? region)
409 ;; We will be using a transformation matrix, so
410 ;; ignore the region's X and Y coordinates as
411 ;; those will be accounted for in the
412 ;; translation matrix.
413 (set-rect-x! rect (- (vec2-x offset)))
414 (set-rect-y! rect (- (vec2-y offset)))
415 (set-rect-width! rect (rect-width region))
416 (set-rect-height! rect (rect-height region)))
417 ((and (not matrix)
418 (zero? rotation)
419 (= scale 1.0))
420 ;; No region specified and no transformation
421 ;; matrix. Use texture width/height for the
422 ;; dimensions of the region.
423 (set-rect-x! rect (- (vec2-x region) (vec2-x offset)))
424 (set-rect-y! rect (- (vec2-y region) (vec2-y offset)))
425 (set-rect-width! rect (f32vector-ref size 0))
426 (set-rect-height! rect (f32vector-ref size 1)))
427 (else
428 ;; No region specified but we will be using a
429 ;; transformation matrix.
430 (set-rect-x! rect (- (vec2-x offset)))
431 (set-rect-y! rect (- (vec2-y offset)))
432 (set-rect-width! rect (f32vector-ref size 0))
433 (set-rect-height! rect (f32vector-ref size 1))))
434 (if *batch?*
435 (draw-sprite-batched texture rect matrix blend-mode
436 shader texcoords)
437 (draw-sprite-unbatched texture rect matrix blend-mode
438 shader texcoords))))))
439
440 \f
441 ;;;
442 ;;; Nine Patches
443 ;;;
444
445 (define draw-nine-patch
446 (let ((rect (make-rect 0.0 0.0 0.0 0.0))
447 (trect (make-rect 0.0 0.0 0.0 0.0)))
448 (lambda* (texture region #:key (margin 0)
449 (top-margin margin) (bottom-margin margin)
450 (left-margin margin) (right-margin margin)
451 (offset %default-offset)
452 (rotation 0)
453 (scale 1.0)
454 matrix
455 (blend-mode 'alpha)
456 (shader (force default-shader)))
457 "Draw a \"nine patch\" sprite. A nine patch sprite renders
458 TEXTURE as a WIDTH x HEIGHT rectangle whose stretchable areas are
459 defined by the given margin measurements. The corners are never
460 stretched, the left and right edges may be stretched vertically, the
461 top and bottom edges may be stretched horizontally, and the center may
462 be stretched in both directions. This rendering technique is
463 particularly well suited for resizable windows and buttons in
464 graphical user interfaces.
465
466 MARGIN specifies the margin size for all sides of the nine patch. To
467 make margins of differing sizes, the TOP-MARGIN, BOTTOM-MARGIN,
468 LEFT-MARGIN, and RIGHT-MARGIN arguments may be used."
469 (let* ((texcoords (if (texture-region? texture)
470 (texture-region-gl-rect texture)
471 %default-texcoords))
472 (texsize (if (texture-region? texture)
473 (texture-region-gl-size texture)
474 (texture-gl-size texture)))
475 (w (rect-width region))
476 (h (rect-height region))
477 (border-x1 (rect-left region))
478 (border-y1 (rect-bottom region))
479 (border-x2 (rect-right region))
480 (border-y2 (rect-top region))
481 (fill-x1 (+ border-x1 left-margin))
482 (fill-y1 (+ border-y1 bottom-margin))
483 (fill-x2 (- border-x2 right-margin))
484 (fill-y2 (- border-y2 top-margin))
485 (tw (f32vector-ref texsize 0))
486 (th (f32vector-ref texsize 1))
487 (border-s1 (rect-left texcoords))
488 (border-t1 (rect-bottom texcoords))
489 (border-s2 (rect-right texcoords))
490 (border-t2 (rect-top texcoords))
491 (fill-s1 (+ border-s1 (/ left-margin tw)))
492 (fill-t1 (+ border-t1 (/ bottom-margin th)))
493 (fill-s2 (- border-s2 (/ right-margin tw)))
494 (fill-t2 (- border-t2 (/ top-margin th))))
495 (define (draw-piece x1 y1 x2 y2 s1 t1 s2 t2)
496 (set-rect-x! rect x1)
497 (set-rect-y! rect y1)
498 (set-rect-width! rect (- x2 x1))
499 (set-rect-height! rect (- y2 y1))
500 (set-rect-x! trect s1)
501 (set-rect-y! trect t1)
502 (set-rect-width! trect (- s2 s1))
503 (set-rect-height! trect (- t2 t1))
504 (draw-sprite texture rect
505 #:texcoords trect
506 #:offset offset
507 #:scale scale
508 #:rotation rotation
509 #:matrix matrix
510 #:blend-mode blend-mode
511 #:shader shader))
512 (with-batched-sprites
513 ;; bottom-left
514 (draw-piece border-x1 border-y1 fill-x1 fill-y1
515 border-s1 border-t1 fill-s1 fill-t1)
516 ;; bottom-center
517 (draw-piece fill-x1 border-y1 fill-x2 fill-y1
518 fill-s1 border-t1 fill-s2 fill-t1)
519 ;; dbottom-right
520 (draw-piece fill-x2 border-y1 border-x2 fill-y1
521 fill-s2 border-t1 border-s2 fill-t1)
522 ;; center-left
523 (draw-piece border-x1 fill-y1 fill-x1 fill-y2
524 border-s1 fill-t1 fill-s1 fill-t2)
525 ;; center
526 (draw-piece fill-x1 fill-y1 fill-x2 fill-y2
527 fill-s1 fill-t1 fill-s2 fill-t2)
528 ;; center-right
529 (draw-piece fill-x2 fill-y1 border-x2 fill-y2
530 fill-s2 fill-t1 border-s2 fill-t2)
531 ;; top-left
532 (draw-piece border-x1 fill-y2 fill-x1 border-y2
533 border-s1 fill-t2 fill-s1 border-t2)
534 ;; top-center
535 (draw-piece fill-x1 fill-y2 fill-x2 border-y2
536 fill-s1 fill-t2 fill-s2 border-t2)
537 ;; top-right
538 (draw-piece fill-x2 fill-y2 border-x2 border-y2
539 fill-s2 fill-t2 border-s2 border-t2))))))