--- /dev/null
+Joe Groff
\ No newline at end of file
--- /dev/null
+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" } { "?" "a boolean" } }
+{ $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"
--- /dev/null
+! Copyright (C) 2008 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces make sequences splitting opengl.gl
+continuations math.parser math arrays sets math.order ;
+IN: opengl.capabilities
+
+: (require-gl) ( thing require-quot make-error-quot -- )
+ -rot dupd call
+ [ 2drop ]
+ [ swap " " 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 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-before? ( version1 version2 -- ? )
+ swap version-seq swap version-seq before=? ;
+
+: (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-before? ;
+: (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-before? ;
+: 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) ;
--- /dev/null
+Testing for OpenGL versions and extensions
\ No newline at end of file
--- /dev/null
+opengl
+bindings
--- /dev/null
+Joe Groff
\ No newline at end of file
--- /dev/null
+USING: arrays kernel math math.functions math.order math.vectors
+namespaces opengl opengl.gl sequences ui ui.gadgets ui.gestures
+ui.render accessors combinators ;
+IN: opengl.demo-support
+
+: FOV 2.0 sqrt 1+ ; inline
+: MOUSE-MOTION-SCALE 0.5 ; inline
+: KEY-ROTATE-STEP 1.0 ; inline
+
+SYMBOL: last-drag-loc
+
+TUPLE: demo-gadget < gadget yaw pitch distance ;
+
+: new-demo-gadget ( yaw pitch distance class -- gadget )
+ new-gadget
+ swap >>distance
+ swap >>pitch
+ swap >>yaw ;
+
+GENERIC: far-plane ( gadget -- z )
+GENERIC: near-plane ( gadget -- z )
+GENERIC: distance-step ( gadget -- dz )
+
+M: demo-gadget far-plane ( gadget -- z )
+ drop 4.0 ;
+M: demo-gadget near-plane ( gadget -- z )
+ drop 1.0 64.0 / ;
+M: demo-gadget distance-step ( gadget -- dz )
+ drop 1.0 64.0 / ;
+
+: fov-ratio ( gadget -- fov ) dim>> dup first2 min v/n ;
+
+: yaw-demo-gadget ( yaw gadget -- )
+ [ + ] with change-yaw relayout-1 ;
+
+: pitch-demo-gadget ( pitch gadget -- )
+ [ + ] with change-pitch relayout-1 ;
+
+: zoom-demo-gadget ( distance gadget -- )
+ [ + ] with change-distance relayout-1 ;
+
+M: demo-gadget pref-dim* ( gadget -- dim )
+ drop { 640 480 } ;
+
+: -+ ( x -- -x x )
+ [ neg ] keep ;
+
+: demo-gadget-frustum ( gadget -- -x x -y y near far )
+ [ near-plane ] [ far-plane ] [ fov-ratio ] tri [
+ nip swap FOV / v*n
+ first2 [ -+ ] bi@
+ ] 3keep drop ;
+
+: demo-gadget-set-matrices ( gadget -- )
+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+ [
+ GL_PROJECTION glMatrixMode
+ glLoadIdentity
+ demo-gadget-frustum glFrustum
+ ] [
+ GL_MODELVIEW glMatrixMode
+ glLoadIdentity
+ [ >r 0.0 0.0 r> distance>> neg glTranslatef ]
+ [ pitch>> 1.0 0.0 0.0 glRotatef ]
+ [ yaw>> 0.0 1.0 0.0 glRotatef ]
+ tri
+ ] bi ;
+
+: reset-last-drag-rel ( -- )
+ { 0 0 } last-drag-loc set-global ;
+: last-drag-rel ( -- rel )
+ drag-loc [ last-drag-loc get v- ] keep last-drag-loc set-global ;
+
+: drag-yaw-pitch ( -- yaw pitch )
+ last-drag-rel MOUSE-MOTION-SCALE v*n first2 ;
+
+: gl-vertex ( point -- )
+ dup length {
+ { 2 [ first2 glVertex2d ] }
+ { 3 [ first3 glVertex3d ] }
+ { 4 [ first4 glVertex4d ] }
+ } case ;
+
+: gl-normal ( normal -- ) first3 glNormal3d ;
+
+: do-state ( mode quot -- )
+ swap glBegin call glEnd ; inline
+
+: rect-vertices ( lower-left upper-right -- )
+ GL_QUADS [
+ over first2 glVertex2d
+ dup first pick second glVertex2d
+ dup first2 glVertex2d
+ swap first swap second glVertex2d
+ ] do-state ;
+
+demo-gadget H{
+ { T{ key-down f f "LEFT" } [ KEY-ROTATE-STEP neg swap yaw-demo-gadget ] }
+ { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP swap yaw-demo-gadget ] }
+ { T{ key-down f f "DOWN" } [ KEY-ROTATE-STEP neg swap pitch-demo-gadget ] }
+ { T{ key-down f f "UP" } [ KEY-ROTATE-STEP swap pitch-demo-gadget ] }
+ { T{ key-down f f "=" } [ dup distance-step neg swap zoom-demo-gadget ] }
+ { T{ key-down f f "-" } [ dup distance-step swap zoom-demo-gadget ] }
+
+ { T{ button-down f f 1 } [ drop reset-last-drag-rel ] }
+ { T{ drag f 1 } [ drag-yaw-pitch rot [ pitch-demo-gadget ] keep yaw-demo-gadget ] }
+ { T{ mouse-scroll } [ scroll-direction get second over distance-step * swap zoom-demo-gadget ] }
+} set-gestures
+
--- /dev/null
+Common support for OpenGL demos
\ No newline at end of file
--- /dev/null
+Joe Groff
\ No newline at end of file
--- /dev/null
+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"
\ No newline at end of file
--- /dev/null
+! 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 ;
--- /dev/null
+Rendering to offscreen textures using the GL_EXT_framebuffer_object extension
\ No newline at end of file
--- /dev/null
+opengl
+bindings
--- /dev/null
+IN: opengl.gadgets.tests
+USING: tools.test opengl.gadgets ;
+
+\ render* must-infer
--- /dev/null
+! Copyright (C) 2008 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: locals math.functions math namespaces
+opengl.gl opengl.demo-support accessors kernel opengl ui.gadgets
+fry assocs
+destructors sequences ui.render colors ;
+IN: opengl.gadgets
+
+TUPLE: texture-gadget < gadget ;
+
+GENERIC: render* ( gadget -- texture dims )
+GENERIC: cache-key* ( gadget -- key )
+
+M: texture-gadget cache-key* ;
+
+SYMBOL: textures
+SYMBOL: refcounts
+
+: init-cache ( symbol -- )
+ dup get [ drop ] [ H{ } clone swap set-global ] if ;
+
+textures init-cache
+refcounts init-cache
+
+: refcount-change ( gadget quot -- )
+ >r cache-key* refcounts get
+ [ [ 0 ] unless* ] r> compose change-at ;
+
+TUPLE: cache-entry tex dims ;
+C: <entry> cache-entry
+
+: make-entry ( gadget -- entry )
+ dup render* <entry>
+ [ swap cache-key* textures get set-at ] keep ;
+
+: get-entry ( gadget -- {texture,dims} )
+ dup cache-key* textures get at
+ [ nip ] [ make-entry ] if* ;
+
+: get-dims ( gadget -- dims )
+ get-entry dims>> ;
+
+: get-texture ( gadget -- texture )
+ get-entry tex>> ;
+
+: release-texture ( gadget -- )
+ cache-key* textures get delete-at*
+ [ tex>> delete-texture ] [ drop ] if ;
+
+: clear-textures ( -- )
+ textures get values [ tex>> delete-texture ] each
+ H{ } clone textures set-global
+ H{ } clone refcounts set-global ;
+
+M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
+
+M: texture-gadget ungraft* ( gadget -- )
+ dup [ 1- ] refcount-change
+ dup cache-key* refcounts get at
+ zero? [ release-texture ] [ drop ] if ;
+
+: 2^-ceil ( x -- y )
+ dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
+
+: 2^-bounds ( dim -- dim' )
+ [ 2^-ceil ] map ; foldable flushable
+
+:: (render-bytes) ( dims bytes format texture -- )
+ GL_ENABLE_BIT [
+ GL_TEXTURE_2D glEnable
+ GL_TEXTURE_2D texture glBindTexture
+ GL_TEXTURE_2D
+ 0
+ GL_RGBA
+ dims 2^-bounds first2
+ 0
+ format
+ GL_UNSIGNED_BYTE
+ bytes
+ glTexImage2D
+ init-texture
+ GL_TEXTURE_2D 0 glBindTexture
+ ] do-attribs ;
+
+: render-bytes ( dims bytes format -- texture )
+ gen-texture [ (render-bytes) ] keep ;
+
+: render-bytes* ( dims bytes format -- texture dims )
+ pick >r render-bytes r> ;
+
+:: four-corners ( dim -- )
+ [let* | w [ dim first ]
+ h [ dim second ]
+ dim' [ dim dup 2^-bounds [ /f ] 2map ]
+ w' [ dim' first ]
+ h' [ dim' second ] |
+ 0 0 glTexCoord2d 0 0 glVertex2d
+ 0 h' glTexCoord2d 0 h glVertex2d
+ w' h' glTexCoord2d w h glVertex2d
+ w' 0 glTexCoord2d w 0 glVertex2d
+ ] ;
+
+M: texture-gadget draw-gadget* ( gadget -- )
+ origin get [
+ GL_ENABLE_BIT [
+ white gl-color
+ 1.0 -1.0 glPixelZoom
+ GL_TEXTURE_2D glEnable
+ GL_TEXTURE_2D over get-texture glBindTexture
+ GL_QUADS [
+ get-dims four-corners
+ ] do-state
+ GL_TEXTURE_2D 0 glBindTexture
+ ] do-attribs
+ ] with-translation ;
+
+M: texture-gadget pref-dim* ( gadget -- dim ) get-dims ;
--- /dev/null
+Joe Groff
\ No newline at end of file
--- /dev/null
+USING: help.markup help.syntax io kernel math quotations
+opengl.gl multiline assocs strings ;
+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" } } { "shader" "a new " { $link gl-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" } { "vertex-shader" "a new " { $link vertex-shader } } }
+{ $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" } { "fragment-shader" "a new " { $link fragment-shader } } }
+{ $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" } { "?" "a boolean" } }
+{ $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" } { "shader" "a new " { $link gl-shader } } { "log" string } }
+{ $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." } { "program" "a new " { $link gl-program } } }
+{ $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" } { "program" "a new " { $link gl-program } } }
+{ $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" } { "?" "a boolean" } }
+{ $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" } { "log" string } }
+{ $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" } { "quot" "A quotation with stack effect " { $snippet "( program -- )" } } }
+{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in the dynamic extent of " { $snippet "quot" } ". " { $snippet "program" } " is left on the top of the stack when " { $snippet "quot" } " is called. The fixed-function pipeline is restored at the end of " { $snippet "quot" } "." } ;
+
+ABOUT: "gl-utilities"
--- /dev/null
+! 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 alien.strings libc opengl math sequences combinators
+combinators.lib macros arrays io.encodings.ascii fry ;
+IN: opengl.shaders
+
+: with-gl-shader-source-ptr ( string quot -- )
+ swap ascii malloc-string [ <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 [
+ 1 calloc &free
+ [ 0 <int> swap glGetShaderInfoLog ] keep
+ ascii alien>string
+ ] with-destructors ;
+
+: check-gl-shader ( shader -- shader )
+ dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ;
+
+: delete-gl-shader ( shader -- ) glDeleteShader ; inline
+
+PREDICATE: gl-shader < integer (gl-shader?) ;
+PREDICATE: vertex-shader < gl-shader (vertex-shader?) ;
+PREDICATE: fragment-shader < gl-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 [
+ 1 calloc &free
+ [ 0 <int> swap glGetProgramInfoLog ] keep
+ ascii alien>string
+ ] with-destructors ;
+
+: 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 <uint-array>
+ 0 <int> swap
+ [ underlying>> glGetAttachedShaders ] { 3 1 } multikeep ;
+
+: 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 -- )
+ over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
+
+PREDICATE: gl-program < integer (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 ;
+
--- /dev/null
+OpenGL Shading Language (GLSL) support
\ No newline at end of file
--- /dev/null
+opengl
+bindings
\ No newline at end of file
+++ /dev/null
-Joe Groff
\ No newline at end of file
+++ /dev/null
-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" } { "?" "a boolean" } }
-{ $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"
+++ /dev/null
-! Copyright (C) 2008 Joe Groff.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces make sequences splitting opengl.gl
-continuations math.parser math arrays sets math.order ;
-IN: opengl.capabilities
-
-: (require-gl) ( thing require-quot make-error-quot -- )
- -rot dupd call
- [ 2drop ]
- [ swap " " 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 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-before? ( version1 version2 -- ? )
- swap version-seq swap version-seq before=? ;
-
-: (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-before? ;
-: (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-before? ;
-: 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) ;
+++ /dev/null
-Testing for OpenGL versions and extensions
\ No newline at end of file
+++ /dev/null
-opengl
-bindings
+++ /dev/null
-Joe Groff
\ No newline at end of file
+++ /dev/null
-USING: arrays kernel math math.functions math.order math.vectors
-namespaces opengl opengl.gl sequences ui ui.gadgets ui.gestures
-ui.render accessors combinators ;
-IN: opengl.demo-support
-
-: FOV 2.0 sqrt 1+ ; inline
-: MOUSE-MOTION-SCALE 0.5 ; inline
-: KEY-ROTATE-STEP 1.0 ; inline
-
-SYMBOL: last-drag-loc
-
-TUPLE: demo-gadget < gadget yaw pitch distance ;
-
-: new-demo-gadget ( yaw pitch distance class -- gadget )
- new-gadget
- swap >>distance
- swap >>pitch
- swap >>yaw ;
-
-GENERIC: far-plane ( gadget -- z )
-GENERIC: near-plane ( gadget -- z )
-GENERIC: distance-step ( gadget -- dz )
-
-M: demo-gadget far-plane ( gadget -- z )
- drop 4.0 ;
-M: demo-gadget near-plane ( gadget -- z )
- drop 1.0 64.0 / ;
-M: demo-gadget distance-step ( gadget -- dz )
- drop 1.0 64.0 / ;
-
-: fov-ratio ( gadget -- fov ) dim>> dup first2 min v/n ;
-
-: yaw-demo-gadget ( yaw gadget -- )
- [ + ] with change-yaw relayout-1 ;
-
-: pitch-demo-gadget ( pitch gadget -- )
- [ + ] with change-pitch relayout-1 ;
-
-: zoom-demo-gadget ( distance gadget -- )
- [ + ] with change-distance relayout-1 ;
-
-M: demo-gadget pref-dim* ( gadget -- dim )
- drop { 640 480 } ;
-
-: -+ ( x -- -x x )
- [ neg ] keep ;
-
-: demo-gadget-frustum ( gadget -- -x x -y y near far )
- [ near-plane ] [ far-plane ] [ fov-ratio ] tri [
- nip swap FOV / v*n
- first2 [ -+ ] bi@
- ] 3keep drop ;
-
-: demo-gadget-set-matrices ( gadget -- )
- GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
- [
- GL_PROJECTION glMatrixMode
- glLoadIdentity
- demo-gadget-frustum glFrustum
- ] [
- GL_MODELVIEW glMatrixMode
- glLoadIdentity
- [ >r 0.0 0.0 r> distance>> neg glTranslatef ]
- [ pitch>> 1.0 0.0 0.0 glRotatef ]
- [ yaw>> 0.0 1.0 0.0 glRotatef ]
- tri
- ] bi ;
-
-: reset-last-drag-rel ( -- )
- { 0 0 } last-drag-loc set-global ;
-: last-drag-rel ( -- rel )
- drag-loc [ last-drag-loc get v- ] keep last-drag-loc set-global ;
-
-: drag-yaw-pitch ( -- yaw pitch )
- last-drag-rel MOUSE-MOTION-SCALE v*n first2 ;
-
-: gl-vertex ( point -- )
- dup length {
- { 2 [ first2 glVertex2d ] }
- { 3 [ first3 glVertex3d ] }
- { 4 [ first4 glVertex4d ] }
- } case ;
-
-: gl-normal ( normal -- ) first3 glNormal3d ;
-
-: do-state ( mode quot -- )
- swap glBegin call glEnd ; inline
-
-: rect-vertices ( lower-left upper-right -- )
- GL_QUADS [
- over first2 glVertex2d
- dup first pick second glVertex2d
- dup first2 glVertex2d
- swap first swap second glVertex2d
- ] do-state ;
-
-demo-gadget H{
- { T{ key-down f f "LEFT" } [ KEY-ROTATE-STEP neg swap yaw-demo-gadget ] }
- { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP swap yaw-demo-gadget ] }
- { T{ key-down f f "DOWN" } [ KEY-ROTATE-STEP neg swap pitch-demo-gadget ] }
- { T{ key-down f f "UP" } [ KEY-ROTATE-STEP swap pitch-demo-gadget ] }
- { T{ key-down f f "=" } [ dup distance-step neg swap zoom-demo-gadget ] }
- { T{ key-down f f "-" } [ dup distance-step swap zoom-demo-gadget ] }
-
- { T{ button-down f f 1 } [ drop reset-last-drag-rel ] }
- { T{ drag f 1 } [ drag-yaw-pitch rot [ pitch-demo-gadget ] keep yaw-demo-gadget ] }
- { T{ mouse-scroll } [ scroll-direction get second over distance-step * swap zoom-demo-gadget ] }
-} set-gestures
-
+++ /dev/null
-Common support for OpenGL demos
\ No newline at end of file
+++ /dev/null
-Joe Groff
\ No newline at end of file
+++ /dev/null
-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"
\ No newline at end of file
+++ /dev/null
-! 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 ;
+++ /dev/null
-Rendering to offscreen textures using the GL_EXT_framebuffer_object extension
\ No newline at end of file
+++ /dev/null
-opengl
-bindings
+++ /dev/null
-IN: opengl.gadgets.tests
-USING: tools.test opengl.gadgets ;
-
-\ render* must-infer
+++ /dev/null
-! Copyright (C) 2008 Matthew Willis.
-! See http://factorcode.org/license.txt for BSD license.
-USING: locals math.functions math namespaces
-opengl.gl opengl.demo-support accessors kernel opengl ui.gadgets
-fry assocs
-destructors sequences ui.render colors ;
-IN: opengl.gadgets
-
-TUPLE: texture-gadget < gadget ;
-
-GENERIC: render* ( gadget -- texture dims )
-GENERIC: cache-key* ( gadget -- key )
-
-M: texture-gadget cache-key* ;
-
-SYMBOL: textures
-SYMBOL: refcounts
-
-: init-cache ( symbol -- )
- dup get [ drop ] [ H{ } clone swap set-global ] if ;
-
-textures init-cache
-refcounts init-cache
-
-: refcount-change ( gadget quot -- )
- >r cache-key* refcounts get
- [ [ 0 ] unless* ] r> compose change-at ;
-
-TUPLE: cache-entry tex dims ;
-C: <entry> cache-entry
-
-: make-entry ( gadget -- entry )
- dup render* <entry>
- [ swap cache-key* textures get set-at ] keep ;
-
-: get-entry ( gadget -- {texture,dims} )
- dup cache-key* textures get at
- [ nip ] [ make-entry ] if* ;
-
-: get-dims ( gadget -- dims )
- get-entry dims>> ;
-
-: get-texture ( gadget -- texture )
- get-entry tex>> ;
-
-: release-texture ( gadget -- )
- cache-key* textures get delete-at*
- [ tex>> delete-texture ] [ drop ] if ;
-
-: clear-textures ( -- )
- textures get values [ tex>> delete-texture ] each
- H{ } clone textures set-global
- H{ } clone refcounts set-global ;
-
-M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
-
-M: texture-gadget ungraft* ( gadget -- )
- dup [ 1- ] refcount-change
- dup cache-key* refcounts get at
- zero? [ release-texture ] [ drop ] if ;
-
-: 2^-ceil ( x -- y )
- dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
-
-: 2^-bounds ( dim -- dim' )
- [ 2^-ceil ] map ; foldable flushable
-
-:: (render-bytes) ( dims bytes format texture -- )
- GL_ENABLE_BIT [
- GL_TEXTURE_2D glEnable
- GL_TEXTURE_2D texture glBindTexture
- GL_TEXTURE_2D
- 0
- GL_RGBA
- dims 2^-bounds first2
- 0
- format
- GL_UNSIGNED_BYTE
- bytes
- glTexImage2D
- init-texture
- GL_TEXTURE_2D 0 glBindTexture
- ] do-attribs ;
-
-: render-bytes ( dims bytes format -- texture )
- gen-texture [ (render-bytes) ] keep ;
-
-: render-bytes* ( dims bytes format -- texture dims )
- pick >r render-bytes r> ;
-
-:: four-corners ( dim -- )
- [let* | w [ dim first ]
- h [ dim second ]
- dim' [ dim dup 2^-bounds [ /f ] 2map ]
- w' [ dim' first ]
- h' [ dim' second ] |
- 0 0 glTexCoord2d 0 0 glVertex2d
- 0 h' glTexCoord2d 0 h glVertex2d
- w' h' glTexCoord2d w h glVertex2d
- w' 0 glTexCoord2d w 0 glVertex2d
- ] ;
-
-M: texture-gadget draw-gadget* ( gadget -- )
- origin get [
- GL_ENABLE_BIT [
- white gl-color
- 1.0 -1.0 glPixelZoom
- GL_TEXTURE_2D glEnable
- GL_TEXTURE_2D over get-texture glBindTexture
- GL_QUADS [
- get-dims four-corners
- ] do-state
- GL_TEXTURE_2D 0 glBindTexture
- ] do-attribs
- ] with-translation ;
-
-M: texture-gadget pref-dim* ( gadget -- dim ) get-dims ;
+++ /dev/null
-Joe Groff
\ No newline at end of file
+++ /dev/null
-USING: help.markup help.syntax io kernel math quotations
-opengl.gl multiline assocs strings ;
-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" } } { "shader" "a new " { $link gl-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" } { "vertex-shader" "a new " { $link vertex-shader } } }
-{ $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" } { "fragment-shader" "a new " { $link fragment-shader } } }
-{ $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" } { "?" "a boolean" } }
-{ $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" } { "shader" "a new " { $link gl-shader } } { "log" string } }
-{ $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." } { "program" "a new " { $link gl-program } } }
-{ $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" } { "program" "a new " { $link gl-program } } }
-{ $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" } { "?" "a boolean" } }
-{ $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" } { "log" string } }
-{ $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" } { "quot" "A quotation with stack effect " { $snippet "( program -- )" } } }
-{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in the dynamic extent of " { $snippet "quot" } ". " { $snippet "program" } " is left on the top of the stack when " { $snippet "quot" } " is called. The fixed-function pipeline is restored at the end of " { $snippet "quot" } "." } ;
-
-ABOUT: "gl-utilities"
+++ /dev/null
-! 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 alien.strings libc opengl math sequences combinators
-combinators.lib macros arrays io.encodings.ascii fry ;
-IN: opengl.shaders
-
-: with-gl-shader-source-ptr ( string quot -- )
- swap ascii malloc-string [ <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 [
- 1 calloc &free
- [ 0 <int> swap glGetShaderInfoLog ] keep
- ascii alien>string
- ] with-destructors ;
-
-: check-gl-shader ( shader -- shader )
- dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ;
-
-: delete-gl-shader ( shader -- ) glDeleteShader ; inline
-
-PREDICATE: gl-shader < integer (gl-shader?) ;
-PREDICATE: vertex-shader < gl-shader (vertex-shader?) ;
-PREDICATE: fragment-shader < gl-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 [
- 1 calloc &free
- [ 0 <int> swap glGetProgramInfoLog ] keep
- ascii alien>string
- ] with-destructors ;
-
-: 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 <uint-array>
- 0 <int> swap
- [ underlying>> glGetAttachedShaders ] { 3 1 } multikeep ;
-
-: 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 -- )
- over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
-
-PREDICATE: gl-program < integer (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 ;
-
+++ /dev/null
-OpenGL Shading Language (GLSL) support
\ No newline at end of file
+++ /dev/null
-opengl
-bindings
\ No newline at end of file
projects / factor.git / commitdiff