{-# LANGUAGE CPP #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.StringQueries
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
-- 
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to parts of section 6.1.5 (String Queries) of the
-- OpenGL 3.2 specs.
--
--------------------------------------------------------------------------------

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 = GLbitfield -> GettableStateVar String
makeStringVar GLbitfield
GL_VENDOR

renderer :: GettableStateVar String
renderer :: GettableStateVar String
renderer = GLbitfield -> GettableStateVar String
makeStringVar GLbitfield
GL_RENDERER

glVersion :: GettableStateVar String
glVersion :: GettableStateVar String
glVersion = GLbitfield -> GettableStateVar String
makeStringVar GLbitfield
GL_VERSION

glExtensions :: GettableStateVar [String]
glExtensions :: GettableStateVar [String]
glExtensions = forall a. IO a -> IO a
makeGettableStateVar (forall a. Set a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m (Set String)
getExtensions)

extensionSupported :: String -> GettableStateVar Bool
extensionSupported :: String -> GettableStateVar Bool
extensionSupported String
ext =
  forall a. IO a -> IO a
makeGettableStateVar (forall (m :: * -> *). MonadIO m => m (Set String)
getExtensions forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Bool
member String
ext))

shadingLanguageVersion :: GettableStateVar String
shadingLanguageVersion :: GettableStateVar String
shadingLanguageVersion = GLbitfield -> GettableStateVar String
makeStringVar GLbitfield
GL_SHADING_LANGUAGE_VERSION

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

data ContextProfile'
   = CoreProfile'
   | CompatibilityProfile'
   deriving ( ContextProfile' -> ContextProfile' -> Bool
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'
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
Ord, Int -> ContextProfile' -> ShowS
[ContextProfile'] -> ShowS
ContextProfile' -> String
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' -> GLbitfield
marshalContextProfile' ContextProfile'
x = case ContextProfile'
x of
   ContextProfile'
CoreProfile' -> GLbitfield
GL_CONTEXT_CORE_PROFILE_BIT
   ContextProfile'
CompatibilityProfile' -> GLbitfield
GL_CONTEXT_COMPATIBILITY_PROFILE_BIT

contextProfile :: GettableStateVar [ContextProfile']
contextProfile :: GettableStateVar [ContextProfile']
contextProfile = forall a. IO a -> IO a
makeGettableStateVar (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' ]
       , (forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
bitfield forall a. Bits a => a -> a -> a
.&. ContextProfile' -> GLbitfield
marshalContextProfile' ContextProfile'
c) forall a. Eq a => a -> a -> Bool
/= GLbitfield
0 ]

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

makeStringVar :: GLenum -> GettableStateVar String
makeStringVar :: GLbitfield -> GettableStateVar String
makeStringVar = forall a. IO a -> IO a
makeGettableStateVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr GLubyte) -> GettableStateVar String
getStringWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => GLbitfield -> m (Ptr GLubyte)
glGetString

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

-- | A utility function to be used with e.g. 'glVersion' or
-- 'shadingLanguageVersion', transforming a variable containing a string of the
-- form /major.minor[optional rest]/ into a variable containing a numeric
-- major\/minor version. If the string is malformed, which should never happen
-- with a sane OpenGL implementation, it is transformed to @(-1,-1)@.

majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)
majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)
majorMinor =
  forall a. IO a -> IO a
makeGettableStateVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. ReadP a -> a -> String -> a
runParser ReadP (Int, Int)
parseVersion (-Int
1, -Int
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
S.get

--------------------------------------------------------------------------------
-- Copy from Graphics.Rendering.OpenGL.Raw.GetProcAddress... :-/

runParser :: ReadP a -> a -> String -> a
runParser :: forall a. ReadP a -> a -> String -> a
runParser ReadP a
parser a
failed String
str =
  case 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" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"OpenGL ES-CL ") forall a. ReadP a -> ReadP a -> ReadP a
<++  -- OpenGL ES 1.x Common-Lite
    (String
"CM" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"OpenGL ES-CM ") forall a. ReadP a -> ReadP a -> ReadP a
<++  -- OpenGL ES 1.x Common
    (String
"ES" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"OpenGL ES "   ) forall a. ReadP a -> ReadP a -> ReadP a
<++  -- OpenGL ES 2.x or 3.x
    (String
"GL" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
""             )      -- OpenGL
  Int
major <- forall a. Read a => String -> a
read 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
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Read a => String -> a
read 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
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> ReadP String
munch1 (forall a. Eq a => a -> a -> Bool
/= Char
' ')) forall a. ReadP a -> ReadP a -> ReadP a
<++ forall (m :: * -> *) a. Monad m => a -> m a
return String
""
  String
_vendorStuff <- (Char -> ReadP Char
char Char
' ' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Char
R.get forall a end. ReadP a -> ReadP end -> ReadP [a]
`manyTill` ReadP ()
eof) forall a. ReadP a -> ReadP a -> ReadP a
<++ (String
"" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP ()
eof)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
major, Int
minor)