module Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects (
Program, createProgram, programDeleteStatus,
attachShader, detachShader, attachedShaders,
linkProgram, linkStatus,
validateProgram, validateStatus,
programInfoLog,
currentProgram,
programSeparable, programBinaryRetrievableHint,
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DrawBufferIndex -> Program
Program forall (m :: * -> *). MonadIO m => m DrawBufferIndex
glCreateProgram
attachShader :: Program -> Shader -> IO ()
attachShader :: Program -> Shader -> IO ()
attachShader Program
p Shader
s = 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 = 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 =
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
GLint
numShaders <- forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (Program -> GettableStateVar GLint
numAttachedShaders Program
program)
[DrawBufferIndex]
ids <- forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
numShaders) forall a b. (a -> b) -> a -> b
$ \Ptr DrawBufferIndex
buf -> do
forall (m :: * -> *).
MonadIO m =>
DrawBufferIndex
-> GLint -> Ptr GLint -> Ptr DrawBufferIndex -> m ()
glGetAttachedShaders (Program -> DrawBufferIndex
programID Program
program) GLint
numShaders forall a. Ptr a
nullPtr Ptr DrawBufferIndex
buf
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
numShaders) Ptr DrawBufferIndex
buf
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DrawBufferIndex -> Shader
Shader [DrawBufferIndex]
ids
setAttachedShaders :: Program -> [Shader] -> IO ()
setAttachedShaders :: Program -> [Shader] -> IO ()
setAttachedShaders Program
program [Shader]
newShaders = do
[Shader]
currentShaders <- Program -> IO [Shader]
getAttachedShaders Program
program
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Program -> Shader -> IO ()
attachShader Program
program) ([Shader]
newShaders forall a. Eq a => [a] -> [a] -> [a]
\\ [Shader]
currentShaders)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Program -> Shader -> IO ()
detachShader Program
program) ([Shader]
currentShaders forall a. Eq a => [a] -> [a] -> [a]
\\ [Shader]
newShaders)
linkProgram :: Program -> IO ()
linkProgram :: Program -> IO ()
linkProgram = forall (m :: * -> *). MonadIO m => DrawBufferIndex -> m ()
glLinkProgram forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> DrawBufferIndex
programID
currentProgram :: StateVar (Maybe Program)
currentProgram :: StateVar (Maybe Program)
currentProgram =
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
(do Program
p <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DrawBufferIndex -> Program
Program forall a b. (a -> b) -> a -> b
$ forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 forall a b. (Integral a, Num b) => a -> b
fromIntegral PName1I
GetCurrentProgram
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Program
p forall a. Eq a => a -> a -> Bool
== Program
noProgram then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Program
p)
(forall (m :: * -> *). MonadIO m => DrawBufferIndex -> m ()
glUseProgram forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> DrawBufferIndex
programID forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *). MonadIO m => DrawBufferIndex -> m ()
glValidateProgram forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> DrawBufferIndex
programID
programInfoLog :: Program -> GettableStateVar String
programInfoLog :: Program -> GettableStateVar String
programInfoLog =
forall a. IO a -> IO a
makeGettableStateVar forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
unpackUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a.
(a -> GettableStateVar GLint)
-> (a -> GLint -> Ptr GLint -> Ptr GLchar -> IO ())
-> a
-> IO ByteString
stringQuery Program -> GettableStateVar GLint
programInfoLogLength (forall (m :: * -> *).
MonadIO m =>
DrawBufferIndex -> GLint -> Ptr GLint -> Ptr GLchar -> m ()
glGetProgramInfoLog 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 =
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
(forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (forall a.
(GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GetProgramPName
pname Program
program))
(forall (m :: * -> *).
MonadIO m =>
DrawBufferIndex -> DrawBufferIndex -> GLint -> m ()
glProgramParameteri (Program -> DrawBufferIndex
programID Program
program)
(GetProgramPName -> DrawBufferIndex
marshalGetProgramPName GetProgramPName
pname) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Bool -> a
marshalGLboolean)
programDeleteStatus :: Program -> GettableStateVar Bool
programDeleteStatus :: Program -> GettableStateVar Bool
programDeleteStatus = forall a.
(GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GetProgramPName
ProgramDeleteStatus
linkStatus :: Program -> GettableStateVar Bool
linkStatus :: Program -> GettableStateVar Bool
linkStatus = forall a.
(GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GetProgramPName
LinkStatus
validateStatus :: Program -> GettableStateVar Bool
validateStatus :: Program -> GettableStateVar Bool
validateStatus = forall a.
(GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GetProgramPName
ValidateStatus
programInfoLogLength :: Program -> GettableStateVar GLsizei
programInfoLogLength :: Program -> GettableStateVar GLint
programInfoLogLength = forall a.
(GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 forall a b. (Integral a, Num b) => a -> b
fromIntegral GetProgramPName
ProgramInfoLogLength
numAttachedShaders :: Program -> GettableStateVar GLsizei
numAttachedShaders :: Program -> GettableStateVar GLint
numAttachedShaders = forall a.
(GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 forall a b. (Integral a, Num b) => a -> b
fromIntegral GetProgramPName
AttachedShaders
bindFragDataLocation :: Program -> String -> SettableStateVar DrawBufferIndex
bindFragDataLocation :: Program -> String -> SettableStateVar DrawBufferIndex
bindFragDataLocation (Program DrawBufferIndex
program) String
varName = forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar forall a b. (a -> b) -> a -> b
$ \DrawBufferIndex
ind ->
forall a. String -> (Ptr GLchar -> IO a) -> IO a
withGLstring String
varName forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
DrawBufferIndex -> DrawBufferIndex -> Ptr GLchar -> m ()
glBindFragDataLocation DrawBufferIndex
program DrawBufferIndex
ind
getFragDataLocation :: Program -> String -> IO (Maybe DrawBufferIndex)
getFragDataLocation :: Program -> String -> IO (Maybe DrawBufferIndex)
getFragDataLocation (Program DrawBufferIndex
program) String
varName = do
GLint
r <- forall a. String -> (Ptr GLchar -> IO a) -> IO a
withGLstring String
varName forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
DrawBufferIndex -> Ptr GLchar -> m GLint
glGetFragDataLocation DrawBufferIndex
program
if GLint
r forall a. Ord a => a -> a -> Bool
< GLint
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
r