{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Variables
-- Copyright   :  (c) Sven Panne 2006-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This internal module contains the functions and data types used by the
-- Uniform and Attribs modules.
--
-----------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.Shaders.Variables (
    VariableType(..), unmarshalVariableType, activeVars
) where

import Control.Monad
import Data.StateVar
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.ByteString
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.Shaders.Program
import Graphics.GL

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

-- Table 2.9 of the OpenGL 3.1 spec: OpenGL Shading Language type tokens
data VariableType =
     Float'
   | FloatVec2
   | FloatVec3
   | FloatVec4
   | Int'
   | IntVec2
   | IntVec3
   | IntVec4
   | UnsignedInt'
   | UnsignedIntVec2
   | UnsignedIntVec3
   | UnsignedIntVec4
   | Bool
   | BoolVec2
   | BoolVec3
   | BoolVec4
   | FloatMat2
   | FloatMat3
   | FloatMat4
   | FloatMat2x3
   | FloatMat2x4
   | FloatMat3x2
   | FloatMat3x4
   | FloatMat4x2
   | FloatMat4x3
   | Sampler1D
   | Sampler2D
   | Sampler3D
   | SamplerCube
   | Sampler1DShadow
   | Sampler2DShadow
   | Sampler1DArray
   | Sampler2DArray
   | Sampler1DArrayShadow
   | Sampler2DArrayShadow
   | SamplerCubeShadow
   | Sampler2DRect
   | Sampler2DRectShadow
   | IntSampler1D
   | IntSampler2D
   | IntSampler3D
   | IntSamplerCube
   | IntSampler1DArray
   | IntSampler2DArray
   | UnsignedIntSampler1D
   | UnsignedIntSampler2D
   | UnsignedIntSampler3D
   | UnsignedIntSamplerCube
   | UnsignedIntSampler1DArray
   | UnsignedIntSampler2DArray
   deriving ( VariableType -> VariableType -> Bool
(VariableType -> VariableType -> Bool)
-> (VariableType -> VariableType -> Bool) -> Eq VariableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VariableType -> VariableType -> Bool
== :: VariableType -> VariableType -> Bool
$c/= :: VariableType -> VariableType -> Bool
/= :: VariableType -> VariableType -> Bool
Eq, Eq VariableType
Eq VariableType =>
(VariableType -> VariableType -> Ordering)
-> (VariableType -> VariableType -> Bool)
-> (VariableType -> VariableType -> Bool)
-> (VariableType -> VariableType -> Bool)
-> (VariableType -> VariableType -> Bool)
-> (VariableType -> VariableType -> VariableType)
-> (VariableType -> VariableType -> VariableType)
-> Ord VariableType
VariableType -> VariableType -> Bool
VariableType -> VariableType -> Ordering
VariableType -> VariableType -> VariableType
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 :: VariableType -> VariableType -> Ordering
compare :: VariableType -> VariableType -> Ordering
$c< :: VariableType -> VariableType -> Bool
< :: VariableType -> VariableType -> Bool
$c<= :: VariableType -> VariableType -> Bool
<= :: VariableType -> VariableType -> Bool
$c> :: VariableType -> VariableType -> Bool
> :: VariableType -> VariableType -> Bool
$c>= :: VariableType -> VariableType -> Bool
>= :: VariableType -> VariableType -> Bool
$cmax :: VariableType -> VariableType -> VariableType
max :: VariableType -> VariableType -> VariableType
$cmin :: VariableType -> VariableType -> VariableType
min :: VariableType -> VariableType -> VariableType
Ord, Int -> VariableType -> ShowS
[VariableType] -> ShowS
VariableType -> String
(Int -> VariableType -> ShowS)
-> (VariableType -> String)
-> ([VariableType] -> ShowS)
-> Show VariableType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VariableType -> ShowS
showsPrec :: Int -> VariableType -> ShowS
$cshow :: VariableType -> String
show :: VariableType -> String
$cshowList :: [VariableType] -> ShowS
showList :: [VariableType] -> ShowS
Show )

unmarshalVariableType :: GLenum -> VariableType
unmarshalVariableType :: GLenum -> VariableType
unmarshalVariableType GLenum
x
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT = VariableType
Float'
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_VEC2 = VariableType
FloatVec2
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_VEC3 = VariableType
FloatVec3
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_VEC4 = VariableType
FloatVec4
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT = VariableType
Int'
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT_VEC2 = VariableType
IntVec2
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT_VEC3 = VariableType
IntVec3
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT_VEC4 = VariableType
IntVec4
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT = VariableType
UnsignedInt'
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT_VEC2 = VariableType
UnsignedIntVec2
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT_VEC3 = VariableType
UnsignedIntVec3
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT_VEC4 = VariableType
UnsignedIntVec4
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_BOOL = VariableType
Bool
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_BOOL_VEC2 = VariableType
BoolVec2
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_BOOL_VEC3 = VariableType
BoolVec3
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_BOOL_VEC4 = VariableType
BoolVec4
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_MAT2 = VariableType
FloatMat2
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_MAT3 = VariableType
FloatMat3
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_MAT4 = VariableType
FloatMat4
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_MAT2x3 = VariableType
FloatMat2x3
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_MAT2x4 = VariableType
FloatMat2x4
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_MAT3x2 = VariableType
FloatMat3x2
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_MAT3x4 = VariableType
FloatMat3x4
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_MAT4x2 = VariableType
FloatMat4x2
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLOAT_MAT4x3 = VariableType
FloatMat4x3
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_1D = VariableType
Sampler1D
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_2D = VariableType
Sampler2D
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_3D = VariableType
Sampler3D
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_CUBE = VariableType
SamplerCube
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_1D_SHADOW = VariableType
Sampler1DShadow
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_2D_SHADOW = VariableType
Sampler2DShadow
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_1D_ARRAY = VariableType
Sampler1DArray
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_2D_ARRAY = VariableType
Sampler2DArray
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_1D_ARRAY_SHADOW = VariableType
Sampler1DArrayShadow
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_2D_ARRAY_SHADOW = VariableType
Sampler2DArrayShadow
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_CUBE_SHADOW = VariableType
SamplerCubeShadow
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_2D_RECT = VariableType
Sampler2DRect
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SAMPLER_2D_RECT_SHADOW = VariableType
Sampler2DRectShadow
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT_SAMPLER_1D = VariableType
IntSampler1D
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT_SAMPLER_2D = VariableType
IntSampler2D
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT_SAMPLER_3D = VariableType
IntSampler3D
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT_SAMPLER_CUBE = VariableType
IntSamplerCube
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT_SAMPLER_1D_ARRAY = VariableType
IntSampler1DArray
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INT_SAMPLER_2D_ARRAY = VariableType
IntSampler2DArray
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT_SAMPLER_1D = VariableType
UnsignedIntSampler1D
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT_SAMPLER_2D = VariableType
UnsignedIntSampler2D
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT_SAMPLER_3D = VariableType
UnsignedIntSampler3D
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT_SAMPLER_CUBE = VariableType
UnsignedIntSamplerCube
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT_SAMPLER_1D_ARRAY = VariableType
UnsignedIntSampler1DArray
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_UNSIGNED_INT_SAMPLER_2D_ARRAY = VariableType
UnsignedIntSampler2DArray
   | Bool
otherwise = String -> VariableType
forall a. HasCallStack => String -> a
error (String
"unmarshalVariableType: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
x)

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

activeVars :: (Program -> GettableStateVar GLuint)
           -> (Program -> GettableStateVar GLsizei)
           -> (GLuint -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ())
           -> (GLenum -> a)
           -> Program
           -> GettableStateVar [(GLint,a,String)]
activeVars :: forall a.
(Program -> GettableStateVar GLenum)
-> (Program -> GettableStateVar GLsizei)
-> (GLenum
    -> GLenum
    -> GLsizei
    -> Ptr GLsizei
    -> Ptr GLsizei
    -> Ptr GLenum
    -> Ptr GLchar
    -> IO ())
-> (GLenum -> a)
-> Program
-> GettableStateVar [(GLsizei, a, String)]
activeVars Program -> GettableStateVar GLenum
numVars Program -> GettableStateVar GLsizei
maxLength GLenum
-> GLenum
-> GLsizei
-> Ptr GLsizei
-> Ptr GLsizei
-> Ptr GLenum
-> Ptr GLchar
-> IO ()
getter GLenum -> a
unmarshalType p :: Program
p@(Program GLenum
program) =
   IO [(GLsizei, a, String)] -> IO [(GLsizei, a, String)]
forall a. IO a -> IO a
makeGettableStateVar (IO [(GLsizei, a, String)] -> IO [(GLsizei, a, String)])
-> IO [(GLsizei, a, String)] -> IO [(GLsizei, a, String)]
forall a b. (a -> b) -> a -> b
$ do
      GLenum
numActiveVars <- GettableStateVar GLenum -> GettableStateVar GLenum
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *).
MonadIO m =>
GettableStateVar GLenum -> m GLenum
get (Program -> GettableStateVar GLenum
numVars Program
p)
      GLsizei
