{-# OPTIONS_HADDOCK hide #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Program
-- Copyright   :  (c) Sven Panne 2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This is a purely internal module for handling program objects and related
-- queries.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.Shaders.Program (
   Program(..),
   GetProgramPName(..), marshalGetProgramPName,
   programVar1, programVar3
) where

import Control.Monad.IO.Class
import Data.ObjectName
import Data.StateVar
import Foreign.Marshal.Utils ( with )
import Foreign.Ptr ( Ptr )
import Graphics.Rendering.OpenGL.GL.DebugOutput
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.GL

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

newtype Program = Program { Program -> GLuint
programID :: GLuint }
   deriving ( Program -> Program -> Bool
(Program -> Program -> Bool)
-> (Program -> Program -> Bool) -> Eq Program
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Program -> Program -> Bool
$c/= :: Program -> Program -> Bool
== :: Program -> Program -> Bool
$c== :: Program -> Program -> Bool
Eq, Eq Program
Eq Program =>
(Program -> Program -> Ordering)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Program)
-> (Program -> Program -> Program)
-> Ord Program
Program -> Program -> Bool
Program -> Program -> Ordering
Program -> Program -> Program
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 :: Program -> Program -> Program
$cmin :: Program -> Program -> Program
max :: Program -> Program -> Program
$cmax :: Program -> Program -> Program
>= :: Program -> Program -> Bool
$c>= :: Program -> Program -> Bool
> :: Program -> Program -> Bool
$c> :: Program -> Program -> Bool
<= :: Program -> Program -> Bool
$c<= :: Program -> Program -> Bool
< :: Program -> Program -> Bool
$c< :: Program -> Program -> Bool
compare :: Program -> Program -> Ordering
$ccompare :: Program -> Program -> Ordering
$cp1Ord :: Eq Program
Ord, Int -> Program -> ShowS
[Program] -> ShowS
Program -> String
(Int -> Program -> ShowS)
-> (Program -> String) -> ([Program] -> ShowS) -> Show Program
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Program] -> ShowS
$cshowList :: [Program] -> ShowS
show :: Program -> String
$cshow :: Program -> String
showsPrec :: Int -> Program -> ShowS
$cshowsPrec :: Int -> Program -> ShowS
Show )

instance ObjectName Program where
   isObjectName :: Program -> m Bool
isObjectName = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> (Program -> IO Bool) -> Program -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLboolean -> Bool) -> IO GLboolean -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLboolean -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean (IO GLboolean -> IO Bool)
-> (Program -> IO GLboolean) -> Program -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLuint -> IO GLboolean
forall (m :: * -> *). MonadIO m => GLuint -> m GLboolean
glIsProgram (GLuint -> IO GLboolean)
-> (Program -> GLuint) -> Program -> IO GLboolean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> GLuint
programID
   deleteObjectName :: Program -> m ()
deleteObjectName = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Program -> IO ()) -> Program -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glDeleteProgram (GLuint -> IO ()) -> (Program -> GLuint) -> Program -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> GLuint
programID

instance CanBeLabeled Program where
   objectLabel :: Program -> StateVar (Maybe String)
