blob: 8b59cb3f7dce8cba0515c868e2437e7244286109 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
;;; Sly
;;; Copyright (C) 2016 David Thompson <dthompson2@worcester.edu>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Deferred sprite rendering for improved performance.
;;
;;; Code:
(define-module (sly render sprite-batch)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-4)
#:use-module (srfi srfi-9)
#:use-module (system foreign)
#:use-module (gl)
#:use-module (gl low-level)
#:use-module (sly agenda)
#:use-module (sly utils)
#:use-module (sly render)
#:use-module (sly render color)
#:use-module (sly render mesh)
#:use-module (sly render shader)
#:use-module (sly render texture)
#:use-module (sly render utils)
#:use-module (sly math vector)
#:use-module (sly math rect)
#:use-module (sly wrappers gl)
#:export (make-sprite-batch
sprite-batch?
sprite-batch-capacity
sprite-batch-size
sprite-batch-add!
sprite-batch-reset!
sprite-batch-flush!
with-sprite-batch))
;;;
;;; Sprite Batch
;;;
(define-record-type <sprite-batch>
(%make-sprite-batch texture size capacity index-buffer
position-buffer texture-buffer mesh)
sprite-batch?
(texture sprite-batch-texture set-sprite-batch-texture!)
(size sprite-batch-size set-sprite-batch-size!)
(capacity sprite-batch-capacity)
(index-buffer sprite-batch-index-buffer)
(position-buffer sprite-batch-position-buffer)
(texture-buffer sprite-batch-texture-buffer)
(mesh sprite-batch-mesh))
(define (make-sprite-batch capacity)
"Make a sprite batch that can hold CAPACITY sprites."
(let* ((index (make-streaming-vertex-buffer 'index (* capacity 6)))
(pos (make-streaming-vertex-buffer 'vec3 (* capacity 4)))
(tex (make-streaming-vertex-buffer 'vec2 (* capacity 4)))
(mesh (make-mesh index pos tex)))
(%make-sprite-batch #f 0 capacity index pos tex mesh)))
(define (same-texture? t1 t2)
(define (maybe-parent-texture t)
(if (texture-region? t)
(texture-parent t)
t))
(= (texture-id (maybe-parent-texture t1))
(texture-id (maybe-parent-texture t2))))
(define* (sprite-batch-add! batch context texture rect)
;; Draw batch if we are at capacity or the texture is changing.
(when (or (= (sprite-batch-capacity batch) (sprite-batch-size batch))
(and (sprite-batch-texture batch)
(not (same-texture? texture (sprite-batch-texture batch)))))
(sprite-batch-flush! batch context)
(sprite-batch-begin! batch))
;; Establish the texture to use if this is the first sprite in the
;; current batch.
(when (texture-null? (sprite-batch-texture batch))
(set-sprite-batch-texture! batch texture))
(let ((size (sprite-batch-size batch)))
(let ((index-offset (* size 6))
(index-vertex-offset (* size 4))
(vertex-offset (* size 12)) ; 4 vertices, 3 floats per vertex
(texture-offset (* size 8))
(index-buffer (vertex-buffer-data
(sprite-batch-index-buffer batch)))
(pos-buffer (vertex-buffer-data
(sprite-batch-position-buffer batch)))
(tex-buffer (vertex-buffer-data
(sprite-batch-texture-buffer batch)))
(s1 (texture-s1 texture))
(t1 (texture-t1 texture))
(s2 (texture-s2 texture))
(t2 (texture-t2 texture))
(top (rect-top rect))
(bottom (rect-bottom rect))
(left (rect-left rect))
(right (rect-right rect)))
;; Add indices.
(u32vector-set! index-buffer index-offset index-vertex-offset)
(u32vector-set! index-buffer (+ index-offset 1) (+ index-vertex-offset 3))
(u32vector-set! index-buffer (+ index-offset 2) (+ index-vertex-offset 2))
(u32vector-set! index-buffer (+ index-offset 3) index-vertex-offset)
(u32vector-set! index-buffer (+ index-offset 4) (+ index-vertex-offset 2))
(u32vector-set! index-buffer (+ index-offset 5) (+ index-vertex-offset 1))
;; Add vertices.
;; Bottom-left
(f32vector-set! pos-buffer vertex-offset left)
(f32vector-set! pos-buffer (+ vertex-offset 1) bottom)
(f32vector-set! pos-buffer (+ vertex-offset 2) 0.0)
;; Bottom-right
(f32vector-set! pos-buffer (+ vertex-offset 3) right)
(f32vector-set! pos-buffer (+ vertex-offset 4) bottom)
(f32vector-set! pos-buffer (+ vertex-offset 5) 0.0)
;; Top-right
(f32vector-set! pos-buffer (+ vertex-offset 6) right)
(f32vector-set! pos-buffer (+ vertex-offset 7) top)
(f32vector-set! pos-buffer (+ vertex-offset 8) 0.0)
;; Top-left
(f32vector-set! pos-buffer (+ vertex-offset 9) left)
(f32vector-set! pos-buffer (+ vertex-offset 10) top)
(f32vector-set! pos-buffer (+ vertex-offset 11) 0.0)
;; Add texture coordinates.
;; Bottom-left
(f32vector-set! tex-buffer texture-offset s1)
(f32vector-set! tex-buffer (+ texture-offset 1) t1)
;; Bottom-right
(f32vector-set! tex-buffer (+ texture-offset 2) s2)
(f32vector-set! tex-buffer (+ texture-offset 3) t1)
;; Top-right
(f32vector-set! tex-buffer (+ texture-offset 4) s2)
(f32vector-set! tex-buffer (+ texture-offset 5) t2)
;; Top-left
(f32vector-set! tex-buffer (+ texture-offset 6) s1)
(f32vector-set! tex-buffer (+ texture-offset 7) t2)
(set-sprite-batch-size! batch (1+ size)))))
(define (sprite-batch-reset! batch)
"Reset BATCH to size 0."
(set-sprite-batch-texture! batch null-texture)
(set-sprite-batch-size! batch 0))
(define (sprite-batch-begin! batch)
(map-vertex-buffer! (sprite-batch-index-buffer batch))
(map-vertex-buffer! (sprite-batch-position-buffer batch))
(map-vertex-buffer! (sprite-batch-texture-buffer batch)))
(define (sprite-batch-flush! batch context)
"Render the contents of BATCH and clear the cache."
(unless (zero? (sprite-batch-size batch))
(graphics-texture-excursion context
(lambda (context)
(set-graphics-texture! context (sprite-batch-texture batch))
(graphics-model-view-excursion context
(lambda (context)
(graphics-model-view-mul! context
(graphics-projection-transform context))
(graphics-uniform-excursion context
`((mvp ,(graphics-model-view-transform context))
(texture? ,(not (texture-null? (graphics-texture context)))))
(lambda (context)
(unmap-vertex-buffer! (sprite-batch-index-buffer batch))
(unmap-vertex-buffer! (sprite-batch-position-buffer batch))
(unmap-vertex-buffer! (sprite-batch-texture-buffer batch))
(set-graphics-mesh! context (sprite-batch-mesh batch))
(glDrawElements (begin-mode triangles)
;; 6 indices per sprite.
(* (sprite-batch-size batch) 6)
(data-type unsigned-int)
%null-pointer)
(sprite-batch-reset! batch)))))))))
(define-syntax-rule (with-sprite-batch batch context body ...)
;; IMPORTANT! We need to make sure that the current VAO is unbound
;; before we start mapping/unmapping vertex buffers. Not doing this
;; created a nasty bug that took me a long time to find.
(graphics-mesh-excursion context
(lambda (context)
(set-graphics-mesh! context null-mesh)
(sprite-batch-reset! batch)
(sprite-batch-begin! batch)
body ...
(sprite-batch-flush! batch context))))
|
