extra/spheres/spheres.factor

   1 USING: kernel opengl opengl.demo-support opengl.gl opengl.textures
   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 literals ;
   5 IN: spheres
   6
   7 STRING: plane-vertex-shader
   8 varying vec3 object_position;
   9 void
  10 main()
  11 {
  12     object_position = gl_Vertex.xyz;
  13     gl_Position = ftransform();
  14 }
  15 ;
  16
  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;
  21
  22 bool
  23 checker_color(vec3 p)
  24 {
  25     vec3 pprime = checker_size_inv * object_position;
  26     return fract((floor(pprime.x) + floor(pprime.z)) * 0.5) == 0.0;
  27 }
  28
  29 void
  30 main()
  31 {
  32     float distance_factor = (gl_FragCoord.z * 0.5 + 0.5);
  33     distance_factor = pow(distance_factor, 500.0)*0.5;
  34
  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);
  38 }
  39 ;
  40
  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;
  48
  49 void
  50 main()
  51 {
  52     world_position = gl_ModelViewMatrix * vec4(center, 1);
  53     sphere_position = gl_Vertex.xyz;
  54
  55     gl_Position = gl_ProjectionMatrix * (world_position + vec4(sphere_position * radius, 0));
  56
  57     vcolor = surface_color;
  58     vradius = radius;
  59 }
  60 ;
  61
  62 STRING: sphere-solid-color-fragment-shader
  63 uniform vec3 light_position;
  64 varying vec4 vcolor;
  65
  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);
  68
  69 vec4
  70 sphere_color(vec3 point, vec3 normal)
  71 {
  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));
  75
  76     return ambient * vcolor + diffuse * vec4(d * vcolor.rgb, vcolor.a);
  77 }
  78 ;
  79
  80 STRING: sphere-texture-fragment-shader
  81 uniform samplerCube surface_texture;
  82
  83 vec4
  84 sphere_color(vec3 point, vec3 normal)
  85 {
  86     vec3 reflect = reflect(normalize(point), normal);
  87     return textureCube(surface_texture, reflect * gl_NormalMatrix);
  88 }
  89 ;
  90
  91 STRING: sphere-main-fragment-shader
  92 varying float vradius;
  93 varying vec3 sphere_position;
  94 varying vec4 world_position;
  95
  96 vec4 sphere_color(vec3 point, vec3 normal);
  97
  98 void
  99 main()
 100 {
 101         float radius = length(sphere_position);
 102         if(radius > 1.0) discard;
 103
 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;
 107
 108     gl_FragDepth = (transformed_surface.z/transformed_surface.w + 1.0) * 0.5;
 109         gl_FragColor = sphere_color(world_surface.xyz, surface);
 110 }
 111 ;
 112
 113 TUPLE: spheres-gadget < demo-gadget
 114     plane-program solid-sphere-program texture-sphere-program
 115     reflection-framebuffer reflection-depthbuffer
 116     reflection-texture initialized? ;
 117
 118 : <spheres-gadget> ( -- gadget )
 119     20.0 10.0 20.0 spheres-gadget new-demo-gadget ;
 120
 121 M: spheres-gadget near-plane ( gadget -- z )
 122     drop 1.0 ;
 123 M: spheres-gadget far-plane ( gadget -- z )
 124     drop 512.0 ;
 125 M: spheres-gadget distance-step ( gadget -- dz )
 126     drop 0.5 ;
 127
 128 : (reflection-dim) ( -- w h )
 129     512 512 ;
 130
 131 : (make-reflection-texture) ( -- texture )
 132     gen-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         ${
 140             GL_TEXTURE_CUBE_MAP_POSITIVE_X
 141             GL_TEXTURE_CUBE_MAP_POSITIVE_Y
 142             GL_TEXTURE_CUBE_MAP_POSITIVE_Z
 143             GL_TEXTURE_CUBE_MAP_NEGATIVE_X
 144             GL_TEXTURE_CUBE_MAP_NEGATIVE_Y
 145             GL_TEXTURE_CUBE_MAP_NEGATIVE_Z
 146         }
 147         [ 0 GL_RGBA8 (reflection-dim) 0 GL_RGBA GL_UNSIGNED_BYTE f glTexImage2D ]
 148         each
 149     ] keep ;
 150
 151 : (make-reflection-depthbuffer) ( -- depthbuffer )
 152     gen-renderbuffer [
 153         GL_RENDERBUFFER_EXT swap glBindRenderbufferEXT
 154         GL_RENDERBUFFER_EXT GL_DEPTH_COMPONENT32 (reflection-dim) glRenderbufferStorageEXT
 155     ] keep ;
 156
 157 : (make-reflection-framebuffer) ( depthbuffer -- framebuffer )
 158     gen-framebuffer dup [
 159         swap [ GL_FRAMEBUFFER_EXT GL_DEPTH_ATTACHMENT_EXT GL_RENDERBUFFER_EXT ] dip
 160         glFramebufferRenderbufferEXT
 161     ] with-framebuffer ;
 162
 163 : (plane-program) ( -- program )
 164     plane-vertex-shader plane-fragment-shader <simple-gl-program> ;
 165 : (solid-sphere-program) ( -- program )
 166     sphere-vertex-shader <vertex-shader> check-gl-shader
 167     sphere-solid-color-fragment-shader <fragment-shader> check-gl-shader
 168     sphere-main-fragment-shader <fragment-shader> check-gl-shader
 169     3array <gl-program> check-gl-program ;
 170 : (texture-sphere-program) ( -- program )
 171     sphere-vertex-shader <vertex-shader> check-gl-shader
 172     sphere-texture-fragment-shader <fragment-shader> check-gl-shader
 173     sphere-main-fragment-shader <fragment-shader> check-gl-shader
 174     3array <gl-program> check-gl-program ;
 175
 176 M: spheres-gadget graft* ( gadget -- )
 177     dup find-gl-context
 178     "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions
 179     { "GL_EXT_framebuffer_object" } require-gl-extensions
 180     (plane-program) >>plane-program
 181     (solid-sphere-program) >>solid-sphere-program
 182     (texture-sphere-program) >>texture-sphere-program
 183     (make-reflection-texture) >>reflection-texture
 184     (make-reflection-depthbuffer) [ >>reflection-depthbuffer ] keep
 185     (make-reflection-framebuffer) >>reflection-framebuffer
 186     t >>initialized?
 187     drop ;
 188
 189 M: spheres-gadget ungraft* ( gadget -- )
 190     f >>initialized?
 191     dup find-gl-context
 192     {
 193         [ reflection-framebuffer>> [ delete-framebuffer ] when* ]
 194         [ reflection-depthbuffer>> [ delete-renderbuffer ] when* ]
 195         [ reflection-texture>> [ delete-texture ] when* ]
 196         [ solid-sphere-program>> [ delete-gl-program ] when* ]
 197         [ texture-sphere-program>> [ delete-gl-program ] when* ]
 198         [ plane-program>> [ delete-gl-program ] when* ]
 199     } cleave ;
 200
 201 M: spheres-gadget pref-dim* ( gadget -- dim )
 202     drop { 640 480 } ;
 203
 204 :: (draw-sphere) ( program center radius -- )
 205     program "center" glGetAttribLocation center first3 glVertexAttrib3f
 206     program "radius" glGetAttribLocation radius glVertexAttrib1f
 207     { -1.0 -1.0 } { 1.0 1.0 } rect-vertices ;
 208
 209 :: (draw-colored-sphere) ( program center radius surfacecolor -- )
 210     program "surface_color" glGetAttribLocation surfacecolor first4 glVertexAttrib4f
 211     program center radius (draw-sphere) ;
 212
 213 : sphere-scene ( gadget -- )
 214     GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
 215     [
 216         solid-sphere-program>> [
 217             {
 218                 [ "light_position" glGetUniformLocation 0.0 0.0 100.0 glUniform3f ]
 219                 [ {  7.0  0.0  0.0 } 1.0 { 1.0 0.0 0.0 1.0 } (draw-colored-sphere) ]
 220                 [ { -7.0  0.0  0.0 } 1.0 { 0.0 1.0 0.0 1.0 } (draw-colored-sphere) ]
 221                 [ {  0.0  0.0  7.0 } 1.0 { 0.0 0.0 1.0 1.0 } (draw-colored-sphere) ]
 222                 [ {  0.0  0.0 -7.0 } 1.0 { 1.0 1.0 0.0 1.0 } (draw-colored-sphere) ]
 223                 [ {  0.0  7.0  0.0 } 1.0 { 1.0 0.0 1.0 1.0 } (draw-colored-sphere) ]
 224                 [ {  0.0 -7.0  0.0 } 1.0 { 0.0 1.0 1.0 1.0 } (draw-colored-sphere) ]
 225             } cleave
 226         ] with-gl-program
 227     ] [
 228         plane-program>> [
 229             {
 230                 [ "checker_size_inv" glGetUniformLocation 0.125 glUniform1f ]
 231                 [ "checker_color_1"  glGetUniformLocation 1.0 0.0 0.0 1.0 glUniform4f ]
 232                 [ "checker_color_2"  glGetUniformLocation 1.0 1.0 1.0 1.0 glUniform4f ]
 233             } cleave
 234             GL_QUADS [
 235                 -1000.0 -30.0  1000.0 glVertex3f
 236                 -1000.0 -30.0 -1000.0 glVertex3f
 237                  1000.0 -30.0 -1000.0 glVertex3f
 238                  1000.0 -30.0  1000.0 glVertex3f
 239             ] do-state
 240         ] with-gl-program
 241     ] bi ;
 242
 243 : reflection-frustum ( gadget -- -x x -y y near far )
 244     [ near-plane ] [ far-plane ] bi
 245     [ drop dup [ -+ ] bi@ ] 2keep ;
 246
 247 : (reflection-face) ( gadget face -- )
 248     swap reflection-texture>> [
 249         GL_FRAMEBUFFER_EXT
 250         GL_COLOR_ATTACHMENT0_EXT
 251     ] 2dip 0 glFramebufferTexture2DEXT
 252     check-framebuffer ;
 253
 254 : (draw-reflection-texture) ( gadget -- )
 255     dup reflection-framebuffer>> [ {
 256         [ drop 0 0 (reflection-dim) glViewport ]
 257         [
 258             GL_PROJECTION glMatrixMode
 259             glLoadIdentity
 260             reflection-frustum glFrustum
 261             GL_MODELVIEW glMatrixMode
 262             glLoadIdentity
 263             180.0 0.0 0.0 1.0 glRotatef
 264         ]
 265         [ GL_TEXTURE_CUBE_MAP_NEGATIVE_Z (reflection-face) ]
 266         [ sphere-scene ]
 267         [ GL_TEXTURE_CUBE_MAP_POSITIVE_X (reflection-face)
 268           90.0 0.0 1.0 0.0 glRotatef ]
 269         [ sphere-scene ]
 270         [ GL_TEXTURE_CUBE_MAP_POSITIVE_Z (reflection-face)
 271           90.0 0.0 1.0 0.0 glRotatef glPushMatrix ]
 272         [ sphere-scene ]
 273         [ GL_TEXTURE_CUBE_MAP_NEGATIVE_X (reflection-face)
 274           90.0 0.0 1.0 0.0 glRotatef ]
 275         [ sphere-scene ]
 276         [ GL_TEXTURE_CUBE_MAP_NEGATIVE_Y (reflection-face)
 277           glPopMatrix glPushMatrix -90.0 1.0 0.0 0.0 glRotatef ]
 278         [ sphere-scene ]
 279         [ GL_TEXTURE_CUBE_MAP_POSITIVE_Y (reflection-face)
 280           glPopMatrix 90.0 1.0 0.0 0.0 glRotatef ]
 281         [ sphere-scene ]
 282         [ dim>> 0 0 rot first2 glViewport ]
 283     } cleave ] with-framebuffer ;
 284
 285 : (draw-gadget) ( gadget -- )
 286     GL_DEPTH_TEST glEnable
 287     GL_SCISSOR_TEST glDisable
 288     0.15 0.15 1.0 1.0 glClearColor {
 289         [ (draw-reflection-texture) ]
 290         [ demo-gadget-set-matrices ]
 291         [ sphere-scene ]
 292         [ reflection-texture>> GL_TEXTURE_CUBE_MAP GL_TEXTURE0 bind-texture-unit ]
 293         [
 294             texture-sphere-program>> [
 295                 [ "surface_texture" glGetUniformLocation 0 glUniform1i ]
 296                 [ { 0.0 0.0 0.0 } 4.0 (draw-sphere) ]
 297                 bi
 298             ] with-gl-program
 299         ]
 300     } cleave ;
 301
 302 M: spheres-gadget draw-gadget* ( gadget -- )
 303     dup initialized?>> [ (draw-gadget) ] [ drop ] if ;
 304
 305 : spheres-window ( -- )
 306     [ <spheres-gadget> "Spheres" open-window ] with-ui ;
 307
 308 MAIN: spheres-window