OR gl extension testing

basis/opengl/capabilities/capabilities-docs.factor

@@ -40,7 +40,13 @@ HELP: gl-extensions
 
 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 } "." } ;
+{ $description "Returns true if the set of " { $snippet "extensions" } " is a subset of the implementation-supported extensions returned by " { $link gl-extensions } ". Elements of " { $snippet "extensions" } " can be sequences, in which case true will be returned if any one of the extensions in the subsequence are available." }
+{ $examples "Testing for framebuffer object and pixel buffer support:"
+    { $code <" {
+    { "GL_EXT_framebuffer_object" "GL_ARB_framebuffer_object" }
+    "GL_ARB_pixel_buffer_object"
+} has-gl-extensions? "> }
+} ;
 
 HELP: has-gl-version-or-extensions?
 { $values { "version" "A version string" } { "extensions" "A sequence of extension name strings" } { "?" "a boolean" } }

basis/opengl/capabilities/capabilities-tests.factor

@@ -0,0 +1,21 @@
+! (c)2009 Joe Groff bsd license
+USING: opengl.capabilities tools.test ;
+IN: opengl.capabilities.tests
+
+CONSTANT: test-extensions
+    {
+        "GL_ARB_vent_core_frogblast"
+        "GL_EXT_resonance_cascade"
+        "GL_EXT_slipgate"
+    }
+
+[ t ]
+[ "GL_ARB_vent_core_frogblast" test-extensions (has-extension?) ] unit-test
+
+[ f ]
+[ "GL_ARB_wallhack" test-extensions (has-extension?) ] unit-test
+
+[ t ] [
+    { "GL_EXT_dimensional_portal" "GL_EXT_slipgate" }
+    test-extensions (has-extension?)
+] unit-test

basis/opengl/capabilities/capabilities.factor

@@ -1,16 +1,19 @@
 ! 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 fry ;
+continuations math.parser math arrays sets strings math.order fry ;
 IN: opengl.capabilities
 
 : (require-gl) ( thing require-quot make-error-quot -- )
     [ dupd call [ drop ] ] dip '[ _ " " make throw ] if ; inline
 
+: (has-extension?) ( query-extension(s) available-extensions -- ? )
+    over string?  [ member? ] [ [ member? ] curry any? ] if ;
+
 : gl-extensions ( -- seq )
     GL_EXTENSIONS glGetString " " split ;
 : has-gl-extensions? ( extensions -- ? )
-    gl-extensions swap [ over member? ] all? nip ;
+    gl-extensions [ (has-extension?) ] curry all? ;
 : (make-gl-extensions-error) ( required-extensions -- )
     gl-extensions diff
     "Required OpenGL extensions not supported:\n" %