Merge git://pgdn.org/factor

core/alien/c-types/c-types.factor

@@ -214,6 +214,9 @@ M: long-long-type box-return ( type -- )
     over [ <c-object> tuck 0 ] over c-setter append swap
     >r >r constructor-word r> r> add* define-inline ;
 
+: c-bool> ( int -- ? )
+    zero? not ;
+
 : >c-array ( seq type word -- )
     >r >r dup length dup r> <c-array> dup -roll r>
     [ execute ] 2curry 2each ; inline

extra/bunny/authors.txt

@@ -1 +1,2 @@
 Slava Pestov
+Joe Groff

extra/bunny/bunny.factor

@@ -52,7 +52,7 @@ M: bunny-gadget draw-gadget* ( gadget -- )
     GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
     dup demo-gadget-set-matrices
     GL_MODELVIEW glMatrixMode
-    0.0 -0.12 0.0 glTranslatef
+    0.02 -0.105 0.0 glTranslatef
     { bunny-gadget-geom bunny-gadget-draw } get-slots
     draw-bunny ;
 

extra/bunny/cel-shaded/cel-shaded.factor

@@ -1,5 +1,6 @@
 USING: arrays bunny.model combinators.lib continuations
-kernel multiline opengl opengl.gl sequences ;
+kernel multiline opengl opengl.shaders opengl.capabilities
+opengl.gl sequences ;
 IN: bunny.cel-shaded
 
 STRING: vertex-shader-source

extra/bunny/model/model.factor

@@ -1,6 +1,7 @@
 USING: alien alien.c-types arrays sequences math
 math.vectors math.matrices math.parser io io.files kernel opengl
-opengl.gl opengl.glu shuffle http.client vectors splitting
+opengl.gl opengl.glu opengl.capabilities shuffle http.client
+vectors splitting
 tools.time system combinators combinators.lib combinators.cleave
 float-arrays continuations namespaces ;
 IN: bunny.model
