render: texture: Keep a rect for use with draw-sprite and friends.
[chickadee.git] / chickadee / render / sprite.scm
CommitLineData
98dc87a0
DT
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)
027671d6 19 #:use-module (rnrs bytevectors)
98dc87a0
DT
20 #:use-module (srfi srfi-4)
21 #:use-module (srfi srfi-9)
22 #:use-module (srfi srfi-11)
23 #:use-module (chickadee math matrix)
fade3fb9 24 #:use-module (chickadee math rect)
98dc87a0
DT
25 #:use-module (chickadee math vector)
26 #:use-module (chickadee render)
27 #:use-module (chickadee render shader)
28 #:use-module (chickadee render texture)
b1f41911 29 #:use-module (chickadee render buffer)
fedd9bca
DT
30 #:export (draw-sprite*
31 draw-sprite
aa5db237 32 with-batched-sprites
fedd9bca 33 draw-nine-patch*
aa5db237 34 draw-nine-patch))
98dc87a0
DT
35
36(define default-shader
37 (delay
38 (strings->shader
39 "
40#version 330
41
42in vec2 position;
43in vec2 tex;
44out vec2 frag_tex;
45uniform mat4 mvp;
46
47void main(void) {
48 frag_tex = tex;
49 gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
50}
51"
52 "
53#version 330
54
55in vec2 frag_tex;
56uniform sampler2D color_texture;
57
58void main (void) {
59 gl_FragColor = texture2D(color_texture, frag_tex);
60}
61")))
62
63(define draw-sprite-unbatched
b1f41911
DT
64 (let* ((position-buffer
65 (delay
66 (make-streaming-typed-buffer 'vec2 'float 4
67 #:name "unbatched-sprite-vertices")))
98dc87a0 68 (texcoord-buffer
b1f41911
DT
69 (delay
70 (make-streaming-typed-buffer 'vec2 'float 4
71 #:name "unbatched-sprite-texcoords")))
98dc87a0 72 (index-buffer
b1f41911
DT
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))))
98dc87a0 79 (vertex-array
b1f41911
DT
80 (delay
81 (make-vertex-array #:indices (force index-buffer)
82 #:attributes
83 `((0 . ,(force position-buffer))
84 (1 . ,(force texcoord-buffer))))))
cf1b09a1
DT
85 (mvp (make-null-matrix4)))
86 (lambda (texture region world-matrix blend-mode shader texture-region)
b1f41911 87 (with-mapped-typed-buffer (force position-buffer)
cf1b09a1
DT
88 (let* ((x1 (rect-x region))
89 (y1 (rect-y region))
90 (x2 (+ x1 (rect-width region)))
91 (y2 (+ y1 (rect-height region)))
b1f41911 92 (bv (typed-buffer-data (force position-buffer))))
98dc87a0
DT
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)))
b1f41911 101 (with-mapped-typed-buffer (force texcoord-buffer)
c36193e8
DT
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))
b1f41911 106 (bv (typed-buffer-data (force texcoord-buffer))))
98dc87a0
DT
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)))
98dc87a0 115 (with-blend-mode blend-mode
8152ddc9 116 (with-texture 0 texture
cf1b09a1
DT
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))))))))
98dc87a0
DT
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!)
027671d6
DT
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!))
98dc87a0 143
027671d6 144(define (init-sprite-batch batch capacity)
b1f41911
DT
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)))))
027671d6
DT
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))
98dc87a0
DT
166
167(define (sprite-batch-full? batch)
168 (= (sprite-batch-capacity batch) (sprite-batch-size batch)))
169
170(define (double-sprite-batch-size! batch)
4b216e91
DT
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)))
b1f41911
DT
177 (unmap-typed-buffer! old-index)
178 (unmap-typed-buffer! old-verts)
179 (unmap-typed-buffer! old-tex)
027671d6
DT
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)
4b216e91 186 (bytevector-copy! from 0
b1f41911 187 (typed-buffer-data to) 0
4b216e91
DT
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))))
98dc87a0
DT
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)
b1f41911
DT
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)))
98dc87a0
DT
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)
8152ddc9 209 (with-texture 0 (sprite-batch-texture batch)
b1f41911
DT
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))
98dc87a0
DT
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!
cf1b09a1 220 (let ((world1 (vec2 0.0 0.0))
78c685cf 221 (world2 (vec2 0.0 0.0))
cf1b09a1
DT
222 (world3 (vec2 0.0 0.0))
223 (world4 (vec2 0.0 0.0))
320f8ab4
DT
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))
cf1b09a1 229 (lambda (batch texture region world-matrix blend-mode
c36193e8 230 shader texture-region)
98dc87a0
DT
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)))
b1f41911
DT
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)))
cf1b09a1
DT
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)))
c36193e8
DT
251 (s1 (rect-left texture-region))
252 (t1 (rect-bottom texture-region))
253 (s2 (rect-right texture-region))
254 (t2 (rect-top texture-region)))
cf1b09a1
DT
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)))))))
98dc87a0
DT
307
308(define *batch?* #f)
309(define %batch (delay (make-sprite-batch 256)))
310
cf1b09a1 311(define (draw-sprite-batched texture region world-matrix blend-mode shader
c36193e8 312 texture-region)
cf1b09a1
DT
313 (sprite-batch-add! (force %batch) texture region world-matrix blend-mode
314 shader texture-region))
98dc87a0
DT
315
316(define-syntax-rule (with-batched-sprites body ...)
c36193e8 317 "Use batched rendering for all draw-sprite calls within BODY."
ffa8ea55
DT
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)))))
98dc87a0 329
fedd9bca
DT
330(define* (draw-sprite* texture rect matrix #:key
331 (blend-mode 'alpha)
5896bde4 332 (texcoords (texture-gl-tex-rect texture))
fedd9bca
DT
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)))
2950dfa6 339
fedd9bca
DT
340(define %null-vec2 (vec2 0.0 0.0))
341(define %default-scale (vec2 1.0 1.0))
aa5db237 342
fade3fb9 343(define draw-sprite
5896bde4 344 (let ((matrix (make-null-matrix4)))
cf1b09a1 345 (lambda* (texture
fedd9bca 346 position
cf1b09a1 347 #:key
fedd9bca
DT
348 (origin %null-vec2)
349 (scale %default-scale)
350 (rotation 0.0)
cf1b09a1 351 (blend-mode 'alpha)
5896bde4 352 (rect (texture-gl-rect texture))
cf1b09a1 353 (shader (force default-shader)))
fedd9bca 354 "Draw TEXTURE at POSITION.
cf1b09a1 355
fedd9bca 356Optionally, other transformations may be applied to the sprite.
cf1b09a1 357ROTATION specifies the angle to rotate the sprite, in radians. SCALE
fedd9bca
DT
358specifies the scaling factor as a 2D vector. All transformations are
359applied relative to ORIGIN, a 2D vector.
360
361By default, alpha blending is used but can be changed by specifying
362BLEND-MODE.
cf1b09a1 363
fedd9bca 364Advanced users may pass SHADER to change the way the sprite is
2950dfa6 365rendered entirely."
fedd9bca
DT
366 (matrix4-2d-transform! matrix
367 #:origin origin
368 #:position position
369 #:rotation rotation
370 #:scale scale)
df2872c4 371 (draw-sprite* texture rect matrix
fedd9bca
DT
372 #:blend-mode blend-mode
373 #:shader shader))))
aa5db237
DT
374
375\f
376;;;
377;;; Nine Patches
378;;;
379
fedd9bca
DT
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))
aa5db237
DT
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))
5896bde4
DT
406 (prect (texture-gl-rect texture))
407 (trect (texture-gl-tex-rect texture))
fedd9bca
DT
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))
aa5db237
DT
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)
fedd9bca
DT
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))
aa5db237
DT
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)
fedd9bca 438 ;; bottom-right
aa5db237
DT
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))))))
fedd9bca
DT
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
476TEXTURE on the rectangular area RECT whose stretchable areas are
477defined by the given margin measurements. The corners are never
478stretched, the left and right edges may be stretched vertically, the
479top and bottom edges may be stretched horizontally, and the center may
480be stretched in both directions. This rendering technique is
481particularly well suited for resizable windows and buttons in
482graphical user interfaces.
483
484MARGIN specifies the margin size for all sides of the nine patch. To
485make margins of differing sizes, the TOP-MARGIN, BOTTOM-MARGIN,
486LEFT-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))))