module Graphics.GL.Internal.Proc
( getProcAddress
, Invoker
, extensions
) where
import Control.Monad
#if __GLASGOW_HASKELL__ < 710
import Data.Functor
#endif
import Data.Set as Set
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import Graphics.GL.Internal.FFI
( ffienumIOPtrubyte
, 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)
type Invoker a = FunPtr a -> a
extensions :: Set String
extensions = unsafePerformIO $ do
glGetStringiFunPtr <- getProcAddress "glGetStringi"
if glGetStringiFunPtr == nullFunPtr then do
glGetString <- ffienumIOPtrubyte <$> getProcAddress "glGetString"
supported <- glGetString 0x1F03 >>= peekCString . castPtr
return $ Set.fromList (words supported)
else do
let glGetStringi = ffienumuintIOPtrubyte glGetStringiFunPtr
glGetIntegerv <- ffienumPtrintIOV <$> getProcAddress "glGetIntegerv"
numExtensions <- alloca $ \p -> glGetIntegerv 0x821D p >> peek p
supported <- forM [0..fromIntegral numExtensions1] $ glGetStringi 0x1F03 >=> peekCString . castPtr
return $ Set.fromList supported