    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects
    -- Copyright   :  (c) Sven Panne 2006-2019
    -- License     :  BSD3
    --
    -- Maintainer  :  Sven Panne <svenpanne@gmail.com>
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- This module corresponds to section 7.3 (Program Objects) of the OpenGL 4.4
    -- spec.
    --
    -----------------------------------------------------------------------------

    module Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects (
       -- * Program Objects
       Program, createProgram, programDeleteStatus,
       attachShader, detachShader, attachedShaders,
       linkProgram, linkStatus,
       validateProgram, validateStatus,
       programInfoLog,
       currentProgram,
       programSeparable, programBinaryRetrievableHint,

       -- TODOs:
       --    glCreateShaderProgramv
       --    ProgramInterface type (from 7.3.1)
       --    glGetProgramInterfaceiv
       --    glGetProgramResourceIndex
       --    glGetProgramResourceName
       --    glGetProgramResourceiv
       --    glGetProgramResourceLocation
       --    glGetProgramResourceLocationIndex

       -- * Fragment Data
       bindFragDataLocation, getFragDataLocation
    ) where

    import Data.List
    import Data.Maybe
    import Data.StateVar
    import Foreign.Marshal.Array
    import Foreign.Ptr
    import Graphics.Rendering.OpenGL.GL.ByteString
    import Graphics.Rendering.OpenGL.GL.Framebuffer
    import Graphics.Rendering.OpenGL.GL.GLboolean
    import Graphics.Rendering.OpenGL.GL.QueryUtils
    import Graphics.Rendering.OpenGL.GL.Shaders.Program
    import Graphics.Rendering.OpenGL.GL.Shaders.Shader
    import Graphics.GL

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

    createProgram :: IO Program
    createProgram :: IO Program
    createProgram = (DrawBufferIndex -> Program) -> IO DrawBufferIndex -> IO Program
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DrawBufferIndex -> Program
    Program IO DrawBufferIndex
    forall (m :: * -> *). MonadIO m => m DrawBufferIndex
    glCreateProgram

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

    attachShader :: Program -> Shader -> IO ()
    attachShader :: Program -> Shader -> IO ()
    attachShader Program
    p Shader
    s = DrawBufferIndex -> DrawBufferIndex -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    DrawBufferIndex -> DrawBufferIndex -> m ()
    glAttachShader (Program -> DrawBufferIndex
    programID Program
    p) (Shader -> DrawBufferIndex
    shaderID Shader
    s)

    detachShader :: Program -> Shader -> IO ()
    detachShader :: Program -> Shader -> IO ()
    detachShader Program
    p Shader
    s = DrawBufferIndex -> DrawBufferIndex -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    DrawBufferIndex -> DrawBufferIndex -> m ()
    glDetachShader (Program -> DrawBufferIndex
    programID Program
    p) (Shader -> DrawBufferIndex
    shaderID Shader
    s)

    attachedShaders :: Program -> StateVar [Shader]
    attachedShaders :: Program -> StateVar [Shader]
    attachedShaders Program
    program =
       IO [Shader] -> ([Shader] -> IO ()) -> StateVar [Shader]
    forall a. IO a -> (a -> IO ()) -> StateVar a
    makeStateVar (Program -> IO [Shader]
    getAttachedShaders Program
    program) (Program -> [Shader] -> IO ()
    setAttachedShaders Program
    program)

    getAttachedShaders :: Program -> IO [Shader]
    getAttachedShaders :: Program -> IO [Shader]
    getAttachedShaders Program
    program = do
       numShaders <- GettableStateVar GLint -> GettableStateVar GLint
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *).
    MonadIO m =>
    GettableStateVar GLint -> m GLint
    get (Program -> GettableStateVar GLint
    numAttachedShaders Program
    program)
       ids <- allocaArray (fromIntegral numShaders) $ \Ptr DrawBufferIndex
    buf -> do
          DrawBufferIndex
    -> GLint -> Ptr GLint -> Ptr DrawBufferIndex -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    DrawBufferIndex
    -> GLint -> Ptr GLint -> Ptr DrawBufferIndex -> m ()
    glGetAttachedShaders (Program -> DrawBufferIndex
    programID Program
    program) GLint
    numShaders Ptr GLint
    forall a. Ptr a
    nullPtr Ptr DrawBufferIndex
    buf
          Int -> Ptr DrawBufferIndex -> IO [DrawBufferIndex]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray (GLint -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GLint
    numShaders) Ptr DrawBufferIndex
    buf
       return $ map Shader ids

    setAttachedShaders :: Program -> [Shader] -> IO ()
    setAttachedShaders :: Program -> [Shader] -> IO ()
    setAttachedShaders Program
    program [Shader]
    newShaders = do
       currentShaders <- Program -> IO [Shader]
    getAttachedShaders Program
    program
       mapM_ (attachShader program) (newShaders \\ currentShaders)
       mapM_ (detachShader program) (currentShaders \\ newShaders)

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

    linkProgram :: Program -> IO ()
    linkProgram :: Program -> IO ()
    linkProgram = DrawBufferIndex -> IO ()
    forall (m :: * -> *). MonadIO m => DrawBufferIndex -> m ()
    glLinkProgram (DrawBufferIndex -> IO ())
    -> (Program -> DrawBufferIndex) -> Program -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Program -> DrawBufferIndex
    programID

    currentProgram :: StateVar (Maybe Program)
    currentProgram :: StateVar (Maybe Program)
    currentProgram =
       IO (Maybe Program)
    -> (Maybe Program -> IO ()) -> StateVar (Maybe Program)
    forall a. IO a -> (a -> IO ()) -> StateVar a
    makeStateVar
          (do p <- (DrawBufferIndex -> Program) -> IO DrawBufferIndex -> IO Program
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DrawBufferIndex -> Program
    Program (IO DrawBufferIndex -> IO Program)
    -> IO DrawBufferIndex -> IO Program
    forall a b. (a -> b) -> a -> b
    $ (GLint -> DrawBufferIndex) -> PName1I -> IO DrawBufferIndex
    forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
    forall a. (GLint -> a) -> PName1I -> IO a
    getInteger1 GLint -> DrawBufferIndex
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral PName1I
    GetCurrentProgram
              return $ if p == noProgram then Nothing else Just p)
          (DrawBufferIndex -> IO ()
    forall (m :: * -> *). MonadIO m => DrawBufferIndex -> m ()
    glUseProgram (DrawBufferIndex -> IO ())
    -> (Maybe Program -> DrawBufferIndex) -> Maybe Program -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Program -> DrawBufferIndex
    programID (Program -> DrawBufferIndex)
    -> (Maybe Program -> Program) -> Maybe Program -> DrawBufferIndex
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Program -> Maybe Program -> Program
    forall a. a -> Maybe a -> a
    fromMaybe Program
    noProgram)

    noProgram :: Program
    noProgram :: Program
    noProgram = DrawBufferIndex -> Program
    Program DrawBufferIndex
    0

    validateProgram :: Program -> IO ()
    validateProgram :: Program -> IO ()
    validateProgram = DrawBufferIndex -> IO ()
    forall (m :: * -> *). MonadIO m => DrawBufferIndex -> m ()
    glValidateProgram (DrawBufferIndex -> IO ())
    -> (Program -> DrawBufferIndex) -> Program -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Program -> DrawBufferIndex
    programID

    programInfoLog :: Program -> GettableStateVar String
    programInfoLog :: Program -> GettableStateVar String
    programInfoLog =
       GettableStateVar String -> GettableStateVar String
    forall a. IO a -> IO a
    makeGettableStateVar (GettableStateVar String -> GettableStateVar String)
    -> (Program -> GettableStateVar String)
    -> Program
    -> GettableStateVar String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          (ByteString -> String) -> IO ByteString -> GettableStateVar String
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ByteString -> String
    unpackUtf8 (IO ByteString -> GettableStateVar String)
    -> (Program -> IO ByteString) -> Program -> GettableStateVar String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
             (Program -> GettableStateVar GLint)
    -> (Program -> GLint -> Ptr GLint -> Ptr GLchar -> IO ())
    -> Program
    -> IO ByteString
    forall a.
    (a -> GettableStateVar GLint)
    -> (a -> GLint -> Ptr GLint -> Ptr GLchar -> IO ())
    -> a
    -> IO ByteString
    stringQuery Program -> GettableStateVar GLint
    programInfoLogLength (DrawBufferIndex -> GLint -> Ptr GLint -> Ptr GLchar -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    DrawBufferIndex -> GLint -> Ptr GLint -> Ptr GLchar -> m ()
    glGetProgramInfoLog (DrawBufferIndex -> GLint -> Ptr GLint -> Ptr GLchar -> IO ())
    -> (Program -> DrawBufferIndex)
    -> Program
    -> GLint
    -> Ptr GLint
    -> Ptr GLchar
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Program -> DrawBufferIndex
    programID)

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

    programSeparable :: Program -> StateVar Bool
    programSeparable :: Program -> StateVar Bool
    programSeparable = GetProgramPName -> Program -> StateVar Bool
    programStateVarBool GetProgramPName
    ProgramSeparable

    programBinaryRetrievableHint :: Program -> StateVar Bool
    programBinaryRetrievableHint :: Program -> StateVar Bool
    programBinaryRetrievableHint = GetProgramPName -> Program -> StateVar Bool
    programStateVarBool GetProgramPName
    ProgramBinaryRetrievableHint

    programStateVarBool :: GetProgramPName -> Program -> StateVar Bool
    programStateVarBool :: GetProgramPName -> Program -> StateVar Bool
    programStateVarBool GetProgramPName
    pname Program
    program =
       GettableStateVar Bool -> (Bool -> IO ()) -> StateVar Bool
    forall a. IO a -> (a -> IO ()) -> StateVar a
    makeStateVar
          (GettableStateVar Bool -> GettableStateVar Bool
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Bool -> m Bool
    get ((GLint -> Bool)
    -> GetProgramPName -> Program -> GettableStateVar Bool
    forall a.
    (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
    programVar1 GLint -> Bool
    forall a. (Eq a, Num a) => a -> Bool
    unmarshalGLboolean GetProgramPName
    pname Program
    program))
          (DrawBufferIndex -> DrawBufferIndex -> GLint -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    DrawBufferIndex -> DrawBufferIndex -> GLint -> m ()
    glProgramParameteri (Program -> DrawBufferIndex
    programID Program
    program)
                               (GetProgramPName -> DrawBufferIndex
    marshalGetProgramPName GetProgramPName
    pname) (GLint -> IO ()) -> (Bool -> GLint) -> Bool -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> GLint
    forall a. Num a => Bool -> a
    marshalGLboolean)

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

    programDeleteStatus :: Program -> GettableStateVar Bool
    programDeleteStatus :: Program -> GettableStateVar Bool
    programDeleteStatus = (GLint -> Bool)
    -> GetProgramPName -> Program -> GettableStateVar Bool
    forall a.
    (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
    programVar1 GLint -> Bool
    forall a. (Eq a, Num a) => a -> Bool
    unmarshalGLboolean GetProgramPName
    ProgramDeleteStatus

    linkStatus :: Program -> GettableStateVar Bool
    linkStatus :: Program -> GettableStateVar Bool
    linkStatus = (GLint -> Bool)
    -> GetProgramPName -> Program -> GettableStateVar Bool
    forall a.
    (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
    programVar1 GLint -> Bool
    forall a. (Eq a, Num a) => a -> Bool
    unmarshalGLboolean GetProgramPName
    LinkStatus

    validateStatus :: Program -> GettableStateVar Bool
    validateStatus :: Program -> GettableStateVar Bool
    validateStatus = (GLint -> Bool)
    -> GetProgramPName -> Program -> GettableStateVar Bool
    forall a.
    (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
    programVar1 GLint -> Bool
    forall a. (Eq a, Num a) => a -> Bool
    unmarshalGLboolean GetProgramPName
    ValidateStatus

    programInfoLogLength :: Program -> GettableStateVar GLsizei
    programInfoLogLength :: Program -> GettableStateVar GLint
    programInfoLogLength = (GLint -> GLint)
    -> GetProgramPName -> Program -> GettableStateVar GLint
    forall a.
    (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
    programVar1 GLint -> GLint
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GetProgramPName
    ProgramInfoLogLength

    numAttachedShaders :: Program -> GettableStateVar GLsizei
    numAttachedShaders :: Program -> GettableStateVar GLint
    numAttachedShaders = (GLint -> GLint)
    -> GetProgramPName -> Program -> GettableStateVar GLint
    forall a.
    (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
    programVar1 GLint -> GLint
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GetProgramPName
    AttachedShaders

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

    -- | 'bindFragDataLocation' binds a varying variable, specified by program and name, to a
    -- drawbuffer. The effects only take place after succesfull linking of the program.
    -- invalid arguments and conditions are
    -- - an index larger than maxDrawBufferIndex
    -- - names starting with 'gl_'
    -- linking failure will ocure when
    -- - one of the arguments was invalid
    -- - more than one varying varuable name is bound to the same index
    -- It's not an error to specify unused variables, those will be ingored.
    bindFragDataLocation :: Program -> String -> SettableStateVar DrawBufferIndex
    bindFragDataLocation :: Program -> String -> SettableStateVar DrawBufferIndex
    bindFragDataLocation (Program DrawBufferIndex
    program) String
    varName = (DrawBufferIndex -> IO ()) -> SettableStateVar DrawBufferIndex
    forall a. (a -> IO ()) -> SettableStateVar a
    makeSettableStateVar ((DrawBufferIndex -> IO ()) -> SettableStateVar DrawBufferIndex)
    -> (DrawBufferIndex -> IO ()) -> SettableStateVar DrawBufferIndex
    forall a b. (a -> b) -> a -> b
    $ \DrawBufferIndex
    ind ->
       String -> (Ptr GLchar -> IO ()) -> IO ()
    forall a. String -> (Ptr GLchar -> IO a) -> IO a
    withGLstring String
    varName ((Ptr GLchar -> IO ()) -> IO ()) -> (Ptr GLchar -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ DrawBufferIndex -> DrawBufferIndex -> Ptr GLchar -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    DrawBufferIndex -> DrawBufferIndex -> Ptr GLchar -> m ()
    glBindFragDataLocation DrawBufferIndex
    program DrawBufferIndex
    ind

    -- | query the binding of a given variable, specified by program and name. The program has to be
    -- linked. The result is Nothing if an error occures or the name is not a name of a varying
    -- variable. If the program hasn't been linked an 'InvalidOperation' error is generated.
    getFragDataLocation :: Program -> String -> IO (Maybe DrawBufferIndex)
    getFragDataLocation :: Program -> String -> IO (Maybe DrawBufferIndex)
    getFragDataLocation (Program DrawBufferIndex
    program) String
    varName = do
       r <- String
    -> (Ptr GLchar -> GettableStateVar GLint) -> GettableStateVar GLint
    forall a. String -> (Ptr GLchar -> IO a) -> IO a
    withGLstring String
    varName ((Ptr GLchar -> GettableStateVar GLint) -> GettableStateVar GLint)
    -> (Ptr GLchar -> GettableStateVar GLint) -> GettableStateVar GLint
    forall a b. (a -> b) -> a -> b
    $ DrawBufferIndex -> Ptr GLchar -> GettableStateVar GLint
    forall (m :: * -> *).
    MonadIO m =>
    DrawBufferIndex -> Ptr GLchar -> m GLint
    glGetFragDataLocation DrawBufferIndex
    program
       if r < 0
        then return Nothing
        else return . Just $ fromIntegral r