--- /dev/null
+USING: alien help.markup help.syntax io kernel math quotations
+opengl.gl assocs vocabs.loader sequences accessors colors words
+opengl ;
+IN: opengl.annotations
+
+HELP: log-gl-error
+{ $values { "function" word } }
+{ $description "If the most recent OpenGL call resulted in an error, append it to the " { $link gl-error-log } "." }
+{ $notes "Don't call this function directly. Call " { $link log-gl-errors } " to annotate every OpenGL function to automatically log errors." } ;
+
+HELP: gl-error-log
+{ $var-description "A vector of OpenGL errors logged by " { $link log-gl-errors } ". Each log entry has the following tuple slots:" }
+{ $list
+ { { $snippet "function" } " is the OpenGL function that raised the error." }
+ { { $snippet "error" } " is the OpenGL error code." }
+ { { $snippet "timestamp" } " is the time the error was logged." }
+}
+{ "The error log is emptied using the " { $link clear-gl-error-log } " word." } ;
+
+HELP: clear-gl-error-log
+{ $description "Empties the OpenGL error log populated by " { $link log-gl-errors } "." } ;
+
+HELP: throw-gl-errors
+{ $description "Annotate every OpenGL function to throw a " { $link gl-error } " if the function results in an error. Use " { $link reset-gl-functions } " to reverse this operation." } ;
+
+HELP: log-gl-errors
+{ $description "Annotate every OpenGL function to log using " { $link log-gl-error } " if the function results in an error. Use " { $link reset-gl-functions } " to reverse this operation." } ;
+
+HELP: reset-gl-functions
+{ $description "Removes any annotations from all OpenGL functions, such as those applied by " { $link throw-gl-errors } " or " { $link log-gl-errors } "." } ;
+
+{ throw-gl-errors gl-error log-gl-errors log-gl-error clear-gl-error-log reset-gl-functions } related-words
+
+ARTICLE: "opengl.annotations" "OpenGL error reporting"
+"The " { $vocab-link "opengl.annotations" } " vocabulary provides some tools for tracking down GL errors:"
+{ $subsection throw-gl-errors }
+{ $subsection log-gl-errors }
+{ $subsection clear-gl-error-log }
+{ $subsection reset-gl-functions } ;
+
+ABOUT: "opengl.annotations"
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces combinators.short-circuit vocabs sequences
+compiler.units tools.annotations tools.annotations.private fry words
+opengl calendar accessors ascii ;
+IN: opengl.annotations
+
+TUPLE: gl-error-log
+ { function word initial: t }
+ { error gl-error }
+ { timestamp timestamp } ;
+
+gl-error-log [ V{ } clone ] initialize
+
+: <gl-error-log> ( function code -- gl-error-log )
+ [ dup ] dip <gl-error> now gl-error-log boa ;
+
+: log-gl-error ( function -- )
+ gl-error-code [ <gl-error-log> gl-error-log get push ] [ drop ] if* ;
+
+: clear-gl-error-log ( -- )
+ V{ } clone gl-error-log set ;
+
+: gl-function? ( word -- ? )
+ name>> { [ "glGetError" = not ] [ "gl" head? ] [ third LETTER? ] } 1&& ;
+
+: gl-functions ( -- words )
+ "opengl.gl" vocab words [ gl-function? ] filter ;
+
+: annotate-gl-functions ( quot -- )
+ [
+ [ gl-functions ] dip [ [ dup ] dip curry (annotate) ] curry each
+ ] with-compilation-unit ;
+
+: reset-gl-functions ( -- )
+ [ gl-functions [ (reset) ] each ] with-compilation-unit ;
+
+: throw-gl-errors ( -- )
+ [ '[ @ _ (gl-error) ] ] annotate-gl-functions ;
+
+: log-gl-errors ( -- )
+ [ '[ @ _ log-gl-error ] ] annotate-gl-functions ;
HELP: gl-error
{ $description "If the most recent OpenGL call resulted in an error, throw a " { $snippet "gl-error" } " instance reporting the error." } ;
-HELP: log-gl-error
-{ $values { "function" word } }
-{ $description "If the most recent OpenGL call resulted in an error, append it to the " { $link gl-error-log } "." }
-{ $notes "Don't call this function directly. Call " { $link log-gl-errors } " to annotate every OpenGL function to automatically log errors." } ;
-
-HELP: gl-error-log
-{ $var-description "A vector of OpenGL errors logged by " { $link log-gl-errors } ". Each log entry has the following tuple slots:" }
-{ $list
- { { $snippet "function" } " is the OpenGL function that raised the error." }
- { { $snippet "error" } " is the OpenGL error code." }
- { { $snippet "timestamp" } " is the time the error was logged." }
-}
-{ "The error log is emptied using the " { $link clear-gl-error-log } " word." } ;
-
-HELP: clear-gl-error-log
-{ $description "Empties the OpenGL error log populated by " { $link log-gl-errors } "." } ;
-
-HELP: throw-gl-errors
-{ $description "Annotate every OpenGL function to throw a " { $link gl-error } " if the function results in an error. Use " { $link reset-gl-functions } " to reverse this operation." } ;
-
-HELP: log-gl-errors
-{ $description "Annotate every OpenGL function to log using " { $link log-gl-error } " if the function results in an error. Use " { $link reset-gl-functions } " to reverse this operation." } ;
-
-HELP: reset-gl-functions
-{ $description "Removes any annotations from all OpenGL functions, such as those applied by " { $link throw-gl-errors } " or " { $link log-gl-errors } "." } ;
-
-{ throw-gl-errors gl-error log-gl-errors log-gl-error clear-gl-error-log reset-gl-functions } related-words
-
HELP: do-enabled
{ $values { "what" integer } { "quot" quotation } }
{ $description "Wraps a quotation in " { $link glEnable } "/" { $link glDisable } " calls." } ;
{ $subsection "opengl-low-level" }
"Error reporting:"
{ $subsection gl-error }
-{ $subsection throw-gl-errors }
-{ $subsection log-gl-errors }
-{ $subsection clear-gl-error-log }
-{ $subsection reset-gl-functions }
"Wrappers:"
{ $subsection gl-color }
{ $subsection gl-translate }
math.parser opengl.gl combinators combinators.smart arrays
sequences splitting words byte-arrays assocs vocabs
colors colors.constants accessors generalizations locals fry
-specialized-arrays.float specialized-arrays.uint
-tools.annotations tools.annotations.private compiler.units ;
+specialized-arrays.float specialized-arrays.uint ;
IN: opengl
: gl-color ( color -- ) >rgba-components glColor4d ; inline
TUPLE: gl-error function code string ;
-TUPLE: gl-error-log
- { function word initial: t }
- { error gl-error }
- { timestamp timestamp } ;
-
-gl-error-log [ V{ } clone ] initialize
-
: <gl-error> ( function code -- gl-error )
dup error>string \ gl-error boa ; inline
-: <gl-error-log> ( function code -- gl-error-log )
- [ dup ] dip <gl-error> now gl-error-log boa ;
-
: gl-error-code ( -- code/f )
glGetError dup 0 = [ drop f ] when ; inline
: gl-error ( -- )
f (gl-error) ; inline
-: log-gl-error ( function -- )
- gl-error-code [ <gl-error-log> gl-error-log get push ] [ drop ] if* ;
-
-: gl-function? ( word -- ? )
- name>> { [ "glGetError" = not ] [ "gl" head? ] [ third LETTER? ] } 1&& ;
-
-: gl-functions ( -- words )
- "opengl.gl" vocab words [ gl-function? ] filter ;
-
-: annotate-gl-functions ( quot -- )
- [
- [ gl-functions ] dip [ [ dup ] dip curry (annotate) ] curry each
- ] with-compilation-unit ;
-
-: reset-gl-functions ( -- )
- [ gl-functions [ (reset) ] each ] with-compilation-unit ;
-
-: clear-gl-error-log ( -- )
- V{ } clone gl-error-log set ;
-
-: throw-gl-errors ( -- )
- [ '[ @ _ (gl-error) ] ] annotate-gl-functions ;
-
-: log-gl-errors ( -- )
- [ '[ @ _ log-gl-error ] ] annotate-gl-functions ;
-
: do-enabled ( what quot -- )
over glEnable dip glDisable ; inline