maxLen <- GettableStateVar GLsizei -> GettableStateVar GLsizei
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *).
MonadIO m =>
GettableStateVar GLsizei -> m GLsizei
get (Program -> GettableStateVar GLsizei
maxLength Program
p)
      GLsizei
-> (Ptr GLsizei -> IO [(GLsizei, a, String)])
-> IO [(GLsizei, a, String)]
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLsizei
0 ((Ptr GLsizei -> IO [(GLsizei, a, String)])
 -> IO [(GLsizei, a, String)])
-> (Ptr GLsizei -> IO [(GLsizei, a, String)])
-> IO [(GLsizei, a, String)]
forall a b. (a -> b) -> a -> b
$ \Ptr GLsizei
nameLengthBuf ->
         GLsizei
-> (Ptr GLsizei -> IO [(GLsizei, a, String)])
-> IO [(GLsizei, a, String)]
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLsizei
0 ((Ptr GLsizei -> IO [(GLsizei, a, String)])
 -> IO [(GLsizei, a, String)])
-> (Ptr GLsizei -> IO [(GLsizei, a, String)])
-> IO [(GLsizei, a, String)]
forall a b. (a -> b) -> a -> b
$ \Ptr GLsizei
sizeBuf ->
            GLenum
-> (Ptr GLenum -> IO [(GLsizei, a, String)])
-> IO [(GLsizei, a, String)]
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLenum
0 ((Ptr GLenum -> IO [(GLsizei, a, String)])
 -> IO [(GLsizei, a, String)])
