module Graphics.GL.Raw.Internal.Proc
( getProcAddress
, getProcAddressWithSuffixes
, Invoker
, getExtensionEntry
, extensions
) where
import Control.Monad
import Data.Functor
import Data.Set as Set
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Marshal.Error
import Foreign.Ptr
import Foreign.Storable
import Graphics.GL.Raw.Internal.FFI (ffienumuintIOPtrubyte, ffienumPtrintIOV)
import System.IO.Unsafe
getProcAddress :: String -> IO (FunPtr a)
getProcAddress extensionEntry =
withCString extensionEntry hs_gl_getProcAddress
foreign import ccall unsafe "hs_gl_getProcAddress"
hs_gl_getProcAddress :: CString -> IO (FunPtr a)
getProcAddressWithSuffixes :: String -> [String] -> IO (FunPtr a)
getProcAddressWithSuffixes extensionEntry = foldM gpa nullFunPtr
where gpa p s | p == nullFunPtr = getProcAddress (extensionEntry ++ s)
| otherwise = return p
type Invoker a = FunPtr a -> a
getExtensionEntry :: String -> String -> IO (FunPtr a)
getExtensionEntry extensionNameString extensionEntry =
throwIfNullFunPtr ("unknown OpenGL extension entry " ++ extensionEntry ++
", check for " ++ extensionNameString) $
getProcAddressWithSuffixes extensionEntry extensionSuffixes
throwIfNullFunPtr :: String -> IO (FunPtr a) -> IO (FunPtr a)
throwIfNullFunPtr = throwIf (== nullFunPtr) . const
extensionSuffixes :: [String]
extensionSuffixes = [
"", "ARB", "EXT", "NV", "SGIX", "SGIS", "ATI", "APPLE", "SUN", "OES", "IBM",
"MESA", "HP", "SGI", "OML", "AMD", "3DFX", "WIN", "PGI", "INTEL", "INGR",
"GREMEDY", "SUNX", "S3", "REND", "MESAX" ]
extensions :: Set String
extensions = unsafePerformIO $ do
glGetStringi <- ffienumuintIOPtrubyte <$> getProcAddress "glGetStringi"
glGetIntegerv <- ffienumPtrintIOV <$> getProcAddress "glGetIntegerv"
numExtensions <- alloca $ \p -> glGetIntegerv 0x821D p >> peek p
supported <- forM [0..(fromIntegral numExtensions)1] $ \n -> peekCString . castPtr =<< glGetStringi 0x1F03 n
return $ Set.fromList supported