render: Change texture origin to top-left.
[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 ;; 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-x! world1 local-x1)
258 (set-vec2-y! world1 local-y1)
259 (set-vec2-x! world2 local-x2)
260 (set-vec2-y! world2 local-y1)
261 (set-vec2-x! world3 local-x2)
262 (set-vec2-y! world3 local-y2)
263 (set-vec2-x! world4 local-x1)
264 (set-vec2-y! world4 local-y2)
265 (when world-matrix
266 (transform! world-matrix world1)
267 (transform! world-matrix world2)
268 (transform! world-matrix world3)
269 (transform! world-matrix world4))
270 ;; Add indices.
271 (set-offset (* size 4))
272 (let ((index-vertex-offset (offset)))
273 (set-offset (* size 6))
274 (u32vector-set! indices (offset) index-vertex-offset)
275 (u32vector-set! indices (+ (offset) 1) (+ index-vertex-offset 3))
276 (u32vector-set! indices (+ (offset) 2) (+ index-vertex-offset 2))
277 (u32vector-set! indices (+ (offset) 3) index-vertex-offset)
278 (u32vector-set! indices (+ (offset) 4) (+ index-vertex-offset 2))
279 (u32vector-set! indices (+ (offset) 5) (+ index-vertex-offset 1)))
280 ;; Add vertices.
281 (set-offset (* size 8)) ;; 4 vertices, 2 floats per vertex
282 ;; Bottom-left
283 (f32vector-set! vertices (offset) (vec2-x world1))
284 (f32vector-set! vertices (+ (offset) 1) (vec2-y world1))
285 ;; Bottom-right
286 (f32vector-set! vertices (+ (offset) 2) (vec2-x world2))
287 (f32vector-set! vertices (+ (offset) 3) (vec2-y world2))
288 ;; Top-right
289 (f32vector-set! vertices (+ (offset) 4) (vec2-x world3))
290 (f32vector-set! vertices (+ (offset) 5) (vec2-y world3))
291 ;; Top-left
292 (f32vector-set! vertices (+ (offset) 6) (vec2-x world4))
293 (f32vector-set! vertices (+ (offset) 7) (vec2-y world4))
294 ;; Add texture coordinates.
295 (set-offset (* size 8))
296 ;; Bottom-left
297 (f32vector-set! texcoords (offset) s1)
298 (f32vector-set! texcoords (+ (offset) 1) t2)
299 ;; Bottom-right
300 (f32vector-set! texcoords (+ (offset) 2) s2)
301 (f32vector-set! texcoords (+ (offset) 3) t2)
302 ;; Top-right
303 (f32vector-set! texcoords (+ (offset) 4) s2)
304 (f32vector-set! texcoords (+ (offset) 5) t1)
305 ;; Top-left
306 (f32vector-set! texcoords (+ (offset) 6) s1)
307 (f32vector-set! texcoords (+ (offset) 7) t1)
308 (set-sprite-batch-size! batch (1+ size)))))))
309
310 (define *batch?* #f)
311 (define %batch (delay (make-sprite-batch 256)))
312
313 (define (draw-sprite-batched texture region world-matrix blend-mode shader
314 texture-region)
315 (sprite-batch-add! (force %batch) texture region world-matrix blend-mode
316 shader texture-region))
317
318 (define-syntax-rule (with-batched-sprites body ...)
319 "Use batched rendering for all draw-sprite calls within BODY."
320 (if *batch?*
321 (begin body ...)
322 (dynamic-wind
323 (lambda ()
324 (set! *batch?* #t))
325 (lambda ()
326 (sprite-batch-reset! (force %batch))
327 body ...
328 (sprite-batch-flush! (force %batch)))
329 (lambda ()
330 (set! *batch?* #f)))))
331
332 (define* (draw-sprite* texture rect matrix #:key
333 (blend-mode 'alpha)
334 (texcoords (texture-gl-tex-rect texture))
335 (shader (force default-shader)))
336 (if *batch?*
337 (draw-sprite-batched texture rect matrix blend-mode
338 shader texcoords)
339 (draw-sprite-unbatched texture rect matrix blend-mode
340 shader texcoords)))
341
342 (define %null-vec2 (vec2 0.0 0.0))
343 (define %default-scale (vec2 1.0 1.0))
344
345 (define draw-sprite
346 (let ((matrix (make-null-matrix4)))
347 (lambda* (texture
348 position
349 #:key
350 (origin %null-vec2)
351 (scale %default-scale)
352 (rotation 0.0)
353 (blend-mode 'alpha)
354 (rect (texture-gl-rect texture))
355 (shader (force default-shader)))
356 "Draw TEXTURE at POSITION.
357
358 Optionally, other transformations may be applied to the sprite.
359 ROTATION specifies the angle to rotate the sprite, in radians. SCALE
360 specifies the scaling factor as a 2D vector. All transformations are
361 applied relative to ORIGIN, a 2D vector.
362
363 By default, alpha blending is used but can be changed by specifying
364 BLEND-MODE.
365
366 Advanced users may pass SHADER to change the way the sprite is
367 rendered entirely."
368 (matrix4-2d-transform! matrix
369 #:origin origin
370 #:position position
371 #:rotation rotation
372 #:scale scale)
373 (draw-sprite* texture rect matrix
374 #:blend-mode blend-mode
375 #:shader shader))))
376
377 \f
378 ;;;
379 ;;; Nine Patches
380 ;;;
381
382 (define draw-nine-patch*
383 (let ((%rect (make-rect 0.0 0.0 0.0 0.0))
384 (texcoords (make-rect 0.0 0.0 0.0 0.0)))
385 (lambda* (texture
386 rect
387 matrix
388 #:key
389 (margin 0.0)
390 (top-margin margin)
391 (bottom-margin margin)
392 (left-margin margin)
393 (right-margin margin)
394 (blend-mode 'alpha)
395 (shader (force default-shader)))
396 (let* ((x (rect-x rect))
397 (y (rect-y rect))
398 (w (rect-width rect))
399 (h (rect-height rect))
400 (border-x1 x)
401 (border-y1 y)
402 (border-x2 (+ x w))
403 (border-y2 (+ y h))
404 (fill-x1 (+ border-x1 left-margin))
405 (fill-y1 (+ border-y1 bottom-margin))
406 (fill-x2 (- border-x2 right-margin))
407 (fill-y2 (- border-y2 top-margin))
408 (prect (texture-gl-rect texture))
409 (trect (texture-gl-tex-rect texture))
410 (tw (rect-width prect))
411 (th (rect-height prect))
412 (border-s1 (rect-x trect))
413 (border-t1 (rect-y trect))
414 (border-s2 (+ (rect-x trect) (rect-width trect)))
415 (border-t2 (+ (rect-y trect) (rect-height trect)))
416 (fill-s1 (+ border-s1 (/ left-margin tw)))
417 (fill-t1 (+ border-t1 (/ top-margin th)))
418 (fill-s2 (- border-s2 (/ right-margin tw)))
419 (fill-t2 (- border-t2 (/ bottom-margin th))))
420 (define (draw-piece x1 y1 x2 y2 s1 t1 s2 t2)
421 (set-rect-x! %rect x1)
422 (set-rect-y! %rect y1)
423 (set-rect-width! %rect (- x2 x1))
424 (set-rect-height! %rect (- y2 y1))
425 (set-rect-x! texcoords s1)
426 (set-rect-y! texcoords t1)
427 (set-rect-width! texcoords (- s2 s1))
428 (set-rect-height! texcoords (- t2 t1))
429 (draw-sprite* texture %rect matrix
430 #:texcoords texcoords
431 #:blend-mode blend-mode
432 #:shader shader))
433 (with-batched-sprites
434 ;; bottom-left
435 (draw-piece border-x1 border-y1 fill-x1 fill-y1
436 border-s1 fill-t2 fill-s1 border-t2)
437 ;; bottom-center
438 (draw-piece fill-x1 border-y1 fill-x2 fill-y1
439 fill-s1 fill-t2 fill-s2 border-t2)
440 ;; bottom-right
441 (draw-piece fill-x2 border-y1 border-x2 fill-y1
442 fill-s2 fill-t2 border-s2 border-t2)
443 ;; center-left
444 (draw-piece border-x1 fill-y1 fill-x1 fill-y2
445 border-s1 fill-t2 fill-s1 fill-t1)
446 ;; center
447 (draw-piece fill-x1 fill-y1 fill-x2 fill-y2
448 fill-s1 fill-t2 fill-s2 fill-t1)
449 ;; center-right
450 (draw-piece fill-x2 fill-y1 border-x2 fill-y2
451 fill-s2 fill-t2 border-s2 fill-t1)
452 ;; top-left
453 (draw-piece border-x1 fill-y2 fill-x1 border-y2
454 border-s1 border-t1 fill-s1 fill-t1)
455 ;; top-center
456 (draw-piece fill-x1 fill-y2 fill-x2 border-y2
457 fill-s1 border-t1 fill-s2 fill-t1)
458 ;; top-right
459 (draw-piece fill-x2 fill-y2 border-x2 border-y2
460 fill-s2 border-t1 border-s2 fill-t1))))))
461
462 (define draw-nine-patch
463 (let ((position (vec2 0.0 0.0))
464 (%rect (make-rect 0.0 0.0 0.0 0.0))
465 (matrix (make-null-matrix4)))
466 (lambda* (texture
467 rect
468 #:key
469 (margin 0.0)
470 (top-margin margin) (bottom-margin margin)
471 (left-margin margin) (right-margin margin)
472 (origin %null-vec2)
473 (rotation 0.0)
474 (scale %default-scale)
475 (blend-mode 'alpha)
476 (shader (force default-shader)))
477 "Draw a \"nine patch\" sprite. A nine patch sprite renders
478 TEXTURE on the rectangular area RECT whose stretchable areas are
479 defined by the given margin measurements. The corners are never
480 stretched, the left and right edges may be stretched vertically, the
481 top and bottom edges may be stretched horizontally, and the center may
482 be stretched in both directions. This rendering technique is
483 particularly well suited for resizable windows and buttons in
484 graphical user interfaces.
485
486 MARGIN specifies the margin size for all sides of the nine patch. To
487 make margins of differing sizes, the TOP-MARGIN, BOTTOM-MARGIN,
488 LEFT-MARGIN, and RIGHT-MARGIN arguments may be used."
489 (set-rect-x! %rect 0.0)
490 (set-rect-y! %rect 0.0)
491 (set-rect-width! %rect (rect-width rect))
492 (set-rect-height! %rect (rect-height rect))
493 (set-vec2-x! position (rect-x rect))
494 (set-vec2-y! position (rect-y rect))
495 (matrix4-2d-transform! matrix
496 #:origin origin
497 #:position position
498 #:rotation rotation
499 #:scale scale)
500 (draw-nine-patch* texture %rect matrix
501 #:top-margin top-margin
502 #:bottom-margin bottom-margin
503 #:left-margin left-margin
504 #:right-margin right-margin
505 #:blend-mode blend-mode
506 #:shader shader))))