78a2ce553845bb326658b39cba7e536fc655717d
[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 330
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 330
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-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 (%rect (make-rect 0.0 0.0 0.0 0.0)))
346 (lambda* (texture
347 position
348 #:key
349 (origin %null-vec2)
350 (scale %default-scale)
351 (rotation 0.0)
352 (blend-mode 'alpha)
353 ;; Default to an area that is the same size of the
354 ;; texture. 99% of the time that's what you want.
355 (rect (let ((r (texture-rect texture)))
356 (set-rect-width! %rect (rect-width r))
357 (set-rect-height! %rect (rect-height r))
358 %rect))
359 (shader (force default-shader)))
360 "Draw TEXTURE at POSITION.
361
362 Optionally, other transformations may be applied to the sprite.
363 ROTATION specifies the angle to rotate the sprite, in radians. SCALE
364 specifies the scaling factor as a 2D vector. All transformations are
365 applied relative to ORIGIN, a 2D vector.
366
367 By default, alpha blending is used but can be changed by specifying
368 BLEND-MODE.
369
370 Advanced users may pass SHADER to change the way the sprite is
371 rendered entirely."
372 (matrix4-2d-transform! matrix
373 #:origin origin
374 #:position position
375 #:rotation rotation
376 #:scale scale)
377 (draw-sprite* texture rect matrix
378 #:blend-mode blend-mode
379 #:shader shader))))
380
381 \f
382 ;;;
383 ;;; Nine Patches
384 ;;;
385
386 (define draw-nine-patch*
387 (let ((%rect (make-rect 0.0 0.0 0.0 0.0))
388 (texcoords (make-rect 0.0 0.0 0.0 0.0)))
389 (lambda* (texture
390 rect
391 matrix
392 #:key
393 (margin 0.0)
394 (top-margin margin)
395 (bottom-margin margin)
396 (left-margin margin)
397 (right-margin margin)
398 (blend-mode 'alpha)
399 (shader (force default-shader)))
400 (let* ((x (rect-x rect))
401 (y (rect-y rect))
402 (w (rect-width rect))
403 (h (rect-height rect))
404 (border-x1 x)
405 (border-y1 y)
406 (border-x2 (+ x w))
407 (border-y2 (+ y h))
408 (fill-x1 (+ border-x1 left-margin))
409 (fill-y1 (+ border-y1 bottom-margin))
410 (fill-x2 (- border-x2 right-margin))
411 (fill-y2 (- border-y2 top-margin))
412 (prect (texture-rect texture))
413 (trect (texture-gl-rect texture))
414 (tw (rect-width prect))
415 (th (rect-height prect))
416 (border-s1 (rect-left trect))
417 (border-t1 (rect-bottom trect))
418 (border-s2 (rect-right trect))
419 (border-t2 (rect-top trect))
420 (fill-s1 (+ border-s1 (/ left-margin tw)))
421 (fill-t1 (+ border-t1 (/ bottom-margin th)))
422 (fill-s2 (- border-s2 (/ right-margin tw)))
423 (fill-t2 (- border-t2 (/ top-margin th))))
424 (define (draw-piece x1 y1 x2 y2 s1 t1 s2 t2)
425 (set-rect-x! %rect x1)
426 (set-rect-y! %rect y1)
427 (set-rect-width! %rect (- x2 x1))
428 (set-rect-height! %rect (- y2 y1))
429 (set-rect-x! texcoords s1)
430 (set-rect-y! texcoords t1)
431 (set-rect-width! texcoords (- s2 s1))
432 (set-rect-height! texcoords (- t2 t1))
433 (draw-sprite* texture %rect matrix
434 #:texcoords texcoords
435 #:blend-mode blend-mode
436 #:shader shader))
437 (with-batched-sprites
438 ;; bottom-left
439 (draw-piece border-x1 border-y1 fill-x1 fill-y1
440 border-s1 border-t1 fill-s1 fill-t1)
441 ;; bottom-center
442 (draw-piece fill-x1 border-y1 fill-x2 fill-y1
443 fill-s1 border-t1 fill-s2 fill-t1)
444 ;; bottom-right
445 (draw-piece fill-x2 border-y1 border-x2 fill-y1
446 fill-s2 border-t1 border-s2 fill-t1)
447 ;; center-left
448 (draw-piece border-x1 fill-y1 fill-x1 fill-y2
449 border-s1 fill-t1 fill-s1 fill-t2)
450 ;; center
451 (draw-piece fill-x1 fill-y1 fill-x2 fill-y2
452 fill-s1 fill-t1 fill-s2 fill-t2)
453 ;; center-right
454 (draw-piece fill-x2 fill-y1 border-x2 fill-y2
455 fill-s2 fill-t1 border-s2 fill-t2)
456 ;; top-left
457 (draw-piece border-x1 fill-y2 fill-x1 border-y2
458 border-s1 fill-t2 fill-s1 border-t2)
459 ;; top-center
460 (draw-piece fill-x1 fill-y2 fill-x2 border-y2
461 fill-s1 fill-t2 fill-s2 border-t2)
462 ;; top-right
463 (draw-piece fill-x2 fill-y2 border-x2 border-y2
464 fill-s2 fill-t2 border-s2 border-t2))))))
465
466 (define draw-nine-patch
467 (let ((position (vec2 0.0 0.0))
468 (%rect (make-rect 0.0 0.0 0.0 0.0))
469 (matrix (make-null-matrix4)))
470 (lambda* (texture
471 rect
472 #:key
473 (margin 0.0)
474 (top-margin margin) (bottom-margin margin)
475 (left-margin margin) (right-margin margin)
476 (origin %null-vec2)
477 (rotation 0.0)
478 (scale %default-scale)
479 (blend-mode 'alpha)
480 (shader (force default-shader)))
481 "Draw a \"nine patch\" sprite. A nine patch sprite renders
482 TEXTURE on the rectangular area RECT whose stretchable areas are
483 defined by the given margin measurements. The corners are never
484 stretched, the left and right edges may be stretched vertically, the
485 top and bottom edges may be stretched horizontally, and the center may
486 be stretched in both directions. This rendering technique is
487 particularly well suited for resizable windows and buttons in
488 graphical user interfaces.
489
490 MARGIN specifies the margin size for all sides of the nine patch. To
491 make margins of differing sizes, the TOP-MARGIN, BOTTOM-MARGIN,
492 LEFT-MARGIN, and RIGHT-MARGIN arguments may be used."
493 (set-rect-x! %rect 0.0)
494 (set-rect-y! %rect 0.0)
495 (set-rect-width! %rect (rect-width rect))
496 (set-rect-height! %rect (rect-height rect))
497 (set-vec2-x! position (rect-x rect))
498 (set-vec2-y! position (rect-y rect))
499 (matrix4-2d-transform! matrix
500 #:origin origin
501 #:position position
502 #:rotation rotation
503 #:scale scale)
504 (draw-nine-patch* texture %rect matrix
505 #:top-margin top-margin
506 #:bottom-margin bottom-margin
507 #:left-margin left-margin
508 #:right-margin right-margin
509 #:blend-mode blend-mode
510 #:shader shader))))