Use extension queries from OpenGLRaw, they are more robust.

Author: svenpanne

CHANGELOG.md

@@ -1,5 +1,7 @@
-2.13.0.1
+2.13.1.0
 --------
+* Added `extensionSupported`.
+* Relaxed upper version bound for OpenGLRaw.
 * Added CHANGELOG.md to distribution.
 
 2.13.0.0

OpenGL.cabal

@@ -148,14 +148,15 @@ library
   hs-source-dirs: src
   ghc-options: -Wall
   build-depends:
-    base         >= 3   && < 5,
-    bytestring   >= 0.9 && < 0.11,
-    text         >= 0.1 && < 1.3,
-    transformers >= 0.2 && < 0.5,
-    ObjectName   >= 1.1 && < 1.2,
-    StateVar     >= 1.1 && < 1.2,
-    OpenGLRaw    >= 2.1 && < 2.6,
-    GLURaw       >= 1.3 && < 1.6
+    base         >= 3     && < 5,
+    bytestring   >= 0.9   && < 0.11,
+    containers   >= 0.3   && < 0.6,
+    text         >= 0.1   && < 1.3,
+    transformers >= 0.2   && < 0.5,
+    ObjectName   >= 1.1   && < 1.2,
+    StateVar     >= 1.1   && < 1.2,
+    OpenGLRaw    >= 2.5.5 && < 2.7,
+    GLURaw       >= 1.3   && < 1.6
   default-language: Haskell2010
   other-extensions:
     CPP

src/Graphics/Rendering/OpenGL/GL/StringQueries.hs

@@ -20,35 +20,33 @@ module Graphics.Rendering.OpenGL.GL.StringQueries (
 
 import Data.Bits
 import Data.Char
-import Data.StateVar
+import Data.Set ( member, toList )
+import Data.StateVar as S
 import Graphics.Rendering.OpenGL.GL.ByteString
 import Graphics.Rendering.OpenGL.GL.QueryUtils
 import Graphics.Rendering.OpenGL.Raw
+import Text.ParserCombinators.ReadP as R
 
 --------------------------------------------------------------------------------
 
 vendor :: GettableStateVar String
-vendor = makeGettableStateVar (getString gl_VENDOR)
+vendor = makeStringVar gl_VENDOR
 
 renderer :: GettableStateVar String
-renderer = makeGettableStateVar (getString gl_RENDERER)
+renderer = makeStringVar gl_RENDERER
 
 glVersion :: GettableStateVar String
-glVersion = makeGettableStateVar (getString gl_VERSION)
+glVersion = makeStringVar gl_VERSION
 
 glExtensions :: GettableStateVar [String]
-glExtensions = makeGettableStateVar (fmap words $ getString gl_EXTENSIONS)
+glExtensions = makeGettableStateVar (toList `fmap` getExtensions)
 
 extensionSupported :: String -> GettableStateVar Bool
-extensionSupported ext = makeGettableStateVar $ do
-   n <- getInteger1 fromIntegral GetNumExtensions
-   anyM $ map isExt [ 0 .. n - 1 ]
-   where anyM = foldr orM (return False)
-         x `orM` y = x >>= \q -> if q then return True else y
-         isExt = fmap (== ext) . getStringi gl_EXTENSIONS
+extensionSupported ext =
+  makeGettableStateVar (getExtensions >>= (return . member ext))
 
 shadingLanguageVersion :: GettableStateVar String
-shadingLanguageVersion = makeGettableStateVar (getString gl_SHADING_LANGUAGE_VERSION)
+shadingLanguageVersion = makeStringVar gl_SHADING_LANGUAGE_VERSION
 
 --------------------------------------------------------------------------------
 
@@ -72,11 +70,8 @@ i2cps bitfield =
 
 --------------------------------------------------------------------------------
 
-getString :: GLenum -> IO String
-getString = getStringWith . glGetString
-
-getStringi :: GLenum -> GLuint -> IO String
-getStringi n = getStringWith . glGetStringi n
+makeStringVar :: GLenum -> GettableStateVar String
+makeStringVar = makeGettableStateVar . getStringWith . glGetString
 
 --------------------------------------------------------------------------------
 
@@ -87,12 +82,30 @@ getStringi n = getStringWith . glGetStringi n
 -- with a sane OpenGL implementation, it is transformed to @(-1,-1)@.
 
 majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)
-majorMinor = makeGettableStateVar . fmap parse . get
-   where defaultVersion = (-1, -1)
-         parse str =
-            case span isDigit str of
-               (major@(_:_), '.':rest) ->
-                  case span isDigit rest of
-                     (minor@(_:_), _) -> (read major, read minor)
-                     _ -> defaultVersion
-               _ -> defaultVersion
+majorMinor =
+  makeGettableStateVar . fmap (runParser parseVersion (-1, -1)) . S.get
+
+--------------------------------------------------------------------------------
+-- Copy from Graphics.Rendering.OpenGL.Raw.GetProcAddress... :-/
+
+runParser :: ReadP a -> a -> String -> a
+runParser parser failed str =
+  case readP_to_S parser str of
+    [(v, "")] -> v
+    _ -> failed
+
+-- This does quite a bit more than we need for "normal" OpenGL, but at least it
+-- documents the convoluted format of the version string in detail.
+parseVersion :: ReadP (Int, Int)
+parseVersion = do
+  _prefix <-
+    -- Too lazy to define a type for the API...
+    ("CL" <$ string "OpenGL ES-CL ") <++  -- OpenGL ES 1.x Common-Lite
+    ("CM" <$ string "OpenGL ES-CM ") <++  -- OpenGL ES 1.x Common
+    ("ES" <$ string "OpenGL ES "   ) <++  -- OpenGL ES 2.x or 3.x
+    ("GL" <$ string ""             )      -- OpenGL
+  major <- read <$> munch1 isDigit
+  minor <- char '.' >> read <$> munch1 isDigit
+  _release <- (char '.' >> munch1 (/= ' ')) <++ return ""
+  _vendorStuff <- (char ' ' >> R.get `manyTill` eof) <++ ("" <$ eof)
+  return (major, minor)