From 8bf1fd5f2ac65d3f742bb8a068a28501e1993ccd Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 14 Jul 2009 12:00:37 -0500
Subject: [PATCH] throw-gl-errors, log-gl-errors annotations for all OpenGL
 functions

---
 basis/opengl/opengl-docs.factor | 38 ++++++++++++++++++++--
 basis/opengl/opengl.factor      | 56 ++++++++++++++++++++++++++++-----
 2 files changed, 85 insertions(+), 9 deletions(-)

diff --git a/basis/opengl/opengl-docs.factor b/basis/opengl/opengl-docs.factor
index 1e4112d5d4..79038a0fd9 100644
--- a/basis/opengl/opengl-docs.factor
+++ b/basis/opengl/opengl-docs.factor
@@ -1,5 +1,5 @@
 USING: alien help.markup help.syntax io kernel math quotations
-opengl.gl assocs vocabs.loader sequences accessors colors ;
+opengl.gl assocs vocabs.loader sequences accessors colors words ;
 IN: opengl
 
 HELP: gl-color
@@ -8,7 +8,35 @@ HELP: gl-color
 { $notes "See " { $link "colors" } "." } ;
 
 HELP: gl-error
-{ $description "If the most recent OpenGL call resulted in an error, print the error to " { $link output-stream } "." } ;
+{ $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 } }
@@ -73,6 +101,12 @@ ARTICLE: "gl-utilities" "OpenGL utility words"
 $nl
 "The " { $vocab-link "opengl.gl" } " and " { $vocab-link "opengl.glu" } " vocabularies have the actual OpenGL bindings."
 { $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 }
diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor
index bb5847e734..7884890ebf 100644
--- a/basis/opengl/opengl.factor
+++ b/basis/opengl/opengl.factor
@@ -2,11 +2,13 @@
 ! Portions copyright (C) 2007 Eduardo Cavazos.
 ! Portions copyright (C) 2008 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types continuations kernel libc math macros
-namespaces math.vectors math.parser opengl.gl combinators
-combinators.smart arrays sequences splitting words byte-arrays assocs
+USING: alien alien.c-types ascii calendar combinators.short-circuit
+continuations kernel libc math macros namespaces math.vectors
+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 ;
+specialized-arrays.float specialized-arrays.uint
+tools.annotations tools.annotations.private compiler.units ;
 IN: opengl
 
 : gl-color ( color -- ) >rgba-components glColor4d ; inline
@@ -30,10 +32,50 @@ IN: opengl
 
 TUPLE: gl-error code string ;
 
+TUPLE: gl-error-log
+    { function word initial: t }
+    { error gl-error }
+    { timestamp timestamp } ;
+
+gl-error-log [ V{ } clone ] initialize
+
+: <gl-error> ( code -- gl-error )
+    dup error>string \ gl-error boa ; inline
+
+: <gl-error-log> ( function code -- gl-error-log )
+    <gl-error> now gl-error-log boa ;
+
+: gl-error-code ( -- code/f )
+    glGetError dup 0 = [ drop f ] when ; inline
+
 : gl-error ( -- )
-    glGetError dup 0 = [ drop ] [
-        dup error>string \ gl-error boa throw
-    ] if ;
+    gl-error-code [ <gl-error> throw ] [ ] if* ;
+
+: 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 ( -- )
+    [ drop '[ @ gl-error ] ] annotate-gl-functions ;
+
+: log-gl-errors ( -- )
+    [ '[ @ _ log-gl-error ] ] annotate-gl-functions ;
 
 : do-enabled ( what quot -- )
     over glEnable dip glDisable ; inline