diff --git a/extra/bunny/cel-shaded/cel-shaded.factor b/extra/bunny/cel-shaded/cel-shaded.factor index 8285cd776f..e481b47161 100644 --- a/extra/bunny/cel-shaded/cel-shaded.factor +++ b/extra/bunny/cel-shaded/cel-shaded.factor @@ -1,6 +1,6 @@ USING: arrays bunny.model continuations destructors kernel multiline opengl opengl.shaders opengl.capabilities opengl.gl -sequences sequences.lib accessors ; +sequences sequences.lib accessors combinators ; IN: bunny.cel-shaded STRING: vertex-shader-source @@ -78,13 +78,15 @@ TUPLE: bunny-cel-shaded program ; ] [ f ] if ; : (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 ; + [ + { + [ "light_direction" glGetUniformLocation 1.0 -1.0 1.0 glUniform3f ] + [ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ] + [ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ] + [ "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ] + [ "shininess" glGetUniformLocation 100.0 glUniform1f ] + } cleave bunny-geom + ] with-gl-program ; M: bunny-cel-shaded draw-bunny program>> (draw-cel-shaded-bunny) ; diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index fcba98a0e9..bf757c4fb3 100755 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -220,13 +220,14 @@ TUPLE: bunny-outlined [ normal-texture>> GL_TEXTURE_2D GL_TEXTURE1 bind-texture-unit ] [ depth-texture>> GL_TEXTURE_2D GL_TEXTURE2 bind-texture-unit ] [ - pass2-program>> { - { "colormap" [ 0 glUniform1i ] } - { "normalmap" [ 1 glUniform1i ] } - { "depthmap" [ 2 glUniform1i ] } - { "line_color" [ 0.1 0.0 0.1 1.0 glUniform4f ] } - } [ { -1.0 -1.0 } { 1.0 1.0 } rect-vertices ] - with-gl-program + pass2-program>> [ + { + [ "colormap" glGetUniformLocation 0 glUniform1i ] + [ "normalmap" glGetUniformLocation 1 glUniform1i ] + [ "depthmap" glGetUniformLocation 2 glUniform1i ] + [ "line_color" glGetUniformLocation 0.1 0.0 0.1 1.0 glUniform4f ] + } cleave { -1.0 -1.0 } { 1.0 1.0 } rect-vertices + ] with-gl-program ] } cleave ; diff --git a/extra/opengl/shaders/shaders-docs.factor b/extra/opengl/shaders/shaders-docs.factor index 93251627f4..1a10071ddf 100644 --- a/extra/opengl/shaders/shaders-docs.factor +++ b/extra/opengl/shaders/shaders-docs.factor @@ -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 } "." } ; 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" } } -{ $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:" } -{ $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 ; -"> } ; +{ $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" } ". " { $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" } "." } ; ABOUT: "gl-utilities" diff --git a/extra/opengl/shaders/shaders.factor b/extra/opengl/shaders/shaders.factor index c05e180c11..d52e55417f 100755 --- a/extra/opengl/shaders/shaders.factor +++ b/extra/opengl/shaders/shaders.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel opengl.gl alien.c-types continuations namespaces 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 : 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 ] each delete-gl-program-only ; -: (with-gl-program) ( program quot -- ) - swap 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) ; +: with-gl-program ( program quot -- ) + over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline PREDICATE: gl-program < integer (gl-program?) ; diff --git a/extra/spheres/spheres.factor b/extra/spheres/spheres.factor index 9607f6d201..84621f8e18 100755 --- a/extra/spheres/spheres.factor +++ b/extra/spheres/spheres.factor @@ -194,10 +194,9 @@ M: spheres-gadget pref-dim* ( gadget -- dim ) : sphere-scene ( gadget -- ) GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear [ - solid-sphere-program>> dup { - { "light_position" [ 0.0 0.0 100.0 glUniform3f ] } - } [ + solid-sphere-program>> [ { + [ "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 { 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) ] @@ -207,7 +206,8 @@ M: spheres-gadget pref-dim* ( gadget -- dim ) } cleave ] with-gl-program ] [ - plane-program>> { } [ + plane-program>> [ + drop GL_QUADS [ -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 ] [ reflection-texture>> GL_TEXTURE_CUBE_MAP GL_TEXTURE0 bind-texture-unit ] [ - texture-sphere-program>> dup { - { "surface_texture" [ 0 glUniform1i ] } - } [ - { 0.0 0.0 0.0 } 4.0 { 1.0 0.0 0.0 1.0 } (draw-sphere) + texture-sphere-program>> [ + [ "surface_texture" glGetUniformLocation 0 glUniform1i ] + [ { 0.0 0.0 0.0 } 4.0 { 1.0 0.0 0.0 1.0 } (draw-sphere) ] + bi ] with-gl-program ] } cleave ;