@@ -91,7 +92,7 @@ M: bunny-buffers bunny-geom
         bunny-buffers-array
         bunny-buffers-element-array
     } get-slots [
-        GL_VERTEX_ARRAY GL_NORMAL_ARRAY 2array [
+        { GL_VERTEX_ARRAY GL_NORMAL_ARRAY } [
             GL_DOUBLE 0 0 buffer-offset glNormalPointer
             dup bunny-buffers-nv "double" heap-size * buffer-offset
             3 GL_DOUBLE 0 roll glVertexPointer

extra/bunny/outlined/outlined.factor

@@ -1,6 +1,7 @@
 USING: arrays bunny.model bunny.cel-shaded
 combinators.lib continuations kernel math multiline
-opengl opengl.gl sequences ui.gadgets ;
+opengl opengl.shaders opengl.framebuffers opengl.gl
+opengl.capabilities sequences ui.gadgets ;
 IN: bunny.outlined
 
 STRING: outlined-pass1-fragment-shader-main-source

extra/bunny/tags.txt

@@ -1 +1,2 @@
 demos
+opengl

extra/opengl/authors.txt

@@ -1,2 +1,3 @@
 Slava Pestov
 Eduardo Cavazos
+Joe Groff

extra/opengl/capabilities/authors.txt

@@ -0,0 +1 @@
+Joe Groff

extra/opengl/capabilities/capabilities-docs.factor

@@ -0,0 +1,59 @@
+USING: help.markup help.syntax io kernel math quotations
+opengl.gl multiline assocs ;
+IN: opengl.capabilities
+
+HELP: gl-version
+{ $values { "version" "The version string from the OpenGL implementation" } }
+{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ;
+
+HELP: gl-vendor-version
+{ $values { "version" "The vendor-specific version information from the OpenGL implementation" } }
+{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ;
+
+HELP: has-gl-version?
+{ $values { "version" "A version string" } { "?" "A boolean value" } }
+{ $description "Compares the version string returned by " { $link gl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ;
+
+HELP: require-gl-version
+{ $values { "version" "A version string" } }
+{ $description "Throws an exception if " { $link has-gl-version? } " returns false for " { $snippet "version" } "." } ;
+
+HELP: glsl-version
+{ $values { "version" "The GLSL version string from the OpenGL implementation" } }
+{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ;
+
+HELP: glsl-vendor-version
+{ $values { "version" "The vendor-specific GLSL version information from the OpenGL implementation" } }
+{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ;
+
+HELP: has-glsl-version?
+{ $values { "version" "A version string" } { "?" "A boolean value" } }
+{ $description "Compares the version string returned by " { $link glsl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ;
+
+HELP: require-glsl-version
+{ $values { "version" "A version string" } }
+{ $description "Throws an exception if " { $link has-glsl-version? } " returns false for " { $snippet "version" } "." } ;
+
+HELP: gl-extensions
+{ $values { "seq" "A sequence of strings naming the implementation-supported OpenGL extensions" } }
+{ $description "Wrapper for " { $snippet "GL_EXTENSIONS glGetString" } " that returns a sequence of extension names supported by the OpenGL implementation." } ;
+
+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." } ;
+
+{ 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
+
+ABOUT: "gl-utilities"

extra/opengl/capabilities/capabilities.factor

@@ -0,0 +1,67 @@
+! Copyright (C) 2008 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces sequences splitting opengl.gl
+continuations math.parser math arrays ;
+IN: opengl.capabilities
+
+: (require-gl) ( thing require-quot make-error-quot -- )
+    >r dupd call
+    [ r> 2drop ]
+    [ r> " " make throw ]
+    if ; inline
+
+: gl-extensions ( -- seq )
+    GL_EXTENSIONS glGetString " " split ;
+: has-gl-extensions? ( extensions -- ? )
+    gl-extensions swap [ over member? ] all? nip ;
+: (make-gl-extensions-error) ( required-extensions -- )
+    gl-extensions swap seq-diff
+    "Required OpenGL extensions not supported:\n" %
+    [ "    " % % "\n" % ] each ;
+: require-gl-extensions ( extensions -- )
+    [ has-gl-extensions? ]
+    [ (make-gl-extensions-error) ]
+    (require-gl) ;
+
+: version-seq ( version-string -- version-seq )
+    "." split [ string>number ] map ;
+
+: version<=> ( version1 version2 -- n )
+    swap version-seq swap version-seq <=> ;
+
+: (gl-version) ( -- version vendor )
+    GL_VERSION glGetString " " split1 ;
+: gl-version ( -- version )
+    (gl-version) drop ;
+: gl-vendor-version ( -- version )
+    (gl-version) nip ;
+: has-gl-version? ( version -- ? )
+    gl-version version<=> 0 <= ;
+: (make-gl-version-error) ( required-version -- )
+    "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ;
+: require-gl-version ( version -- )
+    [ has-gl-version? ]
+    [ (make-gl-version-error) ]
+    (require-gl) ;
+
+: (glsl-version) ( -- version vendor )
+    GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ;
+: glsl-version ( -- version )
+    (glsl-version) drop ;
+: glsl-vendor-version ( -- version )
+    (glsl-version) nip ;
+: has-glsl-version? ( version -- ? )
+    glsl-version version<=> 0 <= ;
+: require-glsl-version ( version -- )
+    [ has-glsl-version? ]
+    [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ]
+    (require-gl) ;
+
+: has-gl-version-or-extensions? ( version extensions -- ? )
+    has-gl-extensions? swap has-gl-version? or ;
+
+: require-gl-version-or-extensions ( version extensions -- )
+    2array [ first2 has-gl-version-or-extensions? ] [
+        dup first (make-gl-version-error) "\n" %
+        second (make-gl-extensions-error) "\n" %
+    ] (require-gl) ;

extra/opengl/capabilities/summary.txt

@@ -0,0 +1 @@
+Testing for OpenGL versions and extensions

extra/opengl/capabilities/tags.txt

@@ -0,0 +1,2 @@
+opengl
+bindings

extra/opengl/framebuffers/authors.txt

@@ -0,0 +1 @@
+Joe Groff

extra/opengl/framebuffers/framebuffer-docs.factor

@@ -0,0 +1,35 @@
+USING: help.markup help.syntax io kernel math quotations
+opengl.gl multiline assocs ;
+IN: opengl.framebuffers
+
+HELP: gen-framebuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glGenFramebuffersEXT } " to handle the common case of generating a single framebuffer ID." } ;
+
+HELP: gen-renderbuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glGenRenderbuffersEXT } " to handle the common case of generating a single render buffer ID." } ;
+
+HELP: delete-framebuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glDeleteFramebuffersEXT } " to handle the common case of deleting a single framebuffer ID." } ;
+
+HELP: delete-renderbuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glDeleteRenderbuffersEXT } " to handle the common case of deleting a single render buffer ID." } ;
+
+{ gen-framebuffer delete-framebuffer } related-words
+{ gen-renderbuffer delete-renderbuffer } related-words
+
+HELP: framebuffer-incomplete?
+{ $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } }
+{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ;
+
+HELP: check-framebuffer
+{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ;
+
+HELP: with-framebuffer
+{ $values { "id" "The id of a framebuffer object." } { "quot" "a quotation" } }
+{ $description "Binds framebuffer " { $snippet "id" } " in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
+
+ABOUT: "gl-utilities"

extra/opengl/framebuffers/framebuffers.factor

@@ -0,0 +1,43 @@
+! Copyright (C) 2008 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: opengl opengl.gl combinators continuations kernel
+alien.c-types ;
+IN: opengl.framebuffers
+
+: gen-framebuffer ( -- id )
+    [ glGenFramebuffersEXT ] (gen-gl-object) ;
+: gen-renderbuffer ( -- id )
+    [ glGenRenderbuffersEXT ] (gen-gl-object) ;
+
+: delete-framebuffer ( id -- )
+    [ glDeleteFramebuffersEXT ] (delete-gl-object) ;
+: delete-renderbuffer ( id -- )
+    [ glDeleteRenderbuffersEXT ] (delete-gl-object) ;
+
+: framebuffer-incomplete? ( -- status/f )
+    GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT
+    dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ;
+
+: framebuffer-error ( status -- * )
+    { 
+        { GL_FRAMEBUFFER_COMPLETE_EXT [ "framebuffer complete" ] }
+        { GL_FRAMEBUFFER_UNSUPPORTED_EXT [ "framebuffer configuration unsupported" ] }
+        { GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT [ "framebuffer incomplete (incomplete attachment)" ] }
+        { GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT [ "framebuffer incomplete (missing attachment)" ] }
+        { GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT [ "framebuffer incomplete (dimension mismatch)" ] }
+        { GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT [ "framebuffer incomplete (format mismatch)" ] }
+        { GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT [ "framebuffer incomplete (draw buffer(s) have no attachment)" ] }
+        { GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT [ "framebuffer incomplete (read buffer has no attachment)" ] }
+        [ drop gl-error "unknown framebuffer error" ]
+    } case throw ;
+
+: check-framebuffer ( -- )
+    framebuffer-incomplete? [ framebuffer-error ] when* ;
+
+: with-framebuffer ( id quot -- )
+    GL_FRAMEBUFFER_EXT rot glBindFramebufferEXT
+    [ GL_FRAMEBUFFER_EXT 0 glBindFramebufferEXT ] [ ] cleanup ; inline
+
+: framebuffer-attachment ( attachment -- id )
+    GL_FRAMEBUFFER_EXT swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT
+    0 <uint> [ glGetFramebufferAttachmentParameterivEXT ] keep *uint ;

extra/opengl/framebuffers/summary.txt

@@ -0,0 +1 @@
+Rendering to offscreen textures using the GL_EXT_framebuffer_object extension

extra/opengl/framebuffers/tags.txt

@@ -0,0 +1,2 @@
+opengl
+bindings

extra/opengl/opengl-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io kernel math quotations
-opengl.gl multiline assocs ;
+opengl.gl multiline assocs vocabs.loader sequences ;
 IN: opengl
 
 HELP: gl-color
@@ -57,14 +57,6 @@ HELP: gen-texture
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glGenTextures } " to handle the common case of generating a single texture ID." } ;
 
-HELP: gen-framebuffer
-{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glGenFramebuffersEXT } " to handle the common case of generating a single framebuffer ID." } ;
-
-HELP: gen-renderbuffer
-{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glGenRenderbuffersEXT } " to handle the common case of generating a single render buffer ID." } ;
-
 HELP: gen-gl-buffer
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glGenBuffers } " to handle the common case of generating a single buffer ID." } ;
@@ -73,34 +65,13 @@ HELP: delete-texture
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glDeleteTextures } " to handle the common case of deleting a single texture ID." } ;
 
