diff --git a/extra/bunny/bunny.factor b/extra/bunny/bunny.factor index efebefcef3..38f8e32fb6 100755 --- a/extra/bunny/bunny.factor +++ b/extra/bunny/bunny.factor @@ -8,10 +8,6 @@ ui.gestures bunny.fixed-pipeline bunny.cel-shaded bunny.outlined bunny.model ; IN: bunny - - TUPLE: bunny-gadget model geom draw-seq draw-n ; : ( -- bunny-gadget ) diff --git a/extra/bunny/cel-shaded/cel-shaded.factor b/extra/bunny/cel-shaded/cel-shaded.factor index eb0924f50e..fc42ca971e 100644 --- a/extra/bunny/cel-shaded/cel-shaded.factor +++ b/extra/bunny/cel-shaded/cel-shaded.factor @@ -76,16 +76,13 @@ TUPLE: bunny-cel-shaded program ; ] [ f ] if ; : (draw-cel-shaded-bunny) ( geom program -- ) - dup [ - { - [ "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 ] - } call-with - bunny-geom - ] with-gl-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 ; M: bunny-cel-shaded draw-bunny bunny-cel-shaded-program (draw-cel-shaded-bunny) ; diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index 021ac6b4d8..9de341561c 100644 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -168,13 +168,24 @@ TUPLE: bunny-outlined check-framebuffer ] with-framebuffer ; +: dispose-framebuffer ( draw -- ) + dup bunny-outlined-framebuffer-dim [ + { + [ bunny-outlined-framebuffer [ delete-framebuffer ] when* ] + [ bunny-outlined-color-texture [ delete-texture ] when* ] + [ bunny-outlined-normal-texture [ delete-texture ] when* ] + [ bunny-outlined-depth-texture [ delete-texture ] when* ] + [ f swap set-bunny-outlined-framebuffer-dim ] + } call-with + ] [ drop ] if ; + : remake-framebuffer-if-needed ( draw -- ) dup bunny-outlined-gadget rect-dim over bunny-outlined-framebuffer-dim over = [ 2drop ] [ - swap >r + swap dup dispose-framebuffer >r dup GL_RGBA16F_ARB GL_RGBA (framebuffer-texture) swap dup GL_RGBA16F_ARB GL_RGBA (framebuffer-texture) swap dup GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT (framebuffer-texture) @@ -209,15 +220,12 @@ TUPLE: bunny-outlined dup bunny-outlined-color-texture GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit dup bunny-outlined-normal-texture GL_TEXTURE_2D GL_TEXTURE1 bind-texture-unit dup bunny-outlined-depth-texture GL_TEXTURE_2D GL_TEXTURE2 bind-texture-unit - bunny-outlined-pass2-program dup [ - { - [ "colormap" glGetUniformLocation 0 glUniform1i ] - [ "normalmap" glGetUniformLocation 1 glUniform1i ] - [ "depthmap" glGetUniformLocation 2 glUniform1i ] - [ "line_color" glGetUniformLocation 0.1 0.0 0.1 1.0 glUniform4f ] - } call-with - { -1.0 -1.0 } { 1.0 1.0 } rect-vertices - ] with-gl-program ; + bunny-outlined-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 ; M: bunny-outlined draw-bunny dup remake-framebuffer-if-needed @@ -227,9 +235,5 @@ M: bunny-outlined dispose { [ bunny-outlined-pass1-program [ delete-gl-program ] when* ] [ bunny-outlined-pass2-program [ delete-gl-program ] when* ] - [ bunny-outlined-framebuffer [ delete-framebuffer ] when* ] - [ bunny-outlined-color-texture [ delete-texture ] when* ] - [ bunny-outlined-normal-texture [ delete-texture ] when* ] - [ bunny-outlined-depth-texture [ delete-texture ] when* ] - [ f swap set-bunny-outlined-framebuffer-dim ] + [ dispose-framebuffer ] } call-with ; diff --git a/extra/opengl/opengl-docs.factor b/extra/opengl/opengl-docs.factor index 63875e91a8..cb0c9e884f 100644 --- a/extra/opengl/opengl-docs.factor +++ b/extra/opengl/opengl-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax io kernel math quotations -opengl.gl ; +opengl.gl multiline assocs ; IN: opengl HELP: gl-color @@ -241,8 +241,19 @@ 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" } { "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" } "." } ; +{ $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 for the associated quotation.\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 ; +"> } ; HELP: gl-version { $values { "version" "The version string from the OpenGL implementation" } } @@ -284,15 +295,19 @@ HELP: has-gl-extensions? { $values { "extensions" "A sequence of extension name strings" } { "?" "A boolean value" } } { $description "Returns true if the set of " { $snippet "extensions" } " is a subset of the implementation-supported extensions returned by " { $link gl-extensions } "." } ; +HELP: has-gl-version-or-extensions? +{ $values { "version" "A version string" } { "extensions" "A sequence of extension name strings" } } +{ $description "Returns true if either " { $link has-gl-version? } " or " { $link has-gl-extensions? } " returns true for " { $snippet "version" } " or " { $snippet "extensions" } ", respectively. Intended for use when required OpenGL functionality can be verified either by a minimum version or a set of equivalent extensions." } ; + HELP: require-gl-extensions { $values { "extensions" "A sequence of extension name strings" } } { $description "Throws an exception if " { $link has-gl-extensions? } " returns false for " { $snippet "extensions" } "." } ; HELP: require-gl-version-or-extensions { $values { "version" "A version string" } { "extensions" "A sequence of extension name strings" } } -{ $description "Throws an exception if neither " { $link has-gl-version? } " nor " { $link has-gl-extensions? } " returns true for " { $snippet "version" } " or " { $snippet "extensions" } ", respectively. Intended for use when required OpenGL functionality can be verified either by a minimum version, or a set of equivalent extensions." } ; +{ $description "Throws an exception if neither " { $link has-gl-version? } " nor " { $link has-gl-extensions? } " returns true for " { $snippet "version" } " or " { $snippet "extensions" } ", respectively. Intended for use when required OpenGL functionality can be verified either by a minimum version or a set of equivalent extensions." } ; -{ require-gl-version require-glsl-version require-gl-extensions require-gl-version-or-extensions has-gl-version? has-glsl-version? has-gl-extensions? gl-version glsl-version gl-extensions } related-words +{ require-gl-version require-glsl-version require-gl-extensions require-gl-version-or-extensions has-gl-version? has-glsl-version? has-gl-extensions? has-gl-version-or-extensions? gl-version glsl-version gl-extensions } related-words ARTICLE: "gl-utilities" "OpenGL utility words" "In addition to the full OpenGL API, the " { $vocab-link "opengl" } " vocabulary includes some utility words to give OpenGL a more Factor-like feel." diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index d26c2c7685..071f85fe12 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -5,7 +5,7 @@ USING: alien alien.c-types continuations kernel libc math macros namespaces math.vectors math.constants math.functions math.parser opengl.gl opengl.glu combinators arrays sequences -splitting words byte-arrays assocs ; +splitting words byte-arrays assocs combinators.lib ; IN: opengl : coordinates [ first2 ] 2apply ; @@ -382,9 +382,23 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; 2dup detach-gl-program-shader delete-gl-shader ] each delete-gl-program-only ; -: with-gl-program ( program quot -- ) +: (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) , \ call-with , % ] + [ ] make , + \ (with-gl-program) , + ] [ ] make ; + +MACRO: with-gl-program ( uniforms quot -- ) + (make-with-gl-program) ; + PREDICATE: integer gl-program (gl-program?) ; : ( vertex-shader-source fragment-shader-source -- program )