-> (Ptr GLenum -> IO [(GLsizei, a, String)])
-> IO [(GLsizei, a, String)]
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
typeBuf ->
               let ixs :: [GLenum]
ixs = if GLenum
numActiveVars GLenum -> GLenum -> Bool
forall a. Ord a => a -> a -> Bool
> GLenum
0 then [GLenum
0 .. GLenum
numActiveVarsGLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
-GLenum
1] else []
               in [GLenum]
-> (GLenum -> IO (GLsizei, a, String)) -> IO [(GLsizei, a, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [GLenum]
ixs ((GLenum -> IO (GLsizei, a, String)) -> IO [(GLsizei, a, String)])
-> (GLenum -> IO (GLsizei, a, String)) -> IO [(GLsizei, a, String)]
forall a b. (a -> b) -> a -> b
$ \GLenum
i -> do
                  ByteString
n <- GLsizei
-> (Ptr GLchar -> GettableStateVar GLsizei) -> IO ByteString
forall a b.
(Integral a, Integral b) =>
a -> (Ptr GLchar -> IO b) -> IO ByteString
createAndTrimByteString GLsizei
maxLen ((Ptr GLchar -> GettableStateVar GLsizei) -> IO ByteString)
-> (Ptr GLchar -> GettableStateVar GLsizei) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr GLchar
nameBuf -> do
                     GLenum
-> GLenum
-> GLsizei
-> Ptr GLsizei
-> Ptr GLsizei
-> Ptr GLenum
-> Ptr GLchar
-> IO ()
getter GLenum
program GLenum
i GLsizei
maxLen Ptr GLsizei
nameLengthBuf Ptr GLsizei
sizeBuf Ptr GLenum
typeBuf Ptr GLchar
nameBuf
                     Ptr GLsizei -> GettableStateVar GLsizei
forall a. Storable a => Ptr a -> IO a
peek Ptr GLsizei
nameLengthBuf
                  GLsizei
s <- (GLsizei -> GLsizei) -> Ptr GLsizei -> GettableStateVar GLsizei
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLsizei -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ptr GLsizei
sizeBuf
                  a
t <- (GLenum -> a) -> Ptr GLenum -> IO a
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLenum -> a
unmarshalType Ptr GLenum
typeBuf
                  (GLsizei, a, String) -> IO (GLsizei, a, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GLsizei
s, a
t, ByteString -> String
unpackUtf8 ByteString
n)