{-# LANGUAGE CPP #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.GL.GetProcAddress
-- Copyright   :  (c) Sven Panne 2009-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module offers a portable way to retrieve OpenGL functions and extension
-- entries, providing a portability layer upon platform-specific mechanisms
-- like @glXGetProcAddress@, @wglGetProcAddress@ or @NSAddressOfSymbol@.
--
-- Note that /finding/ an OpenGL entry point doesn't mean that it's actually
-- /usable:/ On most platforms entry points are context-independent, so you have
-- to check the available extensions and\/or OpenGL version, too.
--------------------------------------------------------------------------------

module Graphics.GL.GetProcAddress (
   -- * Unchecked retrieval
   getProcAddress,
   getProcAddressWithSuffixes,
   getExtension,
   -- * Checked retrieval
   getProcAddressChecked,
   getProcAddressWithSuffixesChecked,
   getExtensionChecked,
   -- * Version info and extensions
   getVersion, version,
   getExtensions, extensions
) where

#if !MIN_VERSION_base(4,8,0)
import Data.Functor( (<$>), (<$) )
#endif
import Control.Monad ( forM )
import Control.Monad.IO.Class ( MonadIO(..) )
import Data.ByteString.Unsafe ( unsafePackCString, unsafeUseAsCString )
import Data.Char ( isDigit )
import Data.Set ( Set, fromList )
import Data.Text ( pack, unpack )
import Data.Text.Encoding ( encodeUtf8, decodeUtf8 )
import Foreign.C.String ( CString )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Error ( throwIf )
import Foreign.Ptr ( Ptr, nullPtr, castPtr, FunPtr, nullFunPtr )
import Foreign.Storable ( peek )
import Graphics.GL.Tokens
import Graphics.GL.Types
import System.IO.Unsafe ( unsafePerformIO )
import Text.ParserCombinators.ReadP

--------------------------------------------------------------------------------

-- | Retrieve an OpenGL function by name. Returns 'nullFunPtr' when no function
-- with the given name was found.
getProcAddress :: MonadIO m => String -> m (FunPtr a)
getProcAddress :: String -> m (FunPtr a)
getProcAddress String
cmd = IO (FunPtr a) -> m (FunPtr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr a) -> m (FunPtr a)) -> IO (FunPtr a) -> m (FunPtr a)
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO (FunPtr a)) -> IO (FunPtr a)
forall a. String -> (CString -> IO a) -> IO a
withUtf8String String
cmd CString -> IO (FunPtr a)
forall a. CString -> IO (FunPtr a)
hs_OpenGLRaw_getProcAddress

foreign import ccall unsafe "hs_OpenGLRaw_getProcAddress"
   hs_OpenGLRaw_getProcAddress :: CString -> IO (FunPtr a)

-- | Retrieve an OpenGL function by name. Throws an 'userError' when no function
-- with the given name was found.
getProcAddressChecked :: MonadIO m => String -> m (FunPtr a)
getProcAddressChecked :: String -> m (FunPtr a)
getProcAddressChecked String
cmd = IO (FunPtr a) -> m (FunPtr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr a) -> m (FunPtr a)) -> IO (FunPtr a) -> m (FunPtr a)
forall a b. (a -> b) -> a -> b
$ String -> IO (FunPtr a) -> IO (FunPtr a)
forall a. String -> IO (FunPtr a) -> IO (FunPtr a)
check String
cmd (IO (FunPtr a) -> IO (FunPtr a)) -> IO (FunPtr a) -> IO (FunPtr a)
forall a b. (a -> b) -> a -> b
$ String -> IO (FunPtr a)
forall (m :: * -> *) a. MonadIO m => String -> m (FunPtr a)
getProcAddress String
cmd

-- | Retrieve an OpenGL function by name, trying a list of name suffixes in the
-- given order. Returns 'nullFunPtr' when no function with the given name plus
-- any of the suffixes was found.
getProcAddressWithSuffixes :: MonadIO m => String -> [String] -> m (FunPtr a)
getProcAddressWithSuffixes :: String -> [String] -> m (FunPtr a)
getProcAddressWithSuffixes String
_ [] = FunPtr a -> m (FunPtr a)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr a
forall a. FunPtr a
nullFunPtr
getProcAddressWithSuffixes String
cmd (String
x:[String]
xs) = do
   FunPtr a
