{-# LANGUAGE CPP #-}
module Graphics.Rendering.OpenGL.GL.StringQueries (
vendor, renderer, glVersion, glExtensions, extensionSupported,
shadingLanguageVersion, majorMinor, ContextProfile'(..), contextProfile
) where
import Data.Bits
import Data.Char
#if !MIN_VERSION_base(4,8,0)
import Data.Functor( (<$>), (<$) )
#endif
import Data.Set ( member, toList )
import Data.StateVar as S
import Graphics.Rendering.OpenGL.GL.ByteString
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.GL
import Text.ParserCombinators.ReadP as R
vendor :: GettableStateVar String
vendor :: GettableStateVar String
vendor = GLenum -> GettableStateVar String
makeStringVar GLenum
GL_VENDOR
renderer :: GettableStateVar String
renderer :: GettableStateVar String
renderer = GLenum -> GettableStateVar String
makeStringVar GLenum
GL_RENDERER
glVersion :: GettableStateVar String
glVersion :: GettableStateVar String
glVersion = GLenum -> GettableStateVar String
makeStringVar GLenum
GL_VERSION
glExtensions :: GettableStateVar [String]
glExtensions :: GettableStateVar [String]
glExtensions = GettableStateVar [String] -> GettableStateVar [String]
forall a. IO a -> IO a
makeGettableStateVar (Set String -> [String]
forall a. Set a -> [a]
toList (Set String -> [String])
-> IO (Set String) -> GettableStateVar [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Set String)
forall (m :: * -> *). MonadIO m => m (Set String)
getExtensions)
extensionSupported :: String -> GettableStateVar Bool
extensionSupported :: String -> GettableStateVar Bool
extensionSupported String
ext =
GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar (IO (Set String)
forall (m :: * -> *). MonadIO m => m (Set String)
getExtensions IO (Set String)
-> (Set String -> GettableStateVar Bool) -> GettableStateVar Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> GettableStateVar Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> GettableStateVar Bool)
-> (Set String -> Bool) -> Set String -> GettableStateVar Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
member String
ext))
shadingLanguageVersion :: GettableStateVar String
shadingLanguageVersion :: GettableStateVar String
shadingLanguageVersion = GLenum -> GettableStateVar String
makeStringVar GLenum
GL_SHADING_LANGUAGE_VERSION
data ContextProfile'
= CoreProfile'
| CompatibilityProfile'
deriving ( ContextProfile' -> ContextProfile' -> Bool
(ContextProfile' -> ContextProfile' -> Bool)
-> (ContextProfile' -> ContextProfile' -> Bool)
-> Eq ContextProfile'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextProfile' -> ContextProfile' -> Bool
$c/= :: ContextProfile' -> ContextProfile' -> Bool
== :: ContextProfile' -> ContextProfile' -> Bool
$c== :: ContextProfile' -> ContextProfile' -> Bool
Eq, Eq ContextProfile'
Eq ContextProfile'
-> (ContextProfile' -> ContextProfile' -> Ordering)
-> (ContextProfile' -> ContextProfile' -> Bool)
-> (ContextProfile' -> ContextProfile' -> Bool)
-> (ContextProfile' -> ContextProfile' -> Bool)
-> (ContextProfile' -> ContextProfile' -> Bool)
-> (ContextProfile' -> ContextProfile' -> ContextProfile')
-> (ContextProfile' -> ContextProfile' -> ContextProfile')
-> Ord ContextProfile'
ContextProfile' -> ContextProfile' -> Bool
ContextProfile' -> ContextProfile' -> Ordering
ContextProfile' -> ContextProfile' -> ContextProfile'
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ContextProfile' -> ContextProfile' -> ContextProfile'
$cmin :: ContextProfile' -> ContextProfile' -> ContextProfile'
max :: ContextProfile' -> ContextProfile' -> ContextProfile'
$cmax :: ContextProfile' -> ContextProfile' -> ContextProfile'
>= :: ContextProfile' -> ContextProfile' -> Bool
$c>= :: ContextProfile' -> ContextProfile' -> Bool
> :: ContextProfile' -> ContextProfile' -> Bool
$c> :: ContextProfile' -> ContextProfile' -> Bool
<= :: ContextProfile' -> ContextProfile' -> Bool
$c<= :: ContextProfile' -> ContextProfile' -> Bool
< :: ContextProfile' -> ContextProfile' -> Bool
$c< :: ContextProfile' -> ContextProfile' -> Bool
compare :: ContextProfile' -> ContextProfile' -> Ordering
$ccompare :: ContextProfile' -> ContextProfile' -> Ordering
$cp1Ord :: Eq ContextProfile'
Ord, Int -> ContextProfile' -> ShowS
[ContextProfile'] -> ShowS
ContextProfile' -> String
(Int -> ContextProfile' -> ShowS)
-> (ContextProfile' -> String)
-> ([ContextProfile'] -> ShowS)
-> Show ContextProfile'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextProfile'] -> ShowS
$cshowList :: [ContextProfile'] -> ShowS
show :: ContextProfile' -> String
$cshow :: ContextProfile' -> String
showsPrec :: Int -> ContextProfile' -> ShowS
$cshowsPrec :: Int -> ContextProfile' -> ShowS
Show )
marshalContextProfile' :: ContextProfile' -> GLbitfield
marshalContextProfile' :: ContextProfile' -> GLenum
marshalContextProfile' ContextProfile'
x = case ContextProfile'
x of
ContextProfile'
CoreProfile' -> GLenum
GL_CONTEXT_CORE_PROFILE_BIT
ContextProfile'
CompatibilityProfile' -> GLenum
GL_CONTEXT_COMPATIBILITY_PROFILE_BIT
contextProfile :: GettableStateVar [ContextProfile']
contextProfile :: GettableStateVar [ContextProfile']
contextProfile = GettableStateVar [ContextProfile']
-> GettableStateVar [ContextProfile']
forall a. IO a -> IO a
makeGettableStateVar ((GLint -> [ContextProfile'])
-> PName1I -> GettableStateVar [ContextProfile']
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 GLint -> [ContextProfile']
i2cps PName1I
GetContextProfileMask)
i2cps :: GLint -> [ContextProfile']
i2cps :: GLint -> [ContextProfile']
i2cps GLint
bitfield =
[ ContextProfile'
c | ContextProfile'
c <- [ ContextProfile'
CoreProfile', ContextProfile'
CompatibilityProfile' ]
, (GLint -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
bitfield GLenum -> GLenum -> GLenum
forall a. Bits a => a -> a -> a
.&. ContextProfile' -> GLenum
marshalContextProfile' ContextProfile'
c) GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
/= GLenum
0 ]
makeStringVar :: GLenum -> GettableStateVar String
makeStringVar :: GLenum -> GettableStateVar String
makeStringVar = GettableStateVar String -> GettableStateVar String
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar String -> GettableStateVar String)
-> (GLenum -> GettableStateVar String)
-> GLenum
-> GettableStateVar String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr GLubyte) -> GettableStateVar String
getStringWith (IO (Ptr GLubyte) -> GettableStateVar String)
-> (GLenum -> IO (Ptr GLubyte))
-> GLenum
-> GettableStateVar String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> IO (Ptr GLubyte)
forall (m :: * -> *). MonadIO m => GLenum -> m (Ptr GLubyte)
glGetString
majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)
majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)
majorMinor =
GettableStateVar (Int, Int) -> GettableStateVar (Int, Int)
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar (Int, Int) -> GettableStateVar (Int, Int))
-> (GettableStateVar String -> GettableStateVar (Int, Int))
-> GettableStateVar String
-> GettableStateVar (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
-> GettableStateVar String -> GettableStateVar (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (GettableStateVar String -> GettableStateVar (Int, Int))
-> (GettableStateVar String -> GettableStateVar String)
-> GettableStateVar String
-> GettableStateVar (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GettableStateVar String -> GettableStateVar String
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
S.get
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
parseVersion :: ReadP (Int, Int)
parseVersion :: ReadP (Int, Int)
parseVersion = do
String
_prefix <-
(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
<++
(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
<++
(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
<++
(String
"GL" String -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"" )
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
R.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)