-HELP: delete-framebuffer
-{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glDeleteFramebuffersEXT } " to handle the common case of deleting a single framebuffer ID." } ;
-
-HELP: delete-renderbuffer
-{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glDeleteRenderbuffersEXT } " to handle the common case of deleting a single render buffer ID." } ;
-
 HELP: delete-gl-buffer
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glDeleteBuffers } " to handle the common case of deleting a single buffer ID." } ;
 
 { gen-texture delete-texture } related-words
-{ gen-framebuffer delete-framebuffer } related-words
-{ gen-renderbuffer delete-renderbuffer } related-words
 { gen-gl-buffer delete-gl-buffer } related-words
 
-HELP: framebuffer-incomplete?
-{ $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } }
-{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ;
-
-HELP: check-framebuffer
-{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ;
-
-HELP: with-framebuffer
-{ $values { "id" "The id of a framebuffer object." } { "quot" "a quotation" } }
-{ $description "Binds framebuffer " { $snippet "id" } " in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
-
 HELP: bind-texture-unit
 { $values { "id" "The id of a texture object." } { "target" "The texture target (e.g., " { $snippet "GL_TEXTURE_2D" } ")" } { "unit" "The texture unit to bind (e.g., " { $snippet "GL_TEXTURE0" } ")" } }
 { $description "Binds texture " { $snippet "id" } " to texture target " { $snippet "target" } " of texture unit " { $snippet "unit" } ". Equivalent to " { $snippet "unit glActiveTexture target id glBindTexture" } "." } ;
@@ -148,175 +119,9 @@ HELP: with-translation
 { $values { "loc" "a pair of integers" } { "quot" quotation } }
 { $description "Calls the quotation with a translation by " { $snippet "loc" } " pixels applied to the current " { $link GL_MODELVIEW } " matrix, restoring the matrix when the quotation is done." } ;
 
-HELP: gl-shader
-{ $class-description { $snippet "gl-shader" } " is a predicate class comprising values returned by OpenGL to represent shader objects. The following words are provided for creating and manipulating these objects:"
-    { $list
-        { { $link <gl-shader> } " - Compile GLSL code into a shader object" }
-        { { $link gl-shader-ok? } " - Check whether a shader object compiled successfully" }
-        { { $link check-gl-shader } " - Throw an error unless a shader object compiled successfully" }
-        { { $link gl-shader-info-log } " - Retrieve the info log of messages generated by the GLSL compiler" }
-        { { $link delete-gl-shader } " - Invalidate a shader object" }
-    }
-  "The derived predicate classes " { $link vertex-shader } " and " { $link fragment-shader } " are also defined for the two standard kinds of shader defined by the OpenGL specification." } ;
-
-HELP: vertex-shader
-{ $class-description { $snippet "vertex-shader" } " is the predicate class of " { $link gl-shader } " objects that refer to shaders of type " { $snippet "GL_VERTEX_SHADER" } ". In addition to the " { $snippet "gl-shader" } " words, the following vertex shader-specific functions are defined:"
-    { $list
-        { { $link <vertex-shader> } " - Compile GLSL code into a vertex shader object "}
-    }
-} ;
-
-HELP: fragment-shader
-{ $class-description { $snippet "fragment-shader" } " is the predicate class of " { $link gl-shader } " objects that refer to shaders of type " { $snippet "GL_FRAGMENT_SHADER" } ". In addition to the " { $snippet "gl-shader" } " words, the following fragment shader-specific functions are defined:"
-    { $list
-        { { $link <fragment-shader> } " - Compile GLSL code into a fragment shader object "}
-    }
-} ;
-
-HELP: <gl-shader>
-{ $values { "source" "The GLSL source code to compile" } { "kind" "The kind of shader to compile, such as " { $snippet "GL_VERTEX_SHADER" } " or " { $snippet "GL_FRAGMENT_SHADER" } } }
-{ $description "Tries to compile the given GLSL source into a shader object. The returned object can be checked for validity by " { $link check-gl-shader } " or " { $link gl-shader-ok? } ". Errors and warnings generated by the GLSL compiler will be collected in the info log, available from " { $link gl-shader-info-log } ".\n\nWhen the shader object is no longer needed, it should be deleted using " { $link delete-gl-shader } " or else be attached to a " { $link gl-program } " object deleted using " { $link delete-gl-program } "." } ;
-
-HELP: <vertex-shader>
-{ $values { "source" "The GLSL source code to compile" } }
-{ $description "Tries to compile the given GLSL source into a vertex shader object. Equivalent to " { $snippet "GL_VERTEX_SHADER <gl-shader>" } "." } ;
-
-HELP: <fragment-shader>
-{ $values { "source" "The GLSL source code to compile" } }
-{ $description "Tries to compile the given GLSL source into a fragment shader object. Equivalent to " { $snippet "GL_FRAGMENT_SHADER <gl-shader>" } "." } ;
-
-HELP: gl-shader-ok?
-{ $values { "shader" "A " { $link gl-shader } " object" } }
-{ $description "Returns a boolean value indicating whether the given shader object compiled successfully. Compilation errors and warnings are available in the shader's info log, which can be gotten using " { $link gl-shader-info-log } "." } ;
-
-HELP: check-gl-shader
-{ $values { "shader" "A " { $link gl-shader } " object" } }
-{ $description "Throws an error containing the " { $link gl-shader-info-log } " for the shader object if it failed to compile. Otherwise, the shader object is left on the stack." } ;
-
-HELP: delete-gl-shader
-{ $values { "shader" "A " { $link gl-shader } " object" } }
-{ $description "Deletes the shader object, invalidating it and releasing any resources allocated for it by the OpenGL implementation." } ;
-
-HELP: gl-shader-info-log
-{ $values { "shader" "A " { $link gl-shader } " object" } }
-{ $description "Retrieves the info log for " { $snippet "shader" } ", including any errors or warnings generated in compiling the shader object." } ;
-
-HELP: gl-program
-{ $class-description { $snippet "gl-program" } " is a predicate class comprising values returned by OpenGL to represent proram objects. The following words are provided for creating and manipulating these objects:"
-    { $list
-        { { $link <gl-program> } ", " { $link <simple-gl-program> } " - Link a set of shaders into a GLSL program" }
-        { { $link gl-program-ok? } " - Check whether a program object linked successfully" }
-        { { $link check-gl-program } " - Throw an error unless a program object linked successfully" }
-        { { $link gl-program-info-log } " - Retrieve the info log of messages generated by the GLSL linker" }
-        { { $link gl-program-shaders } " - Retrieve the set of shader objects composing the GLSL program" }
-        { { $link delete-gl-program } " - Invalidate a program object and all its attached shaders" }
-        { { $link with-gl-program } " - Use a program object" }
-    }
-} ;
-
-HELP: <gl-program>
-{ $values { "shaders" "A sequence of " { $link gl-shader } " objects." } }
-{ $description "Creates a new GLSL program object, attaches all the shader objects in the " { $snippet "shaders" } " sequence, and attempts to link them. The returned object can be checked for validity by " { $link check-gl-program } " or " { $link gl-program-ok? } ". Errors and warnings generated by the GLSL linker will be collected in the info log, available from " { $link gl-program-info-log } ".\n\nWhen the program object and its attached shaders are no longer needed, it should be deleted using " { $link delete-gl-program } "." } ;
-
-HELP: <simple-gl-program>
-{ $values { "vertex-shader-source" "A string containing GLSL vertex shader source" } { "fragment-shader-source" "A string containing GLSL fragment shader source" } }
-{ $description "Wrapper for " { $link <gl-program> } " for the simple case of compiling a single vertex shader and fragment shader and linking them into a GLSL program. Throws an exception if compiling or linking fails." } ;
-
-{ <gl-program> <simple-gl-program> } related-words
-
-HELP: gl-program-ok?
-{ $values { "program" "A " { $link gl-program } " object" } }
-{ $description "Returns a boolean value indicating whether the given program object linked successfully. Link errors and warnings are available in the program's info log, which can be gotten using " { $link gl-program-info-log } "." } ;
-
-HELP: check-gl-program
-{ $values { "program" "A " { $link gl-program } " object" } }
-{ $description "Throws an error containing the " { $link gl-program-info-log } " for the program object if it failed to link. Otherwise, the program object is left on the stack." } ;
-
-HELP: gl-program-info-log
-{ $values { "program" "A " { $link gl-program } " object" } }
-{ $description "Retrieves the info log for " { $snippet "program" } ", including any errors or warnings generated in linking the program object." } ;
-
-HELP: delete-gl-program
-{ $values { "program" "A " { $link gl-program } " object" } }
-{ $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 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" } }
-{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ;
-
-HELP: gl-vendor-version
-{ $values { "version" "The vendor-specific version information from the OpenGL implementation" } }
-{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ;
-
-HELP: has-gl-version?
-{ $values { "version" "A version string" } { "?" "A boolean value" } }
-{ $description "Compares the version string returned by " { $link gl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ;
-
-HELP: require-gl-version
-{ $values { "version" "A version string" } }
-{ $description "Throws an exception if " { $link has-gl-version? } " returns false for " { $snippet "version" } "." } ;
-
-HELP: glsl-version
-{ $values { "version" "The GLSL version string from the OpenGL implementation" } }
-{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ;
-
-HELP: glsl-vendor-version
-{ $values { "version" "The vendor-specific GLSL version information from the OpenGL implementation" } }
-{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ;
-
-HELP: has-glsl-version?
-{ $values { "version" "A version string" } { "?" "A boolean value" } }
-{ $description "Compares the version string returned by " { $link glsl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ;
-
-HELP: require-glsl-version
-{ $values { "version" "A version string" } }
-{ $description "Throws an exception if " { $link has-glsl-version? } " returns false for " { $snippet "version" } "." } ;
-
-HELP: gl-extensions
-{ $values { "seq" "A sequence of strings naming the implementation-supported OpenGL extensions" } }
-{ $description "Wrapper for " { $snippet "GL_EXTENSIONS glGetString" } " that returns a sequence of extension names supported by the OpenGL implementation." } ;
-
-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." } ;
-
-{ 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."
 $nl
-"Checking implementation capabilities:"
-{ $subsection require-gl-version }
-{ $subsection require-gl-extensions }
-{ $subsection require-glsl-version }
-{ $subsection require-gl-version-or-extensions }
 "Wrappers:"
 { $subsection gl-color }
 { $subsection gl-vertex }
@@ -329,8 +134,6 @@ $nl
 { $subsection do-attribs }
 { $subsection do-matrix }
 { $subsection with-translation }
-{ $subsection with-framebuffer }
-{ $subsection with-gl-program }
 { $subsection make-dlist }
 "Rendering geometric shapes:"
 { $subsection gl-line }
@@ -339,9 +142,6 @@ $nl
 { $subsection gl-fill-poly }
 { $subsection gl-poly }
 { $subsection gl-gradient }
-"Compiling, linking, and using GLSL programs:"
-{ $subsection gl-shader }
-{ $subsection gl-program }
 ;
 
 ABOUT: "gl-utilities"

extra/opengl/opengl.factor

@@ -33,11 +33,19 @@ IN: opengl
 : do-enabled-client-state ( what quot -- )
     over glEnableClientState dip glDisableClientState ; inline
 
-: all-enabled ( seq quot -- )
+: words>values ( word/value-seq -- value-seq )
+    [ dup word? [ execute ] [ ] if ] map ;
+
+: (all-enabled) ( seq quot -- )
     over [ glEnable ] each dip [ glDisable ] each ; inline
-: all-enabled-client-state ( seq quot -- )
+: (all-enabled-client-state) ( seq quot -- )
     over [ glEnableClientState ] each dip [ glDisableClientState ] each ; inline
 
+MACRO: all-enabled ( seq quot -- )
+    >r words>values r> [ (all-enabled) ] 2curry ;
+MACRO: all-enabled-client-state ( seq quot -- )
+    >r words>values r> [ (all-enabled-client-state) ] 2curry ;
+
 : do-matrix ( mode quot -- )
     swap [ glMatrixMode glPushMatrix call ] keep
     glMatrixMode glPopMatrix ; inline
@@ -106,10 +114,6 @@ IN: opengl
     >r 1 0 <uint> r> keep *uint ; inline
 : gen-texture ( -- id )
     [ glGenTextures ] (gen-gl-object) ;
-: gen-framebuffer ( -- id )
-    [ glGenFramebuffersEXT ] (gen-gl-object) ;
-: gen-renderbuffer ( -- id )
-    [ glGenRenderbuffersEXT ] (gen-gl-object) ;
 : gen-gl-buffer ( -- id )
     [ glGenBuffers ] (gen-gl-object) ;
 
@@ -117,10 +121,6 @@ IN: opengl
     >r 1 swap <uint> r> call ; inline
 : delete-texture ( id -- )
     [ glDeleteTextures ] (delete-gl-object) ;
-: delete-framebuffer ( id -- )
-    [ glDeleteFramebuffersEXT ] (delete-gl-object) ;
-: delete-renderbuffer ( id -- )
-    [ glDeleteRenderbuffersEXT ] (delete-gl-object) ;
 : delete-gl-buffer ( id -- )
     [ glDeleteBuffers ] (delete-gl-object) ;
 
@@ -141,40 +141,14 @@ IN: opengl
 : buffer-offset ( int -- alien )
     <alien> ; inline
 
-: framebuffer-incomplete? ( -- status/f )
-    GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT
-    dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ;
-
-: framebuffer-error ( status -- * )
-    { { GL_FRAMEBUFFER_COMPLETE_EXT [ "framebuffer complete" ] }
-      { GL_FRAMEBUFFER_UNSUPPORTED_EXT [ "framebuffer configuration unsupported" ] }
-      { GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT [ "framebuffer incomplete (incomplete attachment)" ] }
-      { GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT [ "framebuffer incomplete (missing attachment)" ] }
-      { GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT [ "framebuffer incomplete (dimension mismatch)" ] }
-      { GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT [ "framebuffer incomplete (format mismatch)" ] }
-      { GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT [ "framebuffer incomplete (draw buffer(s) have no attachment)" ] }
-      { GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT [ "framebuffer incomplete (read buffer has no attachment)" ] }
-      [ drop gl-error "unknown framebuffer error" ] } case throw ;
-
-: check-framebuffer ( -- )
-    framebuffer-incomplete? [ framebuffer-error ] when* ;
-
-: with-framebuffer ( id quot -- )
-    GL_FRAMEBUFFER_EXT rot glBindFramebufferEXT
-    [ GL_FRAMEBUFFER_EXT 0 glBindFramebufferEXT ] [ ] cleanup ; inline
-
 : bind-texture-unit ( id target unit -- )
     glActiveTexture swap glBindTexture gl-error ;
 
-: framebuffer-attachment ( attachment -- id )
-    GL_FRAMEBUFFER_EXT swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT
-    0 <uint> [ glGetFramebufferAttachmentParameterivEXT ] keep *uint ;
-    
 : (set-draw-buffers) ( buffers -- )
     dup length swap >c-uint-array glDrawBuffers ;
 
 MACRO: set-draw-buffers ( buffers -- )
-    [ dup word? [ execute ] [ ] if ] map [ (set-draw-buffers) ] curry ;
+    words>values [ (set-draw-buffers) ] curry ;
 
 : do-attribs ( bits quot -- )
     swap glPushAttrib call glPopAttrib ; inline
@@ -274,196 +248,3 @@ TUPLE: sprite loc dim dim2 dlist texture ;
     glLoadIdentity
     GL_MODELVIEW glMatrixMode
     glLoadIdentity ;
-
-! Shaders
-
-: c-true? ( int -- ? ) zero? not ; inline
-
-: with-gl-shader-source-ptr ( string quot -- )
-    swap string>char-alien malloc-byte-array [
-        <void*> swap call
-    ] keep free ; inline
-
-: <gl-shader> ( source kind -- shader )
-    glCreateShader dup rot
-    [ 1 swap f glShaderSource ] with-gl-shader-source-ptr
-    [ glCompileShader ] keep
-    gl-error ;
-
-: (gl-shader?) ( object -- ? )
-    dup integer? [ glIsShader c-true? ] [ drop f ] if ;
-
-: gl-shader-get-int ( shader enum -- value )
-    0 <int> [ glGetShaderiv ] keep *int ;
-
-: gl-shader-ok? ( shader -- ? )
-    GL_COMPILE_STATUS gl-shader-get-int c-true? ;
-
-: <vertex-shader> ( source -- vertex-shader )
-    GL_VERTEX_SHADER <gl-shader> ; inline
-
-: (vertex-shader?) ( object -- ? )
-    dup (gl-shader?)
-    [ GL_SHADER_TYPE gl-shader-get-int GL_VERTEX_SHADER = ]
-    [ drop f ] if ;
-
-: <fragment-shader> ( source -- fragment-shader )
-    GL_FRAGMENT_SHADER <gl-shader> ; inline
-
-: (fragment-shader?) ( object -- ? )
-    dup (gl-shader?)
-    [ GL_SHADER_TYPE gl-shader-get-int GL_FRAGMENT_SHADER = ]
-    [ drop f ] if ;
-
-: gl-shader-info-log-length ( shader -- log-length )
-    GL_INFO_LOG_LENGTH gl-shader-get-int ; inline
-
-: gl-shader-info-log ( shader -- log )
-    dup gl-shader-info-log-length dup [
-        [ 0 <int> swap glGetShaderInfoLog ] keep
-        alien>char-string
-    ] with-malloc ;
-
-: check-gl-shader ( shader -- shader* )
-    dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ;
-
-: delete-gl-shader ( shader -- ) glDeleteShader ; inline
-
-PREDICATE: integer gl-shader (gl-shader?) ;
-PREDICATE: gl-shader vertex-shader (vertex-shader?) ;
-PREDICATE: gl-shader fragment-shader (fragment-shader?) ;
-
-! Programs
-
-: <gl-program> ( shaders -- program )
-    glCreateProgram swap
-    [ dupd glAttachShader ] each
-    [ glLinkProgram ] keep
-    gl-error ;
-    
-: (gl-program?) ( object -- ? )
-    dup integer? [ glIsProgram c-true? ] [ drop f ] if ;
-
-: gl-program-get-int ( program enum -- value )
-    0 <int> [ glGetProgramiv ] keep *int ;
-
-: gl-program-ok? ( program -- ? )
-    GL_LINK_STATUS gl-program-get-int c-true? ;
-
-: gl-program-info-log-length ( program -- log-length )
-    GL_INFO_LOG_LENGTH gl-program-get-int ; inline
-
-: gl-program-info-log ( program -- log )
-    dup gl-program-info-log-length dup [
-        [ 0 <int> swap glGetProgramInfoLog ] keep
-        alien>char-string
-    ] with-malloc ;
-
-: check-gl-program ( program -- program* )
-    dup gl-program-ok? [ dup gl-program-info-log throw ] unless ;
-
-: gl-program-shaders-length ( program -- shaders-length )
-    GL_ATTACHED_SHADERS gl-program-get-int ; inline
-
-: gl-program-shaders ( program -- shaders )
-    dup gl-program-shaders-length [
-        dup "GLuint" <c-array>
-        [ 0 <int> swap glGetAttachedShaders ] keep
-    ] keep c-uint-array> ;
-
-: delete-gl-program-only ( program -- )
-    glDeleteProgram ; inline
-
-: detach-gl-program-shader ( program shader -- )
-    glDetachShader ; inline
-
-: delete-gl-program ( program -- )
-    dup gl-program-shaders [
-        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) , \ call-with , % ]
-        [ ] make ,
-        \ (with-gl-program) ,
-    ] [ ] make ;
-
-MACRO: with-gl-program ( uniforms quot -- )
-    (make-with-gl-program) ;
-
-PREDICATE: integer gl-program (gl-program?) ;
-
-: <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
-    >r <vertex-shader> check-gl-shader
-    r> <fragment-shader> check-gl-shader
-    2array <gl-program> check-gl-program ;
-
-: (require-gl) ( thing require-quot make-error-quot -- )
-    >r dupd call
-    [ r> 2drop ]
-    [ r> " " make throw ]
-    if ; inline
-
-: gl-extensions ( -- seq )
-    GL_EXTENSIONS glGetString " " split ;
-: has-gl-extensions? ( extensions -- ? )
-    gl-extensions swap [ over member? ] all? nip ;
-: (make-gl-extensions-error) ( required-extensions -- )
-    gl-extensions swap seq-diff
-    "Required OpenGL extensions not supported:\n" %
-    [ "    " % % "\n" % ] each ;
-: require-gl-extensions ( extensions -- )
-    [ has-gl-extensions? ]
-    [ (make-gl-extensions-error) ]
-    (require-gl) ;
-
-: version-seq ( version-string -- version-seq )
-    "." split [ string>number ] map ;
-
-: version<=> ( version1 version2 -- n )
-    swap version-seq swap version-seq <=> ;
-
-: (gl-version) ( -- version vendor )
-    GL_VERSION glGetString " " split1 ;
-: gl-version ( -- version )
-    (gl-version) drop ;
-: gl-vendor-version ( -- version )
-    (gl-version) nip ;
-: has-gl-version? ( version -- ? )
-    gl-version version<=> 0 <= ;
-: (make-gl-version-error) ( required-version -- )
-    "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ;
-: require-gl-version ( version -- )
-    [ has-gl-version? ]
-    [ (make-gl-version-error) ]
-    (require-gl) ;
-
-: (glsl-version) ( -- version vendor )
-    GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ;
-: glsl-version ( -- version )
-    (glsl-version) drop ;
-: glsl-vendor-version ( -- version )
-    (glsl-version) nip ;
-: has-glsl-version? ( version -- ? )
-    glsl-version version<=> 0 <= ;
-: require-glsl-version ( version -- )
-    [ has-glsl-version? ]
-    [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ]
-    (require-gl) ;
-
-: has-gl-version-or-extensions? ( version extensions -- ? )
-    has-gl-extensions? swap has-gl-version? or ;
-
-: require-gl-version-or-extensions ( version extensions -- )
-    2array [ first2 has-gl-version-or-extensions? ] [
-        dup first (make-gl-version-error) "\n" %
-        second (make-gl-extensions-error) "\n" %
-    ] (require-gl) ;

extra/opengl/shaders/authors.txt

@@ -0,0 +1 @@
+Joe Groff

extra/opengl/shaders/shaders-docs.factor

@@ -0,0 +1,112 @@
+USING: help.markup help.syntax io kernel math quotations
+opengl.gl multiline assocs ;
+IN: opengl.shaders
+
+HELP: gl-shader
+{ $class-description { $snippet "gl-shader" } " is a predicate class comprising values returned by OpenGL to represent shader objects. The following words are provided for creating and manipulating these objects:"
+    { $list
+        { { $link <gl-shader> } " - Compile GLSL code into a shader object" }
+        { { $link gl-shader-ok? } " - Check whether a shader object compiled successfully" }
+        { { $link check-gl-shader } " - Throw an error unless a shader object compiled successfully" }
+        { { $link gl-shader-info-log } " - Retrieve the info log of messages generated by the GLSL compiler" }
+        { { $link delete-gl-shader } " - Invalidate a shader object" }
+    }
+  "The derived predicate classes " { $link vertex-shader } " and " { $link fragment-shader } " are also defined for the two standard kinds of shader defined by the OpenGL specification." } ;
+
+HELP: vertex-shader
+{ $class-description { $snippet "vertex-shader" } " is the predicate class of " { $link gl-shader } " objects that refer to shaders of type " { $snippet "GL_VERTEX_SHADER" } ". In addition to the " { $snippet "gl-shader" } " words, the following vertex shader-specific functions are defined:"
+    { $list
+        { { $link <vertex-shader> } " - Compile GLSL code into a vertex shader object "}
+    }
+} ;
+
+HELP: fragment-shader
+{ $class-description { $snippet "fragment-shader" } " is the predicate class of " { $link gl-shader } " objects that refer to shaders of type " { $snippet "GL_FRAGMENT_SHADER" } ". In addition to the " { $snippet "gl-shader" } " words, the following fragment shader-specific functions are defined:"
+    { $list
+        { { $link <fragment-shader> } " - Compile GLSL code into a fragment shader object "}
+    }
+} ;
+
+HELP: <gl-shader>
+{ $values { "source" "The GLSL source code to compile" } { "kind" "The kind of shader to compile, such as " { $snippet "GL_VERTEX_SHADER" } " or " { $snippet "GL_FRAGMENT_SHADER" } } }
+{ $description "Tries to compile the given GLSL source into a shader object. The returned object can be checked for validity by " { $link check-gl-shader } " or " { $link gl-shader-ok? } ". Errors and warnings generated by the GLSL compiler will be collected in the info log, available from " { $link gl-shader-info-log } ".\n\nWhen the shader object is no longer needed, it should be deleted using " { $link delete-gl-shader } " or else be attached to a " { $link gl-program } " object deleted using " { $link delete-gl-program } "." } ;
+
+HELP: <vertex-shader>
+{ $values { "source" "The GLSL source code to compile" } }
+{ $description "Tries to compile the given GLSL source into a vertex shader object. Equivalent to " { $snippet "GL_VERTEX_SHADER <gl-shader>" } "." } ;
+
+HELP: <fragment-shader>
+{ $values { "source" "The GLSL source code to compile" } }
+{ $description "Tries to compile the given GLSL source into a fragment shader object. Equivalent to " { $snippet "GL_FRAGMENT_SHADER <gl-shader>" } "." } ;
+
+HELP: gl-shader-ok?
+{ $values { "shader" "A " { $link gl-shader } " object" } }
+{ $description "Returns a boolean value indicating whether the given shader object compiled successfully. Compilation errors and warnings are available in the shader's info log, which can be gotten using " { $link gl-shader-info-log } "." } ;
+
+HELP: check-gl-shader
+{ $values { "shader" "A " { $link gl-shader } " object" } }
+{ $description "Throws an error containing the " { $link gl-shader-info-log } " for the shader object if it failed to compile. Otherwise, the shader object is left on the stack." } ;
+
+HELP: delete-gl-shader
+{ $values { "shader" "A " { $link gl-shader } " object" } }
+{ $description "Deletes the shader object, invalidating it and releasing any resources allocated for it by the OpenGL implementation." } ;
+
+HELP: gl-shader-info-log
+{ $values { "shader" "A " { $link gl-shader } " object" } }
+{ $description "Retrieves the info log for " { $snippet "shader" } ", including any errors or warnings generated in compiling the shader object." } ;
+
+HELP: gl-program
+{ $class-description { $snippet "gl-program" } " is a predicate class comprising values returned by OpenGL to represent proram objects. The following words are provided for creating and manipulating these objects:"
+    { $list
+        { { $link <gl-program> } ", " { $link <simple-gl-program> } " - Link a set of shaders into a GLSL program" }
+        { { $link gl-program-ok? } " - Check whether a program object linked successfully" }
+        { { $link check-gl-program } " - Throw an error unless a program object linked successfully" }
+        { { $link gl-program-info-log } " - Retrieve the info log of messages generated by the GLSL linker" }
+        { { $link gl-program-shaders } " - Retrieve the set of shader objects composing the GLSL program" }
+        { { $link delete-gl-program } " - Invalidate a program object and all its attached shaders" }
+        { { $link with-gl-program } " - Use a program object" }
+    }
+} ;
+
+HELP: <gl-program>
+{ $values { "shaders" "A sequence of " { $link gl-shader } " objects." } }
+{ $description "Creates a new GLSL program object, attaches all the shader objects in the " { $snippet "shaders" } " sequence, and attempts to link them. The returned object can be checked for validity by " { $link check-gl-program } " or " { $link gl-program-ok? } ". Errors and warnings generated by the GLSL linker will be collected in the info log, available from " { $link gl-program-info-log } ".\n\nWhen the program object and its attached shaders are no longer needed, it should be deleted using " { $link delete-gl-program } "." } ;
+
+HELP: <simple-gl-program>
+{ $values { "vertex-shader-source" "A string containing GLSL vertex shader source" } { "fragment-shader-source" "A string containing GLSL fragment shader source" } }
+{ $description "Wrapper for " { $link <gl-program> } " for the simple case of compiling a single vertex shader and fragment shader and linking them into a GLSL program. Throws an exception if compiling or linking fails." } ;
+
+{ <gl-program> <simple-gl-program> } related-words
+
+HELP: gl-program-ok?
+{ $values { "program" "A " { $link gl-program } " object" } }
+{ $description "Returns a boolean value indicating whether the given program object linked successfully. Link errors and warnings are available in the program's info log, which can be gotten using " { $link gl-program-info-log } "." } ;
+
+HELP: check-gl-program
+{ $values { "program" "A " { $link gl-program } " object" } }
+{ $description "Throws an error containing the " { $link gl-program-info-log } " for the program object if it failed to link. Otherwise, the program object is left on the stack." } ;
+
+HELP: gl-program-info-log
+{ $values { "program" "A " { $link gl-program } " object" } }
+{ $description "Retrieves the info log for " { $snippet "program" } ", including any errors or warnings generated in linking the program object." } ;
+
+HELP: delete-gl-program
+{ $values { "program" "A " { $link gl-program } " object" } }
+{ $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 ;
+"> } ;
+
+ABOUT: "gl-utilities"

extra/opengl/shaders/shaders.factor

@@ -0,0 +1,134 @@
+! Copyright (C) 2008 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel opengl.gl alien.c-types continuations namespaces
+assocs alien libc opengl math sequences combinators.lib 
+macros arrays ;
+IN: opengl.shaders
+
+: with-gl-shader-source-ptr ( string quot -- )
+    swap string>char-alien malloc-byte-array [
+        <void*> swap call
+    ] keep free ; inline
+
+: <gl-shader> ( source kind -- shader )
+    glCreateShader dup rot
+    [ 1 swap f glShaderSource ] with-gl-shader-source-ptr
+    [ glCompileShader ] keep
+    gl-error ;
+
+: (gl-shader?) ( object -- ? )
+    dup integer? [ glIsShader c-bool> ] [ drop f ] if ;
+
+: gl-shader-get-int ( shader enum -- value )
+    0 <int> [ glGetShaderiv ] keep *int ;
+
+: gl-shader-ok? ( shader -- ? )
+    GL_COMPILE_STATUS gl-shader-get-int c-bool> ;
+
+: <vertex-shader> ( source -- vertex-shader )
+    GL_VERTEX_SHADER <gl-shader> ; inline
+
+: (vertex-shader?) ( object -- ? )
+    dup (gl-shader?)
+    [ GL_SHADER_TYPE gl-shader-get-int GL_VERTEX_SHADER = ]
+    [ drop f ] if ;
+
+: <fragment-shader> ( source -- fragment-shader )
+    GL_FRAGMENT_SHADER <gl-shader> ; inline
+
+: (fragment-shader?) ( object -- ? )
+    dup (gl-shader?)
+    [ GL_SHADER_TYPE gl-shader-get-int GL_FRAGMENT_SHADER = ]
+    [ drop f ] if ;
+
+: gl-shader-info-log-length ( shader -- log-length )
+    GL_INFO_LOG_LENGTH gl-shader-get-int ; inline
+
+: gl-shader-info-log ( shader -- log )
+    dup gl-shader-info-log-length dup [
+        [ 0 <int> swap glGetShaderInfoLog ] keep
+        alien>char-string
+    ] with-malloc ;
+
+: check-gl-shader ( shader -- shader* )
+    dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ;
+
+: delete-gl-shader ( shader -- ) glDeleteShader ; inline
+
+PREDICATE: integer gl-shader (gl-shader?) ;
+PREDICATE: gl-shader vertex-shader (vertex-shader?) ;
+PREDICATE: gl-shader fragment-shader (fragment-shader?) ;
+
+! Programs
+
+: <gl-program> ( shaders -- program )
+    glCreateProgram swap
+    [ dupd glAttachShader ] each
+    [ glLinkProgram ] keep
+    gl-error ;
+    
+: (gl-program?) ( object -- ? )
+    dup integer? [ glIsProgram c-bool> ] [ drop f ] if ;
+
+: gl-program-get-int ( program enum -- value )
+    0 <int> [ glGetProgramiv ] keep *int ;
+
+: gl-program-ok? ( program -- ? )
+    GL_LINK_STATUS gl-program-get-int c-bool> ;
+
+: gl-program-info-log-length ( program -- log-length )
+    GL_INFO_LOG_LENGTH gl-program-get-int ; inline
+
+: gl-program-info-log ( program -- log )
+    dup gl-program-info-log-length dup [
+        [ 0 <int> swap glGetProgramInfoLog ] keep
+        alien>char-string
+    ] with-malloc ;
+
+: check-gl-program ( program -- program* )
+    dup gl-program-ok? [ dup gl-program-info-log throw ] unless ;
+
+: gl-program-shaders-length ( program -- shaders-length )
+    GL_ATTACHED_SHADERS gl-program-get-int ; inline
+
+: gl-program-shaders ( program -- shaders )
+    dup gl-program-shaders-length [
+        dup "GLuint" <c-array>
+        [ 0 <int> swap glGetAttachedShaders ] keep
+    ] keep c-uint-array> ;
+
+: delete-gl-program-only ( program -- )
+    glDeleteProgram ; inline
+
+: detach-gl-program-shader ( program shader -- )
+    glDetachShader ; inline
+
+: delete-gl-program ( program -- )
+    dup gl-program-shaders [
+        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) , \ call-with , % ]
+        [ ] make ,
+        \ (with-gl-program) ,
+    ] [ ] make ;
+
+MACRO: with-gl-program ( uniforms quot -- )
+    (make-with-gl-program) ;
+
+PREDICATE: integer gl-program (gl-program?) ;
+
+: <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
+    >r <vertex-shader> check-gl-shader
+    r> <fragment-shader> check-gl-shader
+    2array <gl-program> check-gl-program ;
+

extra/opengl/shaders/summary.txt

@@ -0,0 +1 @@
+OpenGL Shading Language (GLSL) support

extra/opengl/shaders/tags.txt

@@ -0,0 +1,3 @@
+opengl
+glsl
+bindings