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