p <- String -> m (FunPtr a)
forall (m :: * -> *) a. MonadIO m => String -> m (FunPtr a)
getProcAddress (String
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
   if FunPtr a
p FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr a
forall a. FunPtr a
nullFunPtr
      then String -> [String] -> m (FunPtr a)
forall (m :: * -> *) a.
MonadIO m =>
String -> [String] -> m (FunPtr a)
getProcAddressWithSuffixes String
cmd [String]
xs
      else FunPtr a -> m (FunPtr a)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr a
p

-- | Retrieve an OpenGL function by name, trying a list of name suffixes in the
-- given order. Throws an 'userError' when no function with the given name plus
-- any of the suffixes was found.
getProcAddressWithSuffixesChecked :: MonadIO m
                                  => String -> [String] -> m (FunPtr a)
getProcAddressWithSuffixesChecked :: String -> [String] -> m (FunPtr a)
getProcAddressWithSuffixesChecked String
cmd [String]
suffixes =
   IO (FunPtr a) -> m (FunPtr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr a) -> m (FunPtr a)) -> IO (FunPtr a) -> m (FunPtr a)
forall a b. (a -> b) -> a -> b
$ String -> IO (FunPtr a) -> IO (FunPtr a)
forall a. String -> IO (FunPtr a) -> IO (FunPtr a)
check String
cmd (IO (FunPtr a) -> IO (FunPtr a)) -> IO (FunPtr a) -> IO (FunPtr a)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO (FunPtr a)
forall (m :: * -> *) a.
MonadIO m =>
String -> [String] -> m (FunPtr a)
getProcAddressWithSuffixes String
cmd [String]
suffixes

-- | Retrieve an OpenGL function by name, additionally trying a list of all
-- known vendor suffixes. Returns 'nullFunPtr' when no function with the given
-- name plus any of the suffixes was found.
getExtension :: MonadIO m => String -> m (FunPtr a)
getExtension :: String -> m (FunPtr a)
getExtension String
cmd = IO (FunPtr a) -> m (FunPtr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr a) -> m (FunPtr a)) -> IO (FunPtr a) -> m (FunPtr a)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO (FunPtr a)
forall (m :: * -> *) a.
MonadIO m =>
String -> [String] -> m (FunPtr a)
getProcAddressWithSuffixes String
cmd [String]
vendorSuffixes

-- | Retrieve an OpenGL function by name, additionally trying a list of all
-- known vendor suffixes. Throws an 'userError' when no function with the given
-- name plus any of the suffixes was found.
getExtensionChecked :: MonadIO m => String -> m (FunPtr a)
getExtensionChecked :: String -> m (FunPtr a)
getExtensionChecked String
cmd =
  IO (FunPtr a) -> m (FunPtr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr a) -> m (FunPtr a)) -> IO (FunPtr a) -> m (FunPtr a)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO (FunPtr a)
forall (m :: * -> *) a.
MonadIO m =>
String -> [String] -> m (FunPtr a)
getProcAddressWithSuffixesChecked String
cmd [String]
vendorSuffixes

check :: String -> IO (FunPtr a) -> IO (FunPtr a)
check :: String -> IO (FunPtr a) -> IO (FunPtr a)
check = String -> IO (FunPtr a) -> IO (FunPtr a)
forall a. String -> IO (FunPtr a) -> IO (FunPtr a)
throwIfNullFunPtr (String -> IO (FunPtr a) -> IO (FunPtr a))
-> (String -> String) -> String -> IO (FunPtr a) -> IO (FunPtr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"unknown OpenGL command " String -> String -> String
forall a. [a] -> [a] -> [a]
++)

