render: Rename "typed buffer" to "buffer view".
[chickadee.git] / chickadee / render / shapes.scm
CommitLineData
98dc87a0 1;;; Chickadee Game Toolkit
14f984b3 2;;; Copyright © 2016, 2018 David Thompson <davet@gnu.org>
98dc87a0
DT
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)
0a15a316 28 #:use-module (chickadee math bezier)
98dc87a0 29 #:use-module (chickadee math matrix)
14f984b3 30 #:use-module (chickadee math rect)
98dc87a0
DT
31 #:use-module (chickadee math vector)
32 #:use-module (chickadee render)
7520b6c0 33 #:use-module (chickadee render color)
98dc87a0 34 #:use-module (chickadee render shader)
b1f41911 35 #:use-module (chickadee render buffer)
14f984b3 36 #:export (draw-filled-rect
0a15a316
DT
37 draw-line
38 draw-bezier-curve
39 draw-bezier-path))
14f984b3
DT
40
41;; TODO: Make a generic polygon renderer, include batching, etc.
42(define draw-filled-rect
43 (let* ((vertex-buffer
44 (delay
50abc024
DT
45 (make-streaming-buffer-view 'vec2 'float 4
46 #:name "rect-buffer-view")))
14f984b3
DT
47 (index-buffer
48 (delay
50abc024
DT
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))))
14f984b3
DT
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 "
dd35ec3c 61#version 130
14f984b3
DT
62
63in vec2 position;
64uniform mat4 mvp;
65
66void main(void) {
67 gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
68}
69"
70 "
dd35ec3c 71#version 130
14f984b3
DT
72
73in vec2 frag_tex;
74uniform vec4 color;
75
76void 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))))
50abc024
DT
91 (with-mapped-buffer-view (force vertex-buffer)
92 (let ((bv (buffer-view-data (force vertex-buffer))))
14f984b3
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)))
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))))))
98dc87a0
DT
110
111(define draw-line
f2414b69
DT
112 (let* ((mvp (make-null-matrix4))
113 (vertex-buffer
b1f41911 114 (delay
50abc024
DT
115 (make-streaming-buffer-view 'vec2 'float 4
116 #:name "line-buffer-view")))
98dc87a0 117 (texcoord-buffer
b1f41911 118 (delay
50abc024
DT
119 (make-streaming-buffer-view 'vec2 'float 4
120 #:name "line-buffer-view")))
98dc87a0 121 (index-buffer
b1f41911 122 (delay
50abc024
DT
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))))
98dc87a0 127 (vertex-array
b1f41911
DT
128 (delay
129 (make-vertex-array #:indices (force index-buffer)
130 #:attributes `((0 . ,(force vertex-buffer))
131 (1 . ,(force texcoord-buffer))))))
98dc87a0
DT
132 (default-shader
133 (delay
134 (strings->shader
135 "
dd35ec3c 136#version 130
98dc87a0
DT
137
138in vec2 position;
139in vec2 tex;
140out vec2 frag_tex;
f2414b69 141uniform mat4 mvp;
98dc87a0
DT
142
143void main(void) {
144 frag_tex = tex;
f2414b69 145 gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
98dc87a0
DT
146}
147"
148 "
dd35ec3c 149#version 130
98dc87a0
DT
150
151in vec2 frag_tex;
152uniform vec4 color;
153uniform float r;
154uniform float w;
155uniform float t;
156uniform float l;
157uniform int cap;
158float infinity = 1.0 / 0.0;
159
160void 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"))))
92fbc130
DT
213 (lambda* (start end #:key
214 (thickness 0.5)
215 (feather 1.0)
216 (cap 'round)
217 (color white)
f2414b69
DT
218 (shader (force default-shader))
219 matrix)
a68ae4ea
DT
220 "Draw a line segment from START to END. The line will be
221THICKNESS pixels thick with an antialiased border FEATHER pixels wide.
222The line will be colored COLOR. CAP specifies the type of end cap that
223should be used to terminate the lines, either 'none', 'butt',
224'square', 'round', 'triangle-in', or 'triangle-out'. Advanced users
225may use SHADER to override the built-in line segment shader."
92fbc130
DT
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))
98dc87a0
DT
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))
50abc024
DT
258 (with-mapped-buffer-view (force vertex-buffer)
259 (let ((bv (buffer-view-data (force vertex-buffer))))
98dc87a0
DT
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)))
50abc024
DT
268 (with-mapped-buffer-view (force texcoord-buffer)
269 (let ((bv (buffer-view-data (force texcoord-buffer))))
98dc87a0
DT
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)
f2414b69
DT
280 #:mvp (if matrix
281 (begin
282 (matrix4-mult! mvp matrix
283 (current-projection))
284 mvp)
285 (current-projection))
98dc87a0
DT
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))))))))
0a15a316
DT
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))