Split off annotation code from opengl into opengl.annotations to reduce deployed image size
parent
e88e7f70be
commit
fca74191ce
|
@ -0,0 +1,41 @@
|
||||||
|
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"
|
|
@ -0,0 +1,42 @@
|
||||||
|
! 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 ;
|
|
@ -10,34 +10,6 @@ HELP: gl-color
|
||||||
HELP: gl-error
|
HELP: gl-error
|
||||||
{ $description "If the most recent OpenGL call resulted in an error, throw a " { $snippet "gl-error" } " instance reporting the 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
|
HELP: do-enabled
|
||||||
{ $values { "what" integer } { "quot" quotation } }
|
{ $values { "what" integer } { "quot" quotation } }
|
||||||
{ $description "Wraps a quotation in " { $link glEnable } "/" { $link glDisable } " calls." } ;
|
{ $description "Wraps a quotation in " { $link glEnable } "/" { $link glDisable } " calls." } ;
|
||||||
|
@ -103,10 +75,6 @@ $nl
|
||||||
{ $subsection "opengl-low-level" }
|
{ $subsection "opengl-low-level" }
|
||||||
"Error reporting:"
|
"Error reporting:"
|
||||||
{ $subsection gl-error }
|
{ $subsection gl-error }
|
||||||
{ $subsection throw-gl-errors }
|
|
||||||
{ $subsection log-gl-errors }
|
|
||||||
{ $subsection clear-gl-error-log }
|
|
||||||
{ $subsection reset-gl-functions }
|
|
||||||
"Wrappers:"
|
"Wrappers:"
|
||||||
{ $subsection gl-color }
|
{ $subsection gl-color }
|
||||||
{ $subsection gl-translate }
|
{ $subsection gl-translate }
|
||||||
|
|
|
@ -7,8 +7,7 @@ continuations kernel libc math macros namespaces math.vectors
|
||||||
math.parser opengl.gl combinators combinators.smart arrays
|
math.parser opengl.gl combinators combinators.smart arrays
|
||||||
sequences splitting words byte-arrays assocs vocabs
|
sequences splitting words byte-arrays assocs vocabs
|
||||||
colors colors.constants accessors generalizations locals fry
|
colors colors.constants accessors generalizations locals fry
|
||||||
specialized-arrays.float specialized-arrays.uint
|
specialized-arrays.float specialized-arrays.uint ;
|
||||||
tools.annotations tools.annotations.private compiler.units ;
|
|
||||||
IN: opengl
|
IN: opengl
|
||||||
|
|
||||||
: gl-color ( color -- ) >rgba-components glColor4d ; inline
|
: gl-color ( color -- ) >rgba-components glColor4d ; inline
|
||||||
|
@ -32,19 +31,9 @@ IN: opengl
|
||||||
|
|
||||||
TUPLE: gl-error function code string ;
|
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 )
|
: <gl-error> ( function code -- gl-error )
|
||||||
dup error>string \ gl-error boa ; inline
|
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 )
|
: gl-error-code ( -- code/f )
|
||||||
glGetError dup 0 = [ drop f ] when ; inline
|
glGetError dup 0 = [ drop f ] when ; inline
|
||||||
|
|
||||||
|
@ -54,32 +43,6 @@ gl-error-log [ V{ } clone ] initialize
|
||||||
: gl-error ( -- )
|
: gl-error ( -- )
|
||||||
f (gl-error) ; inline
|
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 -- )
|
: do-enabled ( what quot -- )
|
||||||
over glEnable dip glDisable ; inline
|
over glEnable dip glDisable ; inline
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue