-
Notifications
You must be signed in to change notification settings - Fork 0
/
render-to-texture.scm
143 lines (129 loc) · 6.27 KB
/
render-to-texture.scm
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
;;;; render-to-texture.scm
;;;; NOTE:
;;;; This uses glls-render, so if this file is compiled it must be linked with OpenGL
;;;; E.g.:
;;;; csc -lGL render-to-texture.scm
(import chicken scheme)
(use glls-render (prefix glfw3 glfw:) (prefix opengl-glew gl:) gl-math gl-utils
noise srfi-4)
(define time (make-f32vector 1 0 #t))
(define rect (make-mesh vertices: '(attributes: ((position #:float 2))
initial-elements: ((position . (-1 -1
1 -1
1 1
-1 1))))
indices: '(type: #:ushort
initial-elements: (0 1 2
0 2 3))))
(define cube (make-mesh vertices: '(attributes: ((position #:float 3)
(tex-coord #:ushort 2
normalized: #t))
initial-elements: ((position . (0 0 0
1 0 0
1 1 0
0 1 0
0 0 1
1 0 1
1 1 1
0 1 1))
(tex-coord . (0 0
1 0
1 1
0 1
1 0
0 0
0 1
1 1))))
indices: '(type: #:ushort
initial-elements: (0 1 2
2 3 0
7 6 5
5 4 7
0 4 5
5 1 0
1 5 6
6 2 1
2 6 7
7 3 2
3 7 4
3 4 0))))
;;; Matrices
(define projection-matrix
(perspective 480 480 0.1 100 70))
(define view-matrix
(look-at (make-point 1.5 0.5 2)
(make-point 0.5 0.5 0.5)
(make-point 0 1 0)))
(define model-matrix (mat4-identity))
(define mvp (m* projection-matrix
(m* view-matrix model-matrix)
#t ; Matrix should be in a non-GC'd area
))
(define-pipeline noise-shader
((#:vertex input: ((position #:vec2))
output: ((pos #:vec2)))
(define (main) #:void
(set! gl:position (vec4 position 0.0 1.0))
(set! pos (* position 8))))
((#:fragment input: ((pos #:vec2))
uniform: ((time #:float))
output: ((frag-color #:vec4))
use: (flow-noise-2d))
(define (main) #:void
(set! isotropic true)
(let* ((g1 #:vec2) (g2 #:vec2)
(n1 #:float (flow-noise (* pos 0.5) (* 0.2 time) g1))
(n2 #:float (flow-noise (+ (* pos 2) (* g1 0.5)) (* 0.51 time) g2))
(n3 #:float (flow-noise (+ (* pos 4) (* g1 0.5) (* g2 0.5))
(* 0.77 time) g2)))
(set! isotropic true)
(set! frag-color (vec4 (+ (vec3 0.6 0.4 0.2)
(vec3 (+ n1 (* n2 0.75) (* n3 0.5))))
1.0))))))
(define-pipeline box-shader
((#:vertex input: ((position #:vec3)
(tex-coord #:vec2))
uniform: ((mvp #:mat4))
output: ((coord #:vec2)))
(define (main) #:void
(set! gl:position (* mvp (vec4 position 1.0)))
(set! coord tex-coord)))
((#:fragment input: ((coord #:vec2))
uniform: ((tex #:sampler-2d))
output: ((frag-color #:vec4)))
(begin
(define (main) #:void
(set! frag-color (texture tex coord))))))
(glfw:key-callback
(lambda (window key scancode action mods)
(if (eq? key glfw:+key-escape+)
(glfw:set-window-should-close window 1))))
(define (render-noise fbo renderable)
(with-framebuffer fbo
(gl:clear (bitwise-ior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
(render-noise-shader renderable)))
;;; Initialization and main loop
(glfw:with-window (480 480 "Example" resizable: #f)
(gl:init)
(gl:enable gl:+depth-test+)
(gl:depth-func gl:+less+)
(compile-pipelines)
(mesh-make-vao! rect (pipeline-mesh-attributes noise-shader))
(mesh-make-vao! cube (pipeline-mesh-attributes box-shader))
(receive (fbo tex _) (create-framebuffer 480 480)
(let* ((noise-renderable (make-noise-shader-renderable mesh: rect
time: time))
(box-renderable (make-box-shader-renderable mesh: cube
mvp: mvp
tex: tex)))
(let loop ()
(render-noise fbo noise-renderable)
;; At this point the texture with the noise (tex) could be transfered to RAM with e.g. gl:get-tex-image
(glfw:swap-buffers (glfw:window))
(gl:clear (bitwise-ior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
(render-box-shader box-renderable)
(check-error)
(glfw:poll-events)
(f32vector-set! time 0 (glfw:get-time))
(unless (glfw:window-should-close (glfw:window))
(loop))))))