Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
19b5d4f958
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1 +1,2 @@
|
|||
Slava Pestov
|
||||
Joe Groff
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1 +1,2 @@
|
|||
demos
|
||||
opengl
|
||||
|
|
|
|||
|
|
@ -1,2 +1,3 @@
|
|||
Slava Pestov
|
||||
Eduardo Cavazos
|
||||
Joe Groff
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -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"
|
||||
|
|
@ -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) ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Testing for OpenGL versions and extensions
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
opengl
|
||||
bindings
|
||||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -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"
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Rendering to offscreen textures using the GL_EXT_framebuffer_object extension
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
opengl
|
||||
bindings
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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) ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -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"
|
||||
|
|
@ -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 ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
OpenGL Shading Language (GLSL) support
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
opengl
|
||||
glsl
|
||||
bindings
|
||||
|
|
@ -80,6 +80,7 @@ IN: tools.deploy.backend
|
|||
] { } make ;
|
||||
|
||||
: make-deploy-image ( vm image vocab config -- )
|
||||
make-boot-image
|
||||
dup staging-image-name exists? [
|
||||
>r pick r> tuck make-staging-image
|
||||
] unless
|
||||
|
|
|
|||
Loading…
Reference in New Issue