b07a969b4dffca3d200de3893447bf015bc9ac2e
[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 (tmp-matrix (make-null-matrix4))
84 (mvp (make-null-matrix4))
85 (position (vec2 0 0)))
86 (lambda (texture region scale rotation blend-mode shader texture-region)
87 (with-mapped-typed-buffer (force position-buffer)
88 (let* ((x1 0)
89 (y1 0)
90 (x2 (rect-width region))
91 (y2 (rect-height region))
92 (bv (typed-buffer-data (force position-buffer))))
93 (f32vector-set! bv 0 x1)
94 (f32vector-set! bv 1 y1)
95 (f32vector-set! bv 2 x2)
96 (f32vector-set! bv 3 y1)
97 (f32vector-set! bv 4 x2)
98 (f32vector-set! bv 5 y2)
99 (f32vector-set! bv 6 x1)
100 (f32vector-set! bv 7 y2)))
101 (with-mapped-typed-buffer (force texcoord-buffer)
102 (let ((s1 (rect-left texture-region))
103 (t1 (rect-bottom texture-region))
104 (s2 (rect-right texture-region))
105 (t2 (rect-top texture-region))
106 (bv (typed-buffer-data (force texcoord-buffer))))
107 (f32vector-set! bv 0 s1)
108 (f32vector-set! bv 1 t1)
109 (f32vector-set! bv 2 s2)
110 (f32vector-set! bv 3 t1)
111 (f32vector-set! bv 4 s2)
112 (f32vector-set! bv 5 t2)
113 (f32vector-set! bv 6 s1)
114 (f32vector-set! bv 7 t2)))
115 (matrix4-identity! mvp)
116 (when rotation
117 (matrix4-rotate-z! tmp-matrix rotation)
118 (matrix4-mult! mvp mvp tmp-matrix))
119 (when scale
120 (matrix4-scale! tmp-matrix scale)
121 (matrix4-mult! mvp mvp tmp-matrix))
122 (set-vec2-x! position (rect-x region))
123 (set-vec2-y! position (rect-y region))
124 (matrix4-translate! tmp-matrix position)
125 (matrix4-mult! mvp mvp tmp-matrix)
126 (matrix4-mult! mvp mvp (current-projection))
127 (with-blend-mode blend-mode
128 (with-texture 0 texture
129 (gpu-apply shader (force vertex-array) #:mvp mvp))))))
130
131 \f
132 ;;;
133 ;;; Sprite Batch
134 ;;;
135
136 (define-record-type <sprite-batch>
137 (%make-sprite-batch texture blend-mode shader size capacity index-buffer
138 position-buffer texture-buffer vertex-array)
139 sprite-batch?
140 (texture sprite-batch-texture set-sprite-batch-texture!)
141 (blend-mode sprite-batch-blend-mode set-sprite-batch-blend-mode!)
142 (shader sprite-batch-shader set-sprite-batch-shader!)
143 (size sprite-batch-size set-sprite-batch-size!)
144 (capacity sprite-batch-capacity set-sprite-batch-capacity!)
145 (index-buffer sprite-batch-index-buffer set-sprite-batch-index-buffer!)
146 (position-buffer sprite-batch-position-buffer set-sprite-batch-position-buffer!)
147 (texture-buffer sprite-batch-texture-buffer set-sprite-batch-texture-buffer!)
148 (vertex-array sprite-batch-vertex-array set-sprite-batch-vertex-array!))
149
150 (define (init-sprite-batch batch capacity)
151 (let* ((index (make-streaming-typed-buffer 'scalar
152 'unsigned-int
153 (* capacity 6)
154 #:target 'index))
155 (pos (make-streaming-typed-buffer 'vec2 'float (* capacity 4)
156 #:name "batched-sprite-vertices"))
157 (tex (make-streaming-typed-buffer 'vec2 'float (* capacity 4)
158 #:name "batched-sprite-vertices"))
159 (va (make-vertex-array #:indices index
160 #:attributes `((0 . ,pos) (1 . ,tex)))))
161 (set-sprite-batch-capacity! batch capacity)
162 (set-sprite-batch-index-buffer! batch index)
163 (set-sprite-batch-position-buffer! batch pos)
164 (set-sprite-batch-texture-buffer! batch tex)
165 (set-sprite-batch-vertex-array! batch va)))
166
167 (define (make-sprite-batch capacity)
168 "Make a sprite batch that can hold CAPACITY sprites."
169 (let ((batch (%make-sprite-batch #f #f #f 0 0 #f #f #f #f)))
170 (init-sprite-batch batch capacity)
171 batch))
172
173 (define (sprite-batch-full? batch)
174 (= (sprite-batch-capacity batch) (sprite-batch-size batch)))
175
176 (define (double-sprite-batch-size! batch)
177 (let* ((old-index (sprite-batch-index-buffer batch))
178 (old-verts (sprite-batch-position-buffer batch))
179 (old-tex (sprite-batch-texture-buffer batch))
180 (old-index-data (typed-buffer-data old-index))
181 (old-verts-data (typed-buffer-data old-verts))
182 (old-tex-data (typed-buffer-data old-tex)))
183 (unmap-typed-buffer! old-index)
184 (unmap-typed-buffer! old-verts)
185 (unmap-typed-buffer! old-tex)
186 (init-sprite-batch batch (* (sprite-batch-capacity batch) 2))
187 (sprite-batch-begin! batch)
188 (let ((new-index (sprite-batch-index-buffer batch))
189 (new-verts (sprite-batch-position-buffer batch))
190 (new-tex (sprite-batch-texture-buffer batch)))
191 (define (copy from to)
192 (bytevector-copy! from 0
193 (typed-buffer-data to) 0
194 (bytevector-length from)))
195 (copy old-index-data new-index)
196 (copy old-verts-data new-verts)
197 (copy old-tex-data new-tex))))
198
199 (define (sprite-batch-reset! batch)
200 "Reset BATCH to size 0."
201 (set-sprite-batch-texture! batch #f)
202 (set-sprite-batch-blend-mode! batch #f)
203 (set-sprite-batch-shader! batch #f)
204 (set-sprite-batch-size! batch 0))
205
206 (define (sprite-batch-begin! batch)
207 (map-typed-buffer! (sprite-batch-index-buffer batch))
208 (map-typed-buffer! (sprite-batch-position-buffer batch))
209 (map-typed-buffer! (sprite-batch-texture-buffer batch)))
210
211 (define (sprite-batch-flush! batch)
212 "Render the contents of BATCH and clear the cache."
213 (unless (zero? (sprite-batch-size batch))
214 (with-blend-mode (sprite-batch-blend-mode batch)
215 (with-texture 0 (sprite-batch-texture batch)
216 (unmap-typed-buffer! (sprite-batch-index-buffer batch))
217 (unmap-typed-buffer! (sprite-batch-position-buffer batch))
218 (unmap-typed-buffer! (sprite-batch-texture-buffer batch))
219 (gpu-apply* (sprite-batch-shader batch)
220 (sprite-batch-vertex-array batch)
221 (* (sprite-batch-size batch) 6)
222 #:mvp (current-projection))
223 (sprite-batch-reset! batch)))))
224
225 (define sprite-batch-add!
226 (let ((tmp-matrix (make-null-matrix4))
227 (matrix (make-null-matrix4))
228 (position (vec2 0.0 0.0))
229 (world1 (vec2 0.0 0.0))
230 (world2 (vec2 0.0 0.0))
231 (offset-bv (make-u32vector 1)))
232 (define (set-offset offset)
233 (u32vector-set! offset-bv 0 offset))
234 (define (offset)
235 (u32vector-ref offset-bv 0))
236 (lambda (batch texture region scale rotation blend-mode
237 shader texture-region)
238 ;; Expand the buffers when necessary.
239 (when (sprite-batch-full? batch)
240 (double-sprite-batch-size! batch))
241 ;; Flush the batch if any GL state needs changing.
242 (unless (and (eq? (sprite-batch-texture batch) texture)
243 (eq? (sprite-batch-blend-mode batch) blend-mode)
244 (eq? (sprite-batch-shader batch) shader))
245 (sprite-batch-flush! batch)
246 (sprite-batch-begin! batch)
247 (set-sprite-batch-texture! batch texture)
248 (set-sprite-batch-blend-mode! batch blend-mode)
249 (set-sprite-batch-shader! batch shader))
250 (let ((size (sprite-batch-size batch)))
251 (let* ((indices (typed-buffer-data (sprite-batch-index-buffer batch)))
252 (vertices (typed-buffer-data (sprite-batch-position-buffer batch)))
253 (texcoords (typed-buffer-data (sprite-batch-texture-buffer batch)))
254 (rx (rect-x region))
255 (ry (rect-y region))
256 (local-x1 0.0)
257 (local-y1 0.0)
258 (local-x2 (rect-width region))
259 (local-y2 (rect-height region))
260 (s1 (rect-left texture-region))
261 (t1 (rect-bottom texture-region))
262 (s2 (rect-right texture-region))
263 (t2 (rect-top texture-region)))
264 (if (or rotation scale)
265 (begin
266 (matrix4-identity! matrix)
267 (when rotation
268 (matrix4-rotate-z! tmp-matrix rotation)
269 (matrix4-mult! matrix matrix tmp-matrix))
270 (when scale
271 (matrix4-scale! tmp-matrix scale)
272 (matrix4-mult! matrix matrix tmp-matrix))
273 (set-vec2-x! position rx)
274 (set-vec2-y! position ry)
275 (matrix4-translate! tmp-matrix position)
276 (matrix4-mult! matrix matrix tmp-matrix)
277 (set-vec2-x! world1 local-x1)
278 (set-vec2-y! world1 local-y1)
279 (set-vec2-x! world2 local-x2)
280 (set-vec2-y! world2 local-y2)
281 (transform! matrix world1)
282 (transform! matrix world2))
283 (begin
284 (set-vec2-x! world1 (+ local-x1 rx))
285 (set-vec2-y! world1 (+ local-y1 ry))
286 (set-vec2-x! world2 (+ local-x2 rx))
287 (set-vec2-y! world2 (+ local-y2 ry))))
288 (let ((world-x1 (vec2-x world1))
289 (world-y1 (vec2-y world1))
290 (world-x2 (vec2-x world2))
291 (world-y2 (vec2-y world2)))
292 ;; Add indices.
293 (set-offset (* size 4))
294 (let ((index-vertex-offset (offset)))
295 (set-offset (* size 6))
296 (u32vector-set! indices (offset) index-vertex-offset)
297 (u32vector-set! indices (+ (offset) 1) (+ index-vertex-offset 3))
298 (u32vector-set! indices (+ (offset) 2) (+ index-vertex-offset 2))
299 (u32vector-set! indices (+ (offset) 3) index-vertex-offset)
300 (u32vector-set! indices (+ (offset) 4) (+ index-vertex-offset 2))
301 (u32vector-set! indices (+ (offset) 5) (+ index-vertex-offset 1)))
302 ;; Add vertices.
303 (set-offset (* size 8)) ;; 4 vertices, 2 floats per vertex
304 ;; Bottom-left
305 (f32vector-set! vertices (offset) world-x1)
306 (f32vector-set! vertices (+ (offset) 1) world-y1)
307 ;; Bottom-right
308 (f32vector-set! vertices (+ (offset) 2) world-x2)
309 (f32vector-set! vertices (+ (offset) 3) world-y1)
310 ;; Top-right
311 (f32vector-set! vertices (+ (offset) 4) world-x2)
312 (f32vector-set! vertices (+ (offset) 5) world-y2)
313 ;; Top-left
314 (f32vector-set! vertices (+ (offset) 6) world-x1)
315 (f32vector-set! vertices (+ (offset) 7) world-y2)
316 ;; Add texture coordinates.
317 (set-offset (* size 8))
318 ;; Bottom-left
319 (f32vector-set! texcoords (offset) s1)
320 (f32vector-set! texcoords (+ (offset) 1) t1)
321 ;; Bottom-right
322 (f32vector-set! texcoords (+ (offset) 2) s2)
323 (f32vector-set! texcoords (+ (offset) 3) t1)
324 ;; Top-right
325 (f32vector-set! texcoords (+ (offset) 4) s2)
326 (f32vector-set! texcoords (+ (offset) 5) t2)
327 ;; Top-left
328 (f32vector-set! texcoords (+ (offset) 6) s1)
329 (f32vector-set! texcoords (+ (offset) 7) t2)
330 (set-sprite-batch-size! batch (1+ size))))))))
331
332 (define *batch?* #f)
333 (define %batch (delay (make-sprite-batch 256)))
334
335 (define (draw-sprite-batched texture region
336 scale rotation blend-mode shader
337 texture-region)
338 (sprite-batch-add! (force %batch) texture region
339 scale rotation blend-mode shader
340 texture-region))
341
342 (define-syntax-rule (with-batched-sprites body ...)
343 "Use batched rendering for all draw-sprite calls within BODY."
344 (if *batch?*
345 (begin body ...)
346 (dynamic-wind
347 (lambda ()
348 (set! *batch?* #t))
349 (lambda ()
350 (sprite-batch-reset! (force %batch))
351 body ...
352 (sprite-batch-flush! (force %batch)))
353 (lambda ()
354 (set! *batch?* #f)))))
355
356 (define texture-gl-size
357 (@@ (chickadee render texture) texture-gl-size))
358 (define texture-region-gl-size
359 (@@ (chickadee render texture) texture-region-gl-size))
360 (define texture-region-gl-rect
361 (@@ (chickadee render texture) texture-region-gl-rect))
362
363 (define %default-texcoords (make-rect 0.0 0.0 1.0 1.0))
364
365 (define draw-sprite
366 (let ((rect (make-rect 0.0 0.0 0.0 0.0)))
367 (lambda* (texture region #:key
368 scale rotation (blend-mode 'alpha)
369 (texcoords
370 (if (texture-region? texture)
371 (texture-region-gl-rect texture)
372 %default-texcoords))
373 (shader (force default-shader)))
374 "Draw TEXTURE over the area defined by the rect REGION. Instead
375 of a rect, REGION may be a vec2 representing the position of the
376 sprite, in which case the width and height of the sprite corresponds
377 to the size of the texture. TEXTURE may be a texture or a texture
378 region. ROTATION specifies by how many radians the sprite will be
379 rotated. SCALE specifies the scaling factor. By default, alpha
380 blending is used but can be changed by setting BLEND-MODE. Finally,
381 advanced users may pass SHADER to change the way the sprite is
382 rendered entirely."
383 (let* ((size (if (texture-region? texture)
384 (texture-region-gl-size texture)
385 (texture-gl-size texture)))
386 (texture (if (texture-region? texture)
387 (texture-region-texture texture)
388 texture))
389 (region (if (rect? region)
390 region
391 (begin
392 (rect-move-vec2! rect region)
393 (set-rect-width! rect (f32vector-ref size 0))
394 (set-rect-height! rect (f32vector-ref size 1))
395 rect))))
396 (if *batch?*
397 (draw-sprite-batched texture region
398 scale rotation blend-mode shader
399 texcoords)
400 (draw-sprite-unbatched texture region
401 scale rotation blend-mode shader
402 texcoords))))))
403
404 \f
405 ;;;
406 ;;; Nine Patches
407 ;;;
408
409 (define draw-nine-patch
410 (let ((rect (make-rect 0.0 0.0 0.0 0.0))
411 (trect (make-rect 0.0 0.0 0.0 0.0)))
412 (lambda* (texture region #:key (margin 0)
413 (top-margin margin) (bottom-margin margin)
414 (left-margin margin) (right-margin margin)
415 scale rotation (blend-mode 'alpha)
416 (shader (force default-shader)))
417 "Draw a \"nine patch\" sprite. A nine patch sprite renders
418 TEXTURE as a WIDTH x HEIGHT rectangle whose stretchable areas are
419 defined by the given margin measurements. The corners are never
420 stretched, the left and right edges may be stretched vertically, the
421 top and bottom edges may be stretched horizontally, and the center may
422 be stretched in both directions. This rendering technique is
423 particularly well suited for resizable windows and buttons in
424 graphical user interfaces.
425
426 MARGIN specifies the margin size for all sides of the nine patch. To
427 make margins of differing sizes, the TOP-MARGIN, BOTTOM-MARGIN,
428 LEFT-MARGIN, and RIGHT-MARGIN arguments may be used."
429 (let* ((texcoords (if (texture-region? texture)
430 (texture-region-gl-rect texture)
431 %default-texcoords))
432 (texsize (if (texture-region? texture)
433 (texture-region-gl-size texture)
434 (texture-gl-size texture)))
435 (w (rect-width region))
436 (h (rect-height region))
437 (border-x1 (rect-left region))
438 (border-y1 (rect-bottom region))
439 (border-x2 (rect-right region))
440 (border-y2 (rect-top region))
441 (fill-x1 (+ border-x1 left-margin))
442 (fill-y1 (+ border-y1 bottom-margin))
443 (fill-x2 (- border-x2 right-margin))
444 (fill-y2 (- border-y2 top-margin))
445 (tw (f32vector-ref texsize 0))
446 (th (f32vector-ref texsize 1))
447 (border-s1 (rect-left texcoords))
448 (border-t1 (rect-bottom texcoords))
449 (border-s2 (rect-right texcoords))
450 (border-t2 (rect-top texcoords))
451 (fill-s1 (+ border-s1 (/ left-margin tw)))
452 (fill-t1 (+ border-t1 (/ bottom-margin th)))
453 (fill-s2 (- border-s2 (/ right-margin tw)))
454 (fill-t2 (- border-t2 (/ top-margin th))))
455 (define (draw-piece x1 y1 x2 y2 s1 t1 s2 t2)
456 (set-rect-x! rect x1)
457 (set-rect-y! rect y1)
458 (set-rect-width! rect (- x2 x1))
459 (set-rect-height! rect (- y2 y1))
460 (set-rect-x! trect s1)
461 (set-rect-y! trect t1)
462 (set-rect-width! trect (- s2 s1))
463 (set-rect-height! trect (- t2 t1))
464 (draw-sprite texture rect
465 #:texcoords trect
466 #:scale scale
467 #:rotation rotation
468 #:blend-mode blend-mode
469 #:shader shader))
470 (with-batched-sprites
471 ;; bottom-left
472 (draw-piece border-x1 border-y1 fill-x1 fill-y1
473 border-s1 border-t1 fill-s1 fill-t1)
474 ;; bottom-center
475 (draw-piece fill-x1 border-y1 fill-x2 fill-y1
476 fill-s1 border-t1 fill-s2 fill-t1)
477 ;; dbottom-right
478 (draw-piece fill-x2 border-y1 border-x2 fill-y1
479 fill-s2 border-t1 border-s2 fill-t1)
480 ;; center-left
481 (draw-piece border-x1 fill-y1 fill-x1 fill-y2
482 border-s1 fill-t1 fill-s1 fill-t2)
483 ;; center
484 (draw-piece fill-x1 fill-y1 fill-x2 fill-y2
485 fill-s1 fill-t1 fill-s2 fill-t2)
486 ;; center-right
487 (draw-piece fill-x2 fill-y1 border-x2 fill-y2
488 fill-s2 fill-t1 border-s2 fill-t2)
489 ;; top-left
490 (draw-piece border-x1 fill-y2 fill-x1 border-y2
491 border-s1 fill-t2 fill-s1 border-t2)
492 ;; top-center
493 (draw-piece fill-x1 fill-y2 fill-x2 border-y2
494 fill-s1 fill-t2 fill-s2 border-t2)
495 ;; top-right
496 (draw-piece fill-x2 fill-y2 border-x2 border-y2
497 fill-s2 fill-t2 border-s2 border-t2))))))