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