-- This should really live in Foreign.Marshal.Error.
throwIfNullFunPtr :: String -> IO (FunPtr a) -> IO (FunPtr a)
throwIfNullFunPtr :: String -> IO (FunPtr a) -> IO (FunPtr a)
throwIfNullFunPtr = (FunPtr a -> Bool)
-> (FunPtr a -> String) -> IO (FunPtr a) -> IO (FunPtr a)
forall a. (a -> Bool) -> (a -> String) -> IO a -> IO a
throwIf (FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr a
forall a. FunPtr a
nullFunPtr) ((FunPtr a -> String) -> IO (FunPtr a) -> IO (FunPtr a))
-> (String -> FunPtr a -> String)
-> String
-> IO (FunPtr a)
-> IO (FunPtr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FunPtr a -> String
forall a b. a -> b -> a
const

vendorSuffixes :: [String]
vendorSuffixes :: [String]
vendorSuffixes = [
   -- stuff already in the standard
   String
"",
   -- officially blessed stuff
   String
"ARB", String
"KHR", String
"OES",
   -- almost official stuff
   String
"EXT",
   -- random vendor stuff in decreasing order of number of extensions
   String
"NV", String
"SGIX", String
"AMD", String
"APPLE", String
"ATI", String
"SGIS", String
"ANGLE", String
"QCOM", String
"IMG", String
"SUN",
   String
"IBM", String
"ARM", String
"MESA", String
"INTEL", String
"HP", String
"SGI", String
"OML", String
"INGR", String
"3DFX", String
"WIN",
   String
"PGI", String
"NVX", String
"GREMEDY", String
"DMP", String
"VIV", String
"SUNX", String
"S3", String
"REND", String
"MESAX", String
"FJ",
   String
"ANDROID" ]

--------------------------------------------------------------------------------

-- | Retrieve the set of all available OpenGL extensions.
getExtensions :: MonadIO m => m (Set String)
getExtensions :: m (Set String)
getExtensions = IO (Set String) -> m (Set String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Set String) -> m (Set String))
-> IO (Set String) -> m (Set String)
forall a b. (a -> b) -> a -> b
$ [String] -> Set String
forall a. Ord a => [a] -> Set a
Data.Set.fromList ([String] -> Set String) -> IO [String] -> IO (Set String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  -- glGetStringi is only present from OpenGL 3.0 and OpenGL ES 3.0 onwards, but
  -- we can't simply retrieve its entry point and check that against nullFunPtr:
  -- Apart from WGL, entry points are context-independent, so even having an
  -- entry point which looks valid doesn't guarantee that it is actually
  -- supported. Therefore we need to check the OpenGL version number directly.
  GLenum -> IO String
getString <- IO (GLenum -> IO String)
makeGetString
  (Int, Int)
v <- (GLenum -> IO String) -> IO (Int, Int)
getVersionWith GLenum -> IO String
getString
  if (Int, Int)
v (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
3, Int
0)
    then do GLenum -> IO GLint
getInteger <- IO (GLenum -> IO GLint)
makeGetInteger
            GLenum -> GLenum -> IO String
getStringi <- IO (GLenum -> GLenum -> IO String)
makeGetStringi
            GLint
numExtensions <- GLenum -> IO GLint
getInteger GLenum
GL_NUM_EXTENSIONS
            [GLenum] -> (GLenum -> IO String) -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ GLenum
0 .. GLint -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
numExtensions GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
- GLenum
1 ] ((GLenum -> IO String) -> IO [String])
-> (GLenum -> IO String) -> IO [String]
forall a b. (a -> b) -> a -> b
$
              GLenum -> GLenum -> IO String
getStringi GLenum
GL_EXTENSIONS
    else String -> [String]
words (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GLenum -> IO String
getString GLenum
GL_EXTENSIONS

--------------------------------------------------------------------------------

-- | Retrieve the OpenGL version, split into major and minor version numbers.
getVersion :: MonadIO m => m (Int, Int)
getVersion :: m (Int, Int)
getVersion = IO (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Int) -> m (Int, Int)) -> IO (Int, Int) -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ IO (GLenum -> IO String)
makeGetString IO (GLenum -> IO String)
-> ((GLenum -> IO String) -> IO (Int, Int)) -> IO (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GLenum -> IO String) -> IO (Int, Int)
getVersionWith

getVersionWith :: (GLenum -> IO String) -> IO (Int, Int)
getVersionWith :: (GLenum -> IO String) -> IO (Int, Int)
getVersionWith GLenum -> IO String
getString =
  ReadP (Int, Int) -> (Int, Int) -> String -> (Int, Int)
