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