objectLabel = GLuint -> GLuint -> StateVar (Maybe String)
objectNameLabel GLuint
GL_PROGRAM (GLuint -> StateVar (Maybe String))
-> (Program -> GLuint) -> Program -> StateVar (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> GLuint
programID

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

data GetProgramPName =
     ProgramDeleteStatus
   | LinkStatus
   | ValidateStatus
   | ProgramInfoLogLength
   | AttachedShaders
   | ActiveAttributes
   | ActiveAttributeMaxLength
   | ActiveUniforms
   | ActiveUniformMaxLength
   | TransformFeedbackBufferMode
   | TransformFeedbackVaryings
   | TransformFeedbackVaryingMaxLength
   | ActiveUniformBlocks
   | ActiveUniformBlockMaxNameLength
   | GeometryVerticesOut
   | GeometryInputType
   | GeometryOutputType
   | GeometryShaderInvocations
   | TessControlOutputVertices
   | TessGenMode
   | TessGenSpacing
   | TessGenVertexOrder
   | TessGenPointMode
   | ComputeWorkGroupSize  -- 3 integers!
   | ProgramSeparable
   | ProgramBinaryRetrievableHint
   | ActiveAtomicCounterBuffers
   | ProgramBinaryLength

marshalGetProgramPName :: GetProgramPName -> GLenum
marshalGetProgramPName :: GetProgramPName -> GLuint
marshalGetProgramPName x :: GetProgramPName
x = case GetProgramPName
x of
   ProgramDeleteStatus -> GLuint
GL_DELETE_STATUS
   LinkStatus -> GLuint
GL_LINK_STATUS
   ValidateStatus -> GLuint
GL_VALIDATE_STATUS
   ProgramInfoLogLength -> GLuint
GL_INFO_LOG_LENGTH
   AttachedShaders -> GLuint
GL_ATTACHED_SHADERS
   ActiveAttributes -> GLuint
GL_ACTIVE_ATTRIBUTES
   ActiveAttributeMaxLength -> GLuint
GL_ACTIVE_ATTRIBUTE_MAX_LENGTH
   ActiveUniforms -> GLuint
GL_ACTIVE_UNIFORMS
   ActiveUniformMaxLength -> GLuint
GL_ACTIVE_UNIFORM_MAX_LENGTH
   TransformFeedbackBufferMode -> GLuint
GL_TRANSFORM_FEEDBACK_BUFFER_MODE
   TransformFeedbackVaryings -> GLuint
GL_TRANSFORM_FEEDBACK_VARYINGS
   TransformFeedbackVaryingMaxLength -> GLuint
GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH
   ActiveUniformBlocks -> GLuint
GL_ACTIVE_UNIFORM_BLOCKS
   ActiveUniformBlockMaxNameLength -> GLuint
GL_ACTIVE_UNIFORM_BLOCK_MAX_NAME_LENGTH
   GeometryVerticesOut -> GLuint
GL_GEOMETRY_VERTICES_OUT
   GeometryInputType -> GLuint
GL_GEOMETRY_INPUT_TYPE
   GeometryOutputType -> GLuint
GL_GEOMETRY_OUTPUT_TYPE
   GeometryShaderInvocations -> GLuint
GL_GEOMETRY_SHADER_INVOCATIONS
   TessControlOutputVertices -> GLuint
GL_TESS_CONTROL_OUTPUT_VERTICES
   TessGenMode -> GLuint
GL_TESS_GEN_MODE
   TessGenSpacing -> GLuint
GL_TESS_GEN_SPACING
   TessGenVertexOrder -> GLuint
GL_TESS_GEN_VERTEX_ORDER
   TessGenPointMode -> GLuint
GL_TESS_GEN_POINT_MODE
   ComputeWorkGroupSize -> GLuint
GL_COMPUTE_WORK_GROUP_SIZE
   ProgramSeparable -> GLuint
GL_PROGRAM_SEPARABLE
   ProgramBinaryRetrievableHint -> GLuint
GL_PROGRAM_BINARY_RETRIEVABLE_HINT
   ActiveAtomicCounterBuffers -> GLuint
GL_ACTIVE_ATOMIC_COUNTER_BUFFERS
   ProgramBinaryLength -> GLuint
GL_PROGRAM_BINARY_LENGTH

programVar1 :: (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 :: (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 = (Ptr GLint -> GettableStateVar a)
-> GetProgramPName -> Program -> GettableStateVar a
forall a. (Ptr GLint -> IO a) -> GetProgramPName -> Program -> IO a
programVarN ((Ptr GLint -> GettableStateVar a)
 -> GetProgramPName -> Program -> GettableStateVar a)
-> ((GLint -> a) -> Ptr GLint -> GettableStateVar a)
-> (GLint -> a)
-> GetProgramPName
-> Program
-> GettableStateVar a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLint -> a) -> Ptr GLint -> GettableStateVar a
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1

programVar3 :: (GLint -> GLint -> GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar3 :: (GLint -> GLint -> GLint -> a)
-> GetProgramPName -> Program -> GettableStateVar a
programVar3 = (Ptr GLint -> GettableStateVar a)
-> GetProgramPName -> Program -> GettableStateVar a
forall a. (Ptr GLint -> IO a) -> GetProgramPName -> Program -> IO a
programVarN ((Ptr GLint -> GettableStateVar a)
 -> GetProgramPName -> Program -> GettableStateVar a)
-> ((GLint -> GLint -> GLint -> a)
    -> Ptr GLint -> GettableStateVar a)
-> (GLint -> GLint -> GLint -> a)
-> GetProgramPName
-> Program
-> GettableStateVar a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLint -> GLint -> GLint -> a) -> Ptr GLint -> GettableStateVar a
forall a b. Storable a => (a -> a -> a -> b) -> Ptr a -> IO b
peek3

programVarN :: (Ptr GLint -> IO a) -> GetProgramPName -> Program -> GettableStateVar a
programVarN :: (Ptr GLint -> IO a) -> GetProgramPName -> Program -> IO a
programVarN f :: Ptr GLint -> IO a
f p :: GetProgramPName
p program :: Program
program =
   IO a -> IO a
forall a. IO a -> IO a
makeGettableStateVar (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
      GLint -> (Ptr GLint -> IO a) -> IO a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 0 ((Ptr GLint -> IO a) -> IO a) -> (Ptr GLint -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \buf :: Ptr GLint
buf -> do
         GLuint -> GLuint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLint -> m ()
glGetProgramiv (Program -> GLuint
programID Program
program) (GetProgramPName -> GLuint
marshalGetProgramPName GetProgramPName
p) Ptr GLint
buf
         Ptr GLint -> IO a
f Ptr GLint
buf