1 USING: kernel opengl opengl.demo-support opengl.gl
2 opengl.shaders opengl.framebuffers opengl.capabilities multiline
3 ui.gadgets accessors sequences ui.render ui math locals arrays
4 generalizations combinators ui.gadgets.worlds ;
7 STRING: plane-vertex-shader
8 varying vec3 object_position;
12 object_position = gl_Vertex.xyz;
13 gl_Position = ftransform();
17 STRING: plane-fragment-shader
18 uniform float checker_size_inv;
19 uniform vec4 checker_color_1, checker_color_2;
20 varying vec3 object_position;
25 vec3 pprime = checker_size_inv * object_position;
26 return fract((floor(pprime.x) + floor(pprime.z)) * 0.5) == 0.0;
32 float distance_factor = (gl_FragCoord.z * 0.5 + 0.5);
33 distance_factor = pow(distance_factor, 500.0)*0.5;
35 gl_FragColor = checker_color(object_position)
36 ? mix(checker_color_1, checker_color_2, distance_factor)
37 : mix(checker_color_2, checker_color_1, distance_factor);
41 STRING: sphere-vertex-shader
42 attribute vec3 center;
43 attribute float radius;
44 attribute vec4 surface_color;
45 varying float vradius;
46 varying vec3 sphere_position;
47 varying vec4 world_position, vcolor;
52 world_position = gl_ModelViewMatrix * vec4(center, 1);
53 sphere_position = gl_Vertex.xyz;
55 gl_Position = gl_ProjectionMatrix * (world_position + vec4(sphere_position * radius, 0));
57 vcolor = surface_color;
62 STRING: sphere-solid-color-fragment-shader
63 uniform vec3 light_position;
66 const vec4 ambient = vec4(0.25, 0.2, 0.25, 1.0);
67 const vec4 diffuse = vec4(0.75, 0.8, 0.75, 1.0);
70 sphere_color(vec3 point, vec3 normal)
72 vec3 transformed_light_position = (gl_ModelViewMatrix * vec4(light_position, 1)).xyz;
73 vec3 direction = normalize(transformed_light_position - point);
74 float d = max(0.0, dot(normal, direction));
76 return ambient * vcolor + diffuse * vec4(d * vcolor.rgb, vcolor.a);
80 STRING: sphere-texture-fragment-shader
81 uniform samplerCube surface_texture;
84 sphere_color(vec3 point, vec3 normal)
86 vec3 reflect = reflect(normalize(point), normal);
87 return textureCube(surface_texture, reflect * gl_NormalMatrix);
91 STRING: sphere-main-fragment-shader
92 varying float vradius;
93 varying vec3 sphere_position;
94 varying vec4 world_position;
96 vec4 sphere_color(vec3 point, vec3 normal);
101 float radius = length(sphere_position);
102 if(radius > 1.0) discard;
104 vec3 surface = sphere_position + vec3(0.0, 0.0, sqrt(1.0 - radius*radius));
105 vec4 world_surface = world_position + vec4(surface * vradius, 0);
106 vec4 transformed_surface = gl_ProjectionMatrix * world_surface;
108 gl_FragDepth = (transformed_surface.z/transformed_surface.w + 1.0) * 0.5;
109 gl_FragColor = sphere_color(world_surface.xyz, surface);
113 TUPLE: spheres-gadget < demo-gadget
114 plane-program solid-sphere-program texture-sphere-program
115 reflection-framebuffer reflection-depthbuffer
116 reflection-texture initialized? ;
118 : <spheres-gadget> ( -- gadget )
119 20.0 10.0 20.0 spheres-gadget new-demo-gadget ;
121 M: spheres-gadget near-plane ( gadget -- z )
123 M: spheres-gadget far-plane ( gadget -- z )
125 M: spheres-gadget distance-step ( gadget -- dz )
128 : (reflection-dim) ( -- w h )
131 : (make-reflection-texture) ( -- texture )
133 GL_TEXTURE_CUBE_MAP swap glBindTexture
134 GL_TEXTURE_CUBE_MAP GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
135 GL_TEXTURE_CUBE_MAP GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
136 GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_S GL_CLAMP glTexParameteri
137 GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_T GL_CLAMP glTexParameteri
138 GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_R GL_CLAMP glTexParameteri
139 GL_TEXTURE_CUBE_MAP_POSITIVE_X
140 GL_TEXTURE_CUBE_MAP_POSITIVE_Y
141 GL_TEXTURE_CUBE_MAP_POSITIVE_Z
142 GL_TEXTURE_CUBE_MAP_NEGATIVE_X
143 GL_TEXTURE_CUBE_MAP_NEGATIVE_Y
144 GL_TEXTURE_CUBE_MAP_NEGATIVE_Z 6 narray
145 [ 0 GL_RGBA8 (reflection-dim) 0 GL_RGBA GL_UNSIGNED_BYTE f glTexImage2D ]
149 : (make-reflection-depthbuffer) ( -- depthbuffer )
151 GL_RENDERBUFFER_EXT swap glBindRenderbufferEXT
152 GL_RENDERBUFFER_EXT GL_DEPTH_COMPONENT32 (reflection-dim) glRenderbufferStorageEXT
155 : (make-reflection-framebuffer) ( depthbuffer -- framebuffer )
156 gen-framebuffer dup [
158 GL_FRAMEBUFFER_EXT GL_DEPTH_ATTACHMENT_EXT GL_RENDERBUFFER_EXT r>
159 glFramebufferRenderbufferEXT
162 : (plane-program) ( -- program )
163 plane-vertex-shader plane-fragment-shader <simple-gl-program> ;
164 : (solid-sphere-program) ( -- program )
165 sphere-vertex-shader <vertex-shader> check-gl-shader
166 sphere-solid-color-fragment-shader <fragment-shader> check-gl-shader
167 sphere-main-fragment-shader <fragment-shader> check-gl-shader
168 3array <gl-program> check-gl-program ;
169 : (texture-sphere-program) ( -- program )
170 sphere-vertex-shader <vertex-shader> check-gl-shader
171 sphere-texture-fragment-shader <fragment-shader> check-gl-shader
172 sphere-main-fragment-shader <fragment-shader> check-gl-shader
173 3array <gl-program> check-gl-program ;
175 M: spheres-gadget graft* ( gadget -- )
177 "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions
178 { "GL_EXT_framebuffer_object" } require-gl-extensions
179 (plane-program) >>plane-program
180 (solid-sphere-program) >>solid-sphere-program
181 (texture-sphere-program) >>texture-sphere-program
182 (make-reflection-texture) >>reflection-texture
183 (make-reflection-depthbuffer) [ >>reflection-depthbuffer ] keep
184 (make-reflection-framebuffer) >>reflection-framebuffer
188 M: spheres-gadget ungraft* ( gadget -- )
192 [ reflection-framebuffer>> [ delete-framebuffer ] when* ]
193 [ reflection-depthbuffer>> [ delete-renderbuffer ] when* ]
194 [ reflection-texture>> [ delete-texture ] when* ]
195 [ solid-sphere-program>> [ delete-gl-program ] when* ]
196 [ texture-sphere-program>> [ delete-gl-program ] when* ]
197 [ plane-program>> [ delete-gl-program ] when* ]
200 M: spheres-gadget pref-dim* ( gadget -- dim )
203 :: (draw-sphere) ( program center radius -- )
204 program "center" glGetAttribLocation center first3 glVertexAttrib3f
205 program "radius" glGetAttribLocation radius glVertexAttrib1f
206 { -1.0 -1.0 } { 1.0 1.0 } rect-vertices ;
208 :: (draw-colored-sphere) ( program center radius surfacecolor -- )
209 program "surface_color" glGetAttribLocation surfacecolor first4 glVertexAttrib4f
210 program center radius (draw-sphere) ;
212 : sphere-scene ( gadget -- )
213 GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
215 solid-sphere-program>> [
217 [ "light_position" glGetUniformLocation 0.0 0.0 100.0 glUniform3f ]
218 [ { 7.0 0.0 0.0 } 1.0 { 1.0 0.0 0.0 1.0 } (draw-colored-sphere) ]
219 [ { -7.0 0.0 0.0 } 1.0 { 0.0 1.0 0.0 1.0 } (draw-colored-sphere) ]
220 [ { 0.0 0.0 7.0 } 1.0 { 0.0 0.0 1.0 1.0 } (draw-colored-sphere) ]
221 [ { 0.0 0.0 -7.0 } 1.0 { 1.0 1.0 0.0 1.0 } (draw-colored-sphere) ]
222 [ { 0.0 7.0 0.0 } 1.0 { 1.0 0.0 1.0 1.0 } (draw-colored-sphere) ]
223 [ { 0.0 -7.0 0.0 } 1.0 { 0.0 1.0 1.0 1.0 } (draw-colored-sphere) ]
229 [ "checker_size_inv" glGetUniformLocation 0.125 glUniform1f ]
230 [ "checker_color_1" glGetUniformLocation 1.0 0.0 0.0 1.0 glUniform4f ]
231 [ "checker_color_2" glGetUniformLocation 1.0 1.0 1.0 1.0 glUniform4f ]
234 -1000.0 -30.0 1000.0 glVertex3f
235 -1000.0 -30.0 -1000.0 glVertex3f
236 1000.0 -30.0 -1000.0 glVertex3f
237 1000.0 -30.0 1000.0 glVertex3f
242 : reflection-frustum ( gadget -- -x x -y y near far )
243 [ near-plane ] [ far-plane ] bi
244 [ drop dup [ -+ ] bi@ ] 2keep ;
246 : (reflection-face) ( gadget face -- )
247 swap reflection-texture>> >r >r
249 GL_COLOR_ATTACHMENT0_EXT
250 r> r> 0 glFramebufferTexture2DEXT
253 : (draw-reflection-texture) ( gadget -- )
254 dup reflection-framebuffer>> [ {
255 [ drop 0 0 (reflection-dim) glViewport ]
257 GL_PROJECTION glMatrixMode
259 reflection-frustum glFrustum
260 GL_MODELVIEW glMatrixMode
262 180.0 0.0 0.0 1.0 glRotatef
264 [ GL_TEXTURE_CUBE_MAP_NEGATIVE_Z (reflection-face) ]
266 [ GL_TEXTURE_CUBE_MAP_POSITIVE_X (reflection-face)
267 90.0 0.0 1.0 0.0 glRotatef ]
269 [ GL_TEXTURE_CUBE_MAP_POSITIVE_Z (reflection-face)
270 90.0 0.0 1.0 0.0 glRotatef glPushMatrix ]
272 [ GL_TEXTURE_CUBE_MAP_NEGATIVE_X (reflection-face)
273 90.0 0.0 1.0 0.0 glRotatef ]
275 [ GL_TEXTURE_CUBE_MAP_NEGATIVE_Y (reflection-face)
276 glPopMatrix glPushMatrix -90.0 1.0 0.0 0.0 glRotatef ]
278 [ GL_TEXTURE_CUBE_MAP_POSITIVE_Y (reflection-face)
279 glPopMatrix 90.0 1.0 0.0 0.0 glRotatef ]
281 [ dim>> 0 0 rot first2 glViewport ]
282 } cleave ] with-framebuffer ;
284 : (draw-gadget) ( gadget -- )
285 GL_DEPTH_TEST glEnable
286 GL_SCISSOR_TEST glDisable
287 0.15 0.15 1.0 1.0 glClearColor {
288 [ (draw-reflection-texture) ]
289 [ demo-gadget-set-matrices ]
291 [ reflection-texture>> GL_TEXTURE_CUBE_MAP GL_TEXTURE0 bind-texture-unit ]
293 texture-sphere-program>> [
294 [ "surface_texture" glGetUniformLocation 0 glUniform1i ]
295 [ { 0.0 0.0 0.0 } 4.0 (draw-sphere) ]
301 M: spheres-gadget draw-gadget* ( gadget -- )
302 dup initialized?>> [ (draw-gadget) ] [ drop ] if ;
304 : spheres-window ( -- )
305 [ <spheres-gadget> "Spheres" open-window ] with-ui ;