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