5c4ecb465929da39134d679c305018a09b52e3db
[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 %default-texture-region (make-rect 0.0 0.0 1.0 1.0))
357
358 (define draw-sprite
359 (let ((rect (make-rect 0.0 0.0 0.0 0.0)))
360 (lambda* (texture region #:key
361 scale rotation (blend-mode 'alpha)
362 texture-region
363 (shader (force default-shader)))
364 "Draw TEXTURE over the area defined by the rect REGION. If
365 TEXTURE-REGION is specified, the subset of the texture defined by it
366 will be drawn rather than the entire texture. ROTATION specifies by
367 how many radians the sprite will be rotated. SCALE specifies the
368 scaling factor. By default, alpha blending is used but can be changed
369 by setting BLEND-MODE. Finally, advanced users may pass SHADER to
370 change the way the sprite is rendered entirely."
371 (let ((region (if (vec2? region)
372 (begin
373 (rect-move-vec2! rect region)
374 (set-rect-width! rect (texture-width texture))
375 (set-rect-height! rect (texture-height texture))
376 rect)
377 region))
378 (texture-region (or texture-region %default-texture-region)))
379 (if *batch?*
380 (draw-sprite-batched texture region
381 scale rotation blend-mode shader
382 texture-region)
383 (draw-sprite-unbatched texture region
384 scale rotation blend-mode shader
385 texture-region))))))
386
387 \f
388 ;;;
389 ;;; Nine Patches
390 ;;;
391
392 (define draw-nine-patch
393 (let ((rect (make-rect 0.0 0.0 0.0 0.0))
394 (trect (make-rect 0.0 0.0 0.0 0.0)))
395 (lambda* (texture region #:key (margin 0)
396 (top-margin margin) (bottom-margin margin)
397 (left-margin margin) (right-margin margin)
398 (texture-region %default-texture-region)
399 scale rotation (blend-mode 'alpha)
400 (shader (force default-shader)))
401 "Draw a \"nine patch\" sprite. A nine patch sprite renders
402 TEXTURE as a WIDTH x HEIGHT rectangle whose stretchable areas are
403 defined by the given margin measurements. The corners are never
404 stretched, the left and right edges may be stretched vertically, the
405 top and bottom edges may be stretched horizontally, and the center may
406 be stretched in both directions. This rendering technique is
407 particularly well suited for resizable windows and buttons in
408 graphical user interfaces.
409
410 MARGIN specifies the margin size for all sides of the nine patch. To
411 make margins of differing sizes, the TOP-MARGIN, BOTTOM-MARGIN,
412 LEFT-MARGIN, and RIGHT-MARGIN arguments may be used."
413 (let* ((w (rect-width region))
414 (h (rect-height region))
415 (border-x1 (rect-left region))
416 (border-y1 (rect-bottom region))
417 (border-x2 (rect-right region))
418 (border-y2 (rect-top region))
419 (fill-x1 (+ border-x1 left-margin))
420 (fill-y1 (+ border-y1 bottom-margin))
421 (fill-x2 (- border-x2 right-margin))
422 (fill-y2 (- border-y2 top-margin))
423 (tw (texture-width texture))
424 (th (texture-width texture))
425 (border-s1 (rect-left texture-region))
426 (border-t1 (rect-bottom texture-region))
427 (border-s2 (rect-right texture-region))
428 (border-t2 (rect-top texture-region))
429 (fill-s1 (+ border-s1 (/ left-margin tw)))
430 (fill-t1 (+ border-t1 (/ bottom-margin th)))
431 (fill-s2 (- border-s2 (/ right-margin tw)))
432 (fill-t2 (- border-t2 (/ top-margin th))))
433 (define (draw-piece x1 y1 x2 y2 s1 t1 s2 t2)
434 (set-rect-x! rect x1)
435 (set-rect-y! rect y1)
436 (set-rect-width! rect (- x2 x1))
437 (set-rect-height! rect (- y2 y1))
438 (set-rect-x! trect s1)
439 (set-rect-y! trect t1)
440 (set-rect-width! trect (- s2 s1))
441 (set-rect-height! trect (- t2 t1))
442 (draw-sprite texture rect
443 #:texture-region trect
444 #:scale scale
445 #:rotation rotation
446 #:blend-mode blend-mode
447 #:shader shader))
448 (with-batched-sprites
449 ;; bottom-left
450 (draw-piece border-x1 border-y1 fill-x1 fill-y1
451 border-s1 border-t1 fill-s1 fill-t1)
452 ;; bottom-center
453 (draw-piece fill-x1 border-y1 fill-x2 fill-y1
454 fill-s1 border-t1 fill-s2 fill-t1)
455 ;; dbottom-right
456 (draw-piece fill-x2 border-y1 border-x2 fill-y1
457 fill-s2 border-t1 border-s2 fill-t1)
458 ;; center-left
459 (draw-piece border-x1 fill-y1 fill-x1 fill-y2
460 border-s1 fill-t1 fill-s1 fill-t2)
461 ;; center
462 (draw-piece fill-x1 fill-y1 fill-x2 fill-y2
463 fill-s1 fill-t1 fill-s2 fill-t2)
464 ;; center-right
465 (draw-piece fill-x2 fill-y1 border-x2 fill-y2
466 fill-s2 fill-t1 border-s2 fill-t2)
467 ;; top-left
468 (draw-piece border-x1 fill-y2 fill-x1 border-y2
469 border-s1 fill-t2 fill-s1 border-t2)
470 ;; top-center
471 (draw-piece fill-x1 fill-y2 fill-x2 border-y2
472 fill-s1 fill-t2 fill-s2 border-t2)
473 ;; top-right
474 (draw-piece fill-x2 fill-y2 border-x2 border-y2
475 fill-s2 fill-t2 border-s2 border-t2))))))