forall a. ReadP a -> a -> String -> a
runParser ReadP (Int, Int)
parseVersion (-Int
1, -Int
1) (String -> (Int, Int)) -> IO String -> IO (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GLenum -> IO String
getString GLenum
GL_VERSION

runParser :: ReadP a -> a -> String -> a
runParser :: ReadP a -> a -> String -> a
runParser ReadP a
parser a
failed String
str =
  case ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
parser String
str of
    [(a
v, String
"")] -> a
v
    [(a, String)]
_ -> a
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 :: ReadP (Int, Int)
parseVersion = do
  String
_prefix <-
    -- Too lazy to define a type for the API...
    (String
"CL" String -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"OpenGL ES-CL ") ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++  -- OpenGL ES 1.x Common-Lite
    (String
"CM" String -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"OpenGL ES-CM ") ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++  -- OpenGL ES 1.x Common
    (String
"ES" String -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"OpenGL ES "   ) ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++  -- OpenGL ES 2.x or 3.x
    (String
"GL" String -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
""             )      -- OpenGL
  Int
major <- String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ReadP String -> ReadP Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
  Int
minor <- Char -> ReadP Char
char Char
'.' ReadP Char -> ReadP Int -> ReadP Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ReadP String -> ReadP Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
  String
_release <- (Char -> ReadP Char
char Char
'.' ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> ReadP String
munch1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ')) ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++ String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
  String
_vendorStuff <- (Char -> ReadP Char
char Char
' ' ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Char
get ReadP Char -> ReadP () -> ReadP String
forall a end. ReadP a -> ReadP end -> ReadP [a]
`manyTill` ReadP ()
eof) ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++ (String
"" String -> ReadP () -> ReadP String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP ()
eof)
  (Int, Int) -> ReadP (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
major, Int
minor)

--------------------------------------------------------------------------------
-- Graphics.GL.Foreign uses generated names, which are not
-- easily predictable, so we duplicate a few "foreign import"s below.

makeGetString :: IO (GLenum -> IO String)
makeGetString :: IO (GLenum -> IO String)
makeGetString = do
  GLenum -> IO (Ptr GLubyte)
glGetString_ <- FunPtr (GLenum -> IO (Ptr GLubyte)) -> GLenum -> IO (Ptr GLubyte)
dynGLenumIOPtrGLubyte (FunPtr (GLenum -> IO (Ptr GLubyte)) -> GLenum -> IO (Ptr GLubyte))
-> IO (FunPtr (GLenum -> IO (Ptr GLubyte)))
-> IO (GLenum -> IO (Ptr GLubyte))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (FunPtr (GLenum -> IO (Ptr GLubyte)))
forall (m :: * -> *) a. MonadIO m => String -> m (FunPtr a)
getProcAddress String
"glGetString"
  (GLenum -> IO String) -> IO (GLenum -> IO String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((GLenum -> IO String) -> IO (GLenum -> IO String))
-> (GLenum -> IO String) -> IO (GLenum -> IO String)
forall a b. (a -> b) -> a -> b
$ \GLenum
name -> GLenum -> IO (Ptr GLubyte)
glGetString_ GLenum
name IO (Ptr GLubyte) -> (Ptr GLubyte -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr GLubyte -> IO String
peekGLstring

foreign import CALLCONV "dynamic" dynGLenumIOPtrGLubyte
  :: FunPtr (GLenum -> IO (Ptr GLubyte))
  ->         GLenum -> IO (Ptr GLubyte)

makeGetStringi :: IO (GLenum -> GLuint -> IO String)
makeGetStringi :: IO (GLenum -> GLenum -> IO String)
makeGetStringi = do
  GLenum -> GLenum -> IO (Ptr GLubyte)
glGetStringi_ <- FunPtr (GLenum -> GLenum -> IO (Ptr GLubyte))
-> GLenum -> GLenum -> IO (Ptr GLubyte)
dynGLenumGLuintIOPtrGLubyte (FunPtr (GLenum -> GLenum -> IO (Ptr GLubyte))
 -> GLenum -> GLenum -> IO (Ptr GLubyte))
-> IO (FunPtr (GLenum -> GLenum -> IO (Ptr GLubyte)))
-> IO (GLenum -> GLenum -> IO (Ptr GLubyte))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (FunPtr (GLenum -> GLenum -> IO (Ptr GLubyte)))
forall (m :: * -> *) a. MonadIO m => String -> m (FunPtr a)
getProcAddress String
"glGetStringi"
  (GLenum -> GLenum -> IO String)
-> IO (GLenum -> GLenum -> IO String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((GLenum -> GLenum -> IO String)
 -> IO (GLenum -> GLenum -> IO String))
-> (GLenum -> GLenum -> IO String)
-> IO (GLenum -> GLenum -> IO String)
forall a b. (a -> b) -> a -> b
$ \GLenum
name GLenum
index -> GLenum -> GLenum -> IO (Ptr GLubyte)
glGetStringi_ GLenum
name GLenum
index IO (Ptr GLubyte) -> (Ptr GLubyte -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr GLubyte -> IO String
peekGLstring

foreign import CALLCONV "dynamic" dynGLenumGLuintIOPtrGLubyte
  :: FunPtr (GLenum -> GLuint -> IO (Ptr GLubyte))
  ->         GLenum -> GLuint -> IO (Ptr GLubyte)

makeGetInteger :: IO (GLenum -> IO GLint)
makeGetInteger :: IO (GLenum -> IO GLint)
makeGetInteger = do
  GLenum -> Ptr GLint -> IO ()
glGetIntegerv_ <- FunPtr (GLenum -> Ptr GLint -> IO ())
-> GLenum -> Ptr GLint -> IO ()
dynGLenumPtrGLintIOVoid (FunPtr (GLenum -> Ptr GLint -> IO ())
 -> GLenum -> Ptr GLint -> IO ())
-> IO (FunPtr (GLenum -> Ptr GLint -> IO ()))
-> IO (GLenum -> Ptr GLint -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (FunPtr (GLenum -> Ptr GLint -> IO ()))
forall (m :: * -> *) a. MonadIO m => String -> m (FunPtr a)
getProcAddress String
"glGetIntegerv"
  (GLenum -> IO GLint) -> IO (GLenum -> IO GLint)
forall (m :: * -> *) a. Monad m => a -> m a
return ((GLenum -> IO GLint) -> IO (GLenum -> IO GLint))
-> (GLenum -> IO GLint) -> IO (GLenum -> IO GLint)
forall a b. (a -> b) -> a -> b
$ \GLenum
name -> (Ptr GLint -> IO GLint) -> IO GLint
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLint -> IO GLint) -> IO GLint)
-> (Ptr GLint -> IO GLint) -> IO GLint
forall a b. (a -> b) -> a -> b
$ \Ptr GLint
p -> GLenum -> Ptr GLint -> IO ()
glGetIntegerv_ GLenum
name Ptr GLint
p IO () -> IO GLint -> IO GLint
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLint -> IO GLint
forall a. Storable a => Ptr a -> IO a
peek Ptr GLint
p

foreign import CALLCONV "dynamic" dynGLenumPtrGLintIOVoid
  :: FunPtr (GLenum -> Ptr GLint -> IO ())
  ->         GLenum -> Ptr GLint -> IO ()

--------------------------------------------------------------------------------

-- Play safe, this is in line with OpenGL: Return something, but don't crash.
peekGLstring :: Ptr GLubyte -> IO String
peekGLstring :: Ptr GLubyte -> IO String
peekGLstring = IO String -> (Ptr GLubyte -> IO String) -> Ptr GLubyte -> IO String
forall b a. b -> (Ptr a -> b) -> Ptr a -> b
ptr (String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"") (CString -> IO String
peekUtf8String (CString -> IO String)
-> (Ptr GLubyte -> CString) -> Ptr GLubyte -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr GLubyte -> CString
forall a b. Ptr a -> Ptr b
castPtr)

-- This should really be in Foreign.Ptr.
ptr :: b -> (Ptr a -> b) -> Ptr a -> b
ptr :: b -> (Ptr a -> b) -> Ptr a -> b
ptr b
n Ptr a -> b
f Ptr a
p | Ptr a
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr = b
n
          | Bool
otherwise    = Ptr a -> b
f Ptr a
p

--------------------------------------------------------------------------------

withUtf8String :: String -> (CString -> IO a) -> IO a
withUtf8String :: String -> (CString -> IO a) -> IO a
withUtf8String = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString (ByteString -> (CString -> IO a) -> IO a)
-> (String -> ByteString) -> String -> (CString -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\0")

peekUtf8String :: CString -> IO String
peekUtf8String :: CString -> IO String
peekUtf8String CString
p = Text -> String
unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
unsafePackCString CString
p

--------------------------------------------------------------------------------

-- | The set of all available OpenGL extensions. Note that in the presence of
-- multiple contexts with different capabilities, this might be wrong. Use
-- 'getExtensions' in those cases instead.
extensions :: Set String
extensions :: Set String
extensions = IO (Set String) -> Set String
forall a. IO a -> a
unsafePerformIO IO (Set String)
forall (m :: * -> *). MonadIO m => m (Set String)
getExtensions
{-# NOINLINE extensions #-}

-- | The OpenGL version, split into major and minor version numbers. Note that
-- in the presence of multiple contexts with different capabilities, this might
-- be wrong. Use 'getVersion' in those cases instead.
version :: (Int, Int)
version :: (Int, Int)
version = IO (Int, Int) -> (Int, Int)
forall a. IO a -> a
unsafePerformIO IO (Int, Int)
forall (m :: * -> *). MonadIO m => m (Int, Int)
getVersion
{-# NOINLINE version #-}