retool with-gl-program -- preserving the program object and using cleave is more flexible than the hardcoded pattern
parent
c6d1bd6b25
commit
af80e5c97f
|
@ -1,6 +1,6 @@
|
||||||
USING: arrays bunny.model continuations destructors kernel
|
USING: arrays bunny.model continuations destructors kernel
|
||||||
multiline opengl opengl.shaders opengl.capabilities opengl.gl
|
multiline opengl opengl.shaders opengl.capabilities opengl.gl
|
||||||
sequences sequences.lib accessors ;
|
sequences sequences.lib accessors combinators ;
|
||||||
IN: bunny.cel-shaded
|
IN: bunny.cel-shaded
|
||||||
|
|
||||||
STRING: vertex-shader-source
|
STRING: vertex-shader-source
|
||||||
|
@ -78,13 +78,15 @@ TUPLE: bunny-cel-shaded program ;
|
||||||
] [ f ] if ;
|
] [ f ] if ;
|
||||||
|
|
||||||
: (draw-cel-shaded-bunny) ( geom program -- )
|
: (draw-cel-shaded-bunny) ( geom program -- )
|
||||||
|
[
|
||||||
{
|
{
|
||||||
{ "light_direction" [ 1.0 -1.0 1.0 glUniform3f ] }
|
[ "light_direction" glGetUniformLocation 1.0 -1.0 1.0 glUniform3f ]
|
||||||
{ "color" [ 0.6 0.5 0.5 1.0 glUniform4f ] }
|
[ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ]
|
||||||
{ "ambient" [ 0.2 0.2 0.2 0.2 glUniform4f ] }
|
[ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ]
|
||||||
{ "diffuse" [ 0.8 0.8 0.8 0.8 glUniform4f ] }
|
[ "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ]
|
||||||
{ "shininess" [ 100.0 glUniform1f ] }
|
[ "shininess" glGetUniformLocation 100.0 glUniform1f ]
|
||||||
} [ bunny-geom ] with-gl-program ;
|
} cleave bunny-geom
|
||||||
|
] with-gl-program ;
|
||||||
|
|
||||||
M: bunny-cel-shaded draw-bunny
|
M: bunny-cel-shaded draw-bunny
|
||||||
program>> (draw-cel-shaded-bunny) ;
|
program>> (draw-cel-shaded-bunny) ;
|
||||||
|
|
|
@ -220,13 +220,14 @@ TUPLE: bunny-outlined
|
||||||
[ normal-texture>> GL_TEXTURE_2D GL_TEXTURE1 bind-texture-unit ]
|
[ normal-texture>> GL_TEXTURE_2D GL_TEXTURE1 bind-texture-unit ]
|
||||||
[ depth-texture>> GL_TEXTURE_2D GL_TEXTURE2 bind-texture-unit ]
|
[ depth-texture>> GL_TEXTURE_2D GL_TEXTURE2 bind-texture-unit ]
|
||||||
[
|
[
|
||||||
pass2-program>> {
|
pass2-program>> [
|
||||||
{ "colormap" [ 0 glUniform1i ] }
|
{
|
||||||
{ "normalmap" [ 1 glUniform1i ] }
|
[ "colormap" glGetUniformLocation 0 glUniform1i ]
|
||||||
{ "depthmap" [ 2 glUniform1i ] }
|
[ "normalmap" glGetUniformLocation 1 glUniform1i ]
|
||||||
{ "line_color" [ 0.1 0.0 0.1 1.0 glUniform4f ] }
|
[ "depthmap" glGetUniformLocation 2 glUniform1i ]
|
||||||
} [ { -1.0 -1.0 } { 1.0 1.0 } rect-vertices ]
|
[ "line_color" glGetUniformLocation 0.1 0.0 0.1 1.0 glUniform4f ]
|
||||||
with-gl-program
|
} cleave { -1.0 -1.0 } { 1.0 1.0 } rect-vertices
|
||||||
|
] with-gl-program
|
||||||
]
|
]
|
||||||
} cleave ;
|
} cleave ;
|
||||||
|
|
||||||
|
|
|
@ -95,18 +95,7 @@ HELP: delete-gl-program
|
||||||
{ $description "Deletes the program object, invalidating it and releasing any resources allocated for it by the OpenGL implementation. Any attached " { $link gl-shader } "s are also deleted.\n\nIf the shader objects should be preserved, they should each be detached using " { $link detach-gl-program-shader } ". The program object can then be destroyed alone using " { $link delete-gl-program-only } "." } ;
|
{ $description "Deletes the program object, invalidating it and releasing any resources allocated for it by the OpenGL implementation. Any attached " { $link gl-shader } "s are also deleted.\n\nIf the shader objects should be preserved, they should each be detached using " { $link detach-gl-program-shader } ". The program object can then be destroyed alone using " { $link delete-gl-program-only } "." } ;
|
||||||
|
|
||||||
HELP: with-gl-program
|
HELP: with-gl-program
|
||||||
{ $values { "program" "A " { $link gl-program } " object" } { "uniforms" "An " { $link assoc } " between uniform parameter names and quotations with effect " { $snippet "( uniform-location -- )" } } { "quot" "A quotation" } }
|
{ $values { "program" "A " { $link gl-program } " object" } { "quot" "A quotation with stack effect " { $snippet "( program -- )" } } }
|
||||||
{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in the dynamic extent of " { $snippet "quot" } ". The fixed-function pipeline is restored at the end of " { $snippet "quot" } ". Before calling " { $snippet "quot" } ", calls " { $link glGetUniformLocation } " on each key of " { $snippet "uniforms" } " to get the address of the uniform parameter, which is then placed on top of the stack as the associated quotation is called.\n\nExample:" }
|
{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in the dynamic extent of " { $snippet "quot" } ". " { $snippet "program" } " is left on the top of the stack when " { $snippet "quot" } " is called. The fixed-function pipeline is restored at the end of " { $snippet "quot" } "." } ;
|
||||||
{ $code <"
|
|
||||||
! From bunny.cel-shaded
|
|
||||||
: (draw-cel-shaded-bunny) ( geom program -- )
|
|
||||||
{
|
|
||||||
{ "light_direction" [ 1.0 -1.0 1.0 glUniform3f ] }
|
|
||||||
{ "color" [ 0.6 0.5 0.5 1.0 glUniform4f ] }
|
|
||||||
{ "ambient" [ 0.2 0.2 0.2 0.2 glUniform4f ] }
|
|
||||||
{ "diffuse" [ 0.8 0.8 0.8 0.8 glUniform4f ] }
|
|
||||||
{ "shininess" [ 100.0 glUniform1f ] }
|
|
||||||
} [ bunny-geom ] with-gl-program ;
|
|
||||||
"> } ;
|
|
||||||
|
|
||||||
ABOUT: "gl-utilities"
|
ABOUT: "gl-utilities"
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel opengl.gl alien.c-types continuations namespaces
|
USING: kernel opengl.gl alien.c-types continuations namespaces
|
||||||
assocs alien alien.strings libc opengl math sequences combinators
|
assocs alien alien.strings libc opengl math sequences combinators
|
||||||
combinators.lib macros arrays io.encodings.ascii ;
|
combinators.lib macros arrays io.encodings.ascii fry ;
|
||||||
IN: opengl.shaders
|
IN: opengl.shaders
|
||||||
|
|
||||||
: with-gl-shader-source-ptr ( string quot -- )
|
: with-gl-shader-source-ptr ( string quot -- )
|
||||||
|
@ -107,22 +107,8 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
|
||||||
2dup detach-gl-program-shader delete-gl-shader
|
2dup detach-gl-program-shader delete-gl-shader
|
||||||
] each delete-gl-program-only ;
|
] each delete-gl-program-only ;
|
||||||
|
|
||||||
: (with-gl-program) ( program quot -- )
|
: with-gl-program ( program quot -- )
|
||||||
swap glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
|
over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
|
||||||
|
|
||||||
: (with-gl-program-uniforms) ( uniforms -- quot )
|
|
||||||
[ [ swap , \ glGetUniformLocation , % ] [ ] make ]
|
|
||||||
{ } assoc>map ;
|
|
||||||
: (make-with-gl-program) ( uniforms quot -- q )
|
|
||||||
[
|
|
||||||
\ dup ,
|
|
||||||
[ swap (with-gl-program-uniforms) , \ cleave , % ]
|
|
||||||
[ ] make ,
|
|
||||||
\ (with-gl-program) ,
|
|
||||||
] [ ] make ;
|
|
||||||
|
|
||||||
MACRO: with-gl-program ( uniforms quot -- )
|
|
||||||
(make-with-gl-program) ;
|
|
||||||
|
|
||||||
PREDICATE: gl-program < integer (gl-program?) ;
|
PREDICATE: gl-program < integer (gl-program?) ;
|
||||||
|
|
||||||
|
|
|
@ -194,10 +194,9 @@ M: spheres-gadget pref-dim* ( gadget -- dim )
|
||||||
: sphere-scene ( gadget -- )
|
: sphere-scene ( gadget -- )
|
||||||
GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
|
GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
|
||||||
[
|
[
|
||||||
solid-sphere-program>> dup {
|
solid-sphere-program>> [
|
||||||
{ "light_position" [ 0.0 0.0 100.0 glUniform3f ] }
|
|
||||||
} [
|
|
||||||
{
|
{
|
||||||
|
[ "light_position" glGetUniformLocation 0.0 0.0 100.0 glUniform3f ]
|
||||||
[ { 7.0 0.0 0.0 } 1.0 { 1.0 0.0 0.0 1.0 } (draw-sphere) ]
|
[ { 7.0 0.0 0.0 } 1.0 { 1.0 0.0 0.0 1.0 } (draw-sphere) ]
|
||||||
[ { -7.0 0.0 0.0 } 1.0 { 0.0 1.0 0.0 1.0 } (draw-sphere) ]
|
[ { -7.0 0.0 0.0 } 1.0 { 0.0 1.0 0.0 1.0 } (draw-sphere) ]
|
||||||
[ { 0.0 0.0 7.0 } 1.0 { 0.0 0.0 1.0 1.0 } (draw-sphere) ]
|
[ { 0.0 0.0 7.0 } 1.0 { 0.0 0.0 1.0 1.0 } (draw-sphere) ]
|
||||||
|
@ -207,7 +206,8 @@ M: spheres-gadget pref-dim* ( gadget -- dim )
|
||||||
} cleave
|
} cleave
|
||||||
] with-gl-program
|
] with-gl-program
|
||||||
] [
|
] [
|
||||||
plane-program>> { } [
|
plane-program>> [
|
||||||
|
drop
|
||||||
GL_QUADS [
|
GL_QUADS [
|
||||||
-1000.0 -30.0 1000.0 glVertex3f
|
-1000.0 -30.0 1000.0 glVertex3f
|
||||||
-1000.0 -30.0 -1000.0 glVertex3f
|
-1000.0 -30.0 -1000.0 glVertex3f
|
||||||
|
@ -269,10 +269,10 @@ M: spheres-gadget draw-gadget* ( gadget -- )
|
||||||
[ sphere-scene ]
|
[ sphere-scene ]
|
||||||
[ reflection-texture>> GL_TEXTURE_CUBE_MAP GL_TEXTURE0 bind-texture-unit ]
|
[ reflection-texture>> GL_TEXTURE_CUBE_MAP GL_TEXTURE0 bind-texture-unit ]
|
||||||
[
|
[
|
||||||
texture-sphere-program>> dup {
|
texture-sphere-program>> [
|
||||||
{ "surface_texture" [ 0 glUniform1i ] }
|
[ "surface_texture" glGetUniformLocation 0 glUniform1i ]
|
||||||
} [
|
[ { 0.0 0.0 0.0 } 4.0 { 1.0 0.0 0.0 1.0 } (draw-sphere) ]
|
||||||
{ 0.0 0.0 0.0 } 4.0 { 1.0 0.0 0.0 1.0 } (draw-sphere)
|
bi
|
||||||
] with-gl-program
|
] with-gl-program
|
||||||
]
|
]
|
||||||
} cleave ;
|
} cleave ;
|
||||||
|
|
Loading…
Reference in New Issue