    {-# 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 = 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 a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Bool -> GettableStateVar Bool
    forall a. a -> IO a
    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 = GLbitfield -> GettableStateVar String
    makeStringVar GLbitfield
    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
    $c== :: ContextProfile' -> ContextProfile' -> Bool
    == :: ContextProfile' -> ContextProfile' -> Bool
    $c/= :: ContextProfile' -> ContextProfile' -> Bool
    /= :: 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
    $ccompare :: ContextProfile' -> ContextProfile' -> Ordering
    compare :: ContextProfile' -> ContextProfile' -> Ordering
    $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
    >= :: ContextProfile' -> ContextProfile' -> Bool
    $cmax :: ContextProfile' -> ContextProfile' -> ContextProfile'
    max :: ContextProfile' -> ContextProfile' -> ContextProfile'
    $cmin :: ContextProfile' -> ContextProfile' -> ContextProfile'
    min :: ContextProfile' -> ContextProfile' -> 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
    $cshowsPrec :: Int -> ContextProfile' -> ShowS
    showsPrec :: Int -> ContextProfile' -> ShowS
    $cshow :: ContextProfile' -> String
    show :: ContextProfile' -> String
    $cshowList :: [ContextProfile'] -> ShowS
    showList :: [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 = 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
    forall a. (GLint -> a) -> PName1I -> 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 -> GLbitfield
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GLint
    bitfield GLbitfield -> GLbitfield -> GLbitfield
    forall a. Bits a => a -> a -> a
    .&. ContextProfile' -> GLbitfield
    marshalContextProfile' ContextProfile'
    c) GLbitfield -> GLbitfield -> Bool
    forall a. Eq a => a -> a -> Bool
    /= GLbitfield
    0 ]

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

    makeStringVar :: GLenum -> GettableStateVar String
    makeStringVar :: GLbitfield -> GettableStateVar String
    makeStringVar = GettableStateVar String -> GettableStateVar String
    forall a. IO a -> IO a
    makeGettableStateVar (GettableStateVar String -> GettableStateVar String)
    -> (GLbitfield -> GettableStateVar String)
    -> GLbitfield
    -> GettableStateVar String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Ptr GLubyte) -> GettableStateVar String
    getStringWith (IO (Ptr GLubyte) -> GettableStateVar String)
    -> (GLbitfield -> IO (Ptr GLubyte))
    -> GLbitfield
    -> GettableStateVar String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GLbitfield -> IO (Ptr GLubyte)
    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 =
      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
    forall (m :: * -> *).
    MonadIO m =>
    GettableStateVar String -> m String
    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 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
      _prefix <-
        -- Too lazy to define a type for the API...
        (String
    "CL" String -> ReadP String -> ReadP String
    forall a b. a -> ReadP b -> ReadP a
    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 a b. a -> ReadP b -> ReadP a
    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 a b. a -> ReadP b -> ReadP a
    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 a b. a -> ReadP b -> ReadP a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ String -> ReadP String
    string String
    ""             )      -- OpenGL
      major <- read <$> munch1 isDigit
      minor <- char '.' >> read <$> munch1 isDigit
      _release <- (char '.' >> munch1 (/= ' ')) <++ return ""
      _vendorStuff <- (char ' ' >> R.get `manyTill` eof) <++ ("" <$ eof)
      return (major, minor)