render: Rename "typed buffer" to "buffer view".
[chickadee.git] / chickadee / render / shapes.scm
1 ;;; Chickadee Game Toolkit
2 ;;; Copyright © 2016, 2018 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 ;;; Commentary
19 ;;
20 ;; Polylines as described in
21 ;; http://jcgt.org/published/0002/02/08/paper.pdf
22 ;;
23 ;;; Code:
24
25 (define-module (chickadee render shapes)
26 #:use-module (ice-9 match)
27 #:use-module (srfi srfi-4)
28 #:use-module (chickadee math bezier)
29 #:use-module (chickadee math matrix)
30 #:use-module (chickadee math rect)
31 #:use-module (chickadee math vector)
32 #:use-module (chickadee render)
33 #:use-module (chickadee render color)
34 #:use-module (chickadee render shader)
35 #:use-module (chickadee render buffer)
36 #:export (draw-filled-rect
37 draw-line
38 draw-bezier-curve
39 draw-bezier-path))
40
41 ;; TODO: Make a generic polygon renderer, include batching, etc.
42 (define draw-filled-rect
43 (let* ((vertex-buffer
44 (delay
45 (make-streaming-buffer-view 'vec2 'float 4
46 #:name "rect-buffer-view")))
47 (index-buffer
48 (delay
49 (make-buffer-view #:type 'scalar
50 #:component-type 'unsigned-int
51 #:buffer (make-buffer (u32vector 0 3 2 0 2 1)
52 #:target 'index))))
53 (vertex-array
54 (delay
55 (make-vertex-array #:indices (force index-buffer)
56 #:attributes `((0 . ,(force vertex-buffer))))))
57 (default-shader
58 (delay
59 (strings->shader
60 "
61 #version 130
62
63 in vec2 position;
64 uniform mat4 mvp;
65
66 void main(void) {
67 gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
68 }
69 "
70 "
71 #version 130
72
73 in vec2 frag_tex;
74 uniform vec4 color;
75
76 void main (void) {
77 gl_FragColor = color;
78 }
79 ")))
80 (mvp (make-null-matrix4)))
81 (lambda* (region
82 color
83 #:key
84 (blend-mode 'alpha)
85 (shader (force default-shader))
86 matrix)
87 (let* ((x1 (rect-x region))
88 (y1 (rect-y region))
89 (x2 (+ x1 (rect-width region)))
90 (y2 (+ y1 (rect-height region))))
91 (with-mapped-buffer-view (force vertex-buffer)
92 (let ((bv (buffer-view-data (force vertex-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-blend-mode blend-mode
102 (gpu-apply shader (force vertex-array)
103 #:mvp (if matrix
104 (begin
105 (matrix4-mult! mvp matrix
106 (current-projection))
107 mvp)
108 (current-projection))
109 #:color color))))))
110
111 (define draw-line
112 (let* ((mvp (make-null-matrix4))
113 (vertex-buffer
114 (delay
115 (make-streaming-buffer-view 'vec2 'float 4
116 #:name "line-buffer-view")))
117 (texcoord-buffer
118 (delay
119 (make-streaming-buffer-view 'vec2 'float 4
120 #:name "line-buffer-view")))
121 (index-buffer
122 (delay
123 (make-buffer-view #:type 'scalar
124 #:component-type 'unsigned-int
125 #:buffer (make-buffer (u32vector 0 3 2 0 2 1)
126 #:target 'index))))
127 (vertex-array
128 (delay
129 (make-vertex-array #:indices (force index-buffer)
130 #:attributes `((0 . ,(force vertex-buffer))
131 (1 . ,(force texcoord-buffer))))))
132 (default-shader
133 (delay
134 (strings->shader
135 "
136 #version 130
137
138 in vec2 position;
139 in vec2 tex;
140 out vec2 frag_tex;
141 uniform mat4 mvp;
142
143 void main(void) {
144 frag_tex = tex;
145 gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
146 }
147 "
148 "
149 #version 130
150
151 in vec2 frag_tex;
152 uniform vec4 color;
153 uniform float r;
154 uniform float w;
155 uniform float t;
156 uniform float l;
157 uniform int cap;
158 float infinity = 1.0 / 0.0;
159
160 void main (void) {
161 float hw = w / 2.0;
162 float u = frag_tex.x;
163 float v = frag_tex.y;
164 float dx;
165 float dy;
166 float d;
167
168 if (u < 0 || u > l) {
169 if (u < 0) {
170 dx = abs(u);
171 } else {
172 dx = u - l;
173 }
174 dy = abs(v);
175
176 switch (cap) {
177 // none
178 case 0:
179 d = infinity;
180 break;
181 // butt
182 case 1:
183 d = max(dx + w / 2 - 2 * r, dy);
184 break;
185 // square
186 case 2:
187 d = max(dx, dy);
188 break;
189 // round
190 case 3:
191 d = sqrt(dx * dx + dy * dy);
192 break;
193 // triangle out
194 case 4:
195 d = dx + dy;
196 break;
197 // triangle in
198 case 5:
199 d = max(dy, w / 2 - r + dx - dy);
200 break;
201 }
202 } else {
203 d = abs(v);
204 }
205
206 if (d <= hw) {
207 gl_FragColor = color;
208 } else {
209 gl_FragColor = vec4(color.rgb, color.a * (1.0 - ((d - hw) / r)));
210 }
211 }
212 "))))
213 (lambda* (start end #:key
214 (thickness 0.5)
215 (feather 1.0)
216 (cap 'round)
217 (color white)
218 (shader (force default-shader))
219 matrix)
220 "Draw a line segment from START to END. The line will be
221 THICKNESS pixels thick with an antialiased border FEATHER pixels wide.
222 The line will be colored COLOR. CAP specifies the type of end cap that
223 should be used to terminate the lines, either 'none', 'butt',
224 'square', 'round', 'triangle-in', or 'triangle-out'. Advanced users
225 may use SHADER to override the built-in line segment shader."
226 (let* ((x1 (vec2-x start))
227 (y1 (vec2-y start))
228 (x2 (vec2-x end))
229 (y2 (vec2-y end))
230 (dx (- x2 x1))
231 (dy (- y2 y1))
232 (length (sqrt (+ (expt dx 2) (expt dy 2))))
233 (padding (/ (ceiling (+ thickness (* feather 2.5))) 2.0))
234 (nx (/ dx length))
235 (ny (/ dy length))
236 (xpad (* nx padding))
237 (ypad (* ny padding))
238 ;; start left
239 (vx1 (+ (- x1 xpad) ypad))
240 (vy1 (+ (- y1 ypad) (- xpad)))
241 (s1 (- padding))
242 (t1 padding)
243 ;; start right
244 (vx2 (+ (- x1 xpad) (- ypad)))
245 (vy2 (+ (- y1 ypad) xpad))
246 (s2 (- padding))
247 (t2 (- padding))
248 ;; end left
249 (vx3 (+ x2 xpad (- ypad)))
250 (vy3 (+ y2 ypad xpad))
251 (s3 (+ length padding))
252 (t3 (- padding))
253 ;; end right
254 (vx4 (+ (+ x2 xpad) ypad))
255 (vy4 (+ (+ y2 ypad) (- xpad)))
256 (s4 (+ length padding))
257 (t4 padding))
258 (with-mapped-buffer-view (force vertex-buffer)
259 (let ((bv (buffer-view-data (force vertex-buffer))))
260 (f32vector-set! bv 0 vx1)
261 (f32vector-set! bv 1 vy1)
262 (f32vector-set! bv 2 vx2)
263 (f32vector-set! bv 3 vy2)
264 (f32vector-set! bv 4 vx3)
265 (f32vector-set! bv 5 vy3)
266 (f32vector-set! bv 6 vx4)
267 (f32vector-set! bv 7 vy4)))
268 (with-mapped-buffer-view (force texcoord-buffer)
269 (let ((bv (buffer-view-data (force texcoord-buffer))))
270 (f32vector-set! bv 0 s1)
271 (f32vector-set! bv 1 t1)
272 (f32vector-set! bv 2 s2)
273 (f32vector-set! bv 3 t2)
274 (f32vector-set! bv 4 s3)
275 (f32vector-set! bv 5 t3)
276 (f32vector-set! bv 6 s4)
277 (f32vector-set! bv 7 t4)))
278 (with-blend-mode 'alpha
279 (gpu-apply shader (force vertex-array)
280 #:mvp (if matrix
281 (begin
282 (matrix4-mult! mvp matrix
283 (current-projection))
284 mvp)
285 (current-projection))
286 #:color color
287 #:w thickness
288 #:r feather
289 #:l length
290 #:cap (match cap
291 ('none 0)
292 ('butt 1)
293 ('square 2)
294 ('round 3)
295 ('triangle-out 4)
296 ('triangle-in 5))))))))
297
298 ;; XXX: This is going to be hopelessly slow until I implement batching
299 ;; for lines and shapes.
300 (define draw-bezier-curve
301 (let ((start #v(0.0 0.0))
302 (end #v(0.0 0.0))
303 (tmp #f)
304 (rect (make-rect 0.0 0.0 0.0 0.0)))
305 (lambda* (bezier #:key
306 (segments 32)
307 control-points?
308 tangents?
309 (control-point-size 8.0)
310 (color white)
311 (control-point-color yellow)
312 (tangent-color yellow)
313 (thickness 0.5)
314 (feather 1.0)
315 matrix)
316 "Draw the curve defined by BEZIER using a resolution of n SEGMENTS."
317 (define (draw-segment start end color)
318 (draw-line start end
319 #:thickness thickness
320 #:feather feather
321 #:cap 'none
322 #:color color))
323 (define (draw-control-point p)
324 (let ((hs (/ control-point-size 2.0)))
325 (set-rect-x! rect (- (vec2-x p) hs))
326 (set-rect-y! rect (- (vec2-y p) hs))
327 (set-rect-width! rect control-point-size)
328 (set-rect-height! rect control-point-size)
329 (draw-filled-rect rect control-point-color #:matrix matrix)))
330 (bezier-curve-point-at! start bezier 0.0)
331 (let loop ((i 1))
332 (when (<= i segments)
333 (bezier-curve-point-at! end bezier (exact->inexact (/ i segments)))
334 (draw-segment start end color)
335 ;; Make the previous end point is now the new start point
336 ;; for the next iteration.
337 (set! tmp start)
338 (set! start end)
339 (set! end tmp)
340 (loop (+ i 1))))
341 (when tangents?
342 (draw-segment (bezier-curve-p0 bezier)
343 (bezier-curve-p1 bezier)
344 tangent-color)
345 (draw-segment (bezier-curve-p3 bezier)
346 (bezier-curve-p2 bezier)
347 tangent-color))
348 (when control-points?
349 (draw-control-point (bezier-curve-p0 bezier))
350 (draw-control-point (bezier-curve-p1 bezier))
351 (draw-control-point (bezier-curve-p2 bezier))
352 (draw-control-point (bezier-curve-p3 bezier))))))
353
354 (define* (draw-bezier-path path #:key
355 (segments 32)
356 control-points?
357 tangents?
358 (control-point-size 8.0)
359 (color white)
360 (control-point-color yellow)
361 (tangent-color yellow)
362 (thickness 0.5)
363 (feather 1.0)
364 matrix)
365 (for-each (lambda (bezier)
366 (draw-bezier-curve bezier
367 #:segments segments
368 #:control-points? control-points?
369 #:tangents? tangents?
370 #:control-point-size control-point-size
371 #:color color
372 #:control-point-color control-point-color
373 #:tangent-color tangent-color
374 #:thickness 0.5
375 #:feather feather
376 #:matrix matrix))
377 path))