module Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects (
shaderCompiler,
ShaderType(..), Shader, createShader,
shaderSourceBS, shaderSource, compileShader, releaseShaderCompiler,
shaderType, shaderDeleteStatus, compileStatus, shaderInfoLog,
PrecisionType, shaderPrecisionFormat,
packUtf8, unpackUtf8
) where
import Control.Monad
import Data.StateVar
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.ByteString
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.Shaders.Shader
import Graphics.GL
shaderCompiler :: GettableStateVar Bool
shaderCompiler :: GettableStateVar Bool
shaderCompiler =
forall a. IO a -> IO a
makeGettableStateVar (forall p a. GetPName1I p => (GLboolean -> a) -> p -> IO a
getBoolean1 forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean PName1I
GetShaderCompiler)
data ShaderType =
VertexShader
| TessControlShader
| TessEvaluationShader
| GeometryShader
| FragmentShader
| ComputeShader
deriving ( ShaderType -> ShaderType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderType -> ShaderType -> Bool
$c/= :: ShaderType -> ShaderType -> Bool
== :: ShaderType -> ShaderType -> Bool
$c== :: ShaderType -> ShaderType -> Bool
Eq, Eq ShaderType
ShaderType -> ShaderType -> Bool
ShaderType -> ShaderType -> Ordering
ShaderType -> ShaderType -> ShaderType
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 :: ShaderType -> ShaderType -> ShaderType
$cmin :: ShaderType -> ShaderType -> ShaderType
max :: ShaderType -> ShaderType -> ShaderType
$cmax :: ShaderType -> ShaderType -> ShaderType
>= :: ShaderType -> ShaderType -> Bool
$c>= :: ShaderType -> ShaderType -> Bool
> :: ShaderType -> ShaderType -> Bool
$c> :: ShaderType -> ShaderType -> Bool
<= :: ShaderType -> ShaderType -> Bool
$c<= :: ShaderType -> ShaderType -> Bool
< :: ShaderType -> ShaderType -> Bool
$c< :: ShaderType -> ShaderType -> Bool
compare :: ShaderType -> ShaderType -> Ordering
$ccompare :: ShaderType -> ShaderType -> Ordering
Ord, Int -> ShaderType -> ShowS
[ShaderType] -> ShowS
ShaderType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderType] -> ShowS
$cshowList :: [ShaderType] -> ShowS
show :: ShaderType -> String
$cshow :: ShaderType -> String
showsPrec :: Int -> ShaderType -> ShowS
$cshowsPrec :: Int -> ShaderType -> ShowS
Show )
marshalShaderType :: ShaderType -> GLenum
marshalShaderType :: ShaderType -> GLenum
marshalShaderType ShaderType
x = case ShaderType
x of
ShaderType
VertexShader -> GLenum
GL_VERTEX_SHADER
ShaderType
TessControlShader -> GLenum
GL_TESS_CONTROL_SHADER
ShaderType
TessEvaluationShader -> GLenum
GL_TESS_EVALUATION_SHADER
ShaderType
GeometryShader -> GLenum
GL_GEOMETRY_SHADER
ShaderType
FragmentShader -> GLenum
GL_FRAGMENT_SHADER
ShaderType
ComputeShader -> GLenum
GL_COMPUTE_SHADER
unmarshalShaderType :: GLenum -> ShaderType
unmarshalShaderType :: GLenum -> ShaderType
unmarshalShaderType GLenum
x
| GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_VERTEX_SHADER = ShaderType
VertexShader
| GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_TESS_CONTROL_SHADER = ShaderType
TessControlShader
| GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_TESS_EVALUATION_SHADER = ShaderType
TessEvaluationShader
| GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_GEOMETRY_SHADER = ShaderType
GeometryShader
| GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_FRAGMENT_SHADER = ShaderType
FragmentShader
| GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_COMPUTE_SHADER = ShaderType
ComputeShader
| Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalShaderType: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x)
createShader :: ShaderType -> IO Shader
createShader :: ShaderType -> IO Shader
createShader = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLenum -> Shader
Shader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => GLenum -> m GLenum
glCreateShader forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShaderType -> GLenum
marshalShaderType
shaderSourceBS :: Shader -> StateVar ByteString
shaderSourceBS :: Shader -> StateVar ByteString
shaderSourceBS Shader
shader =
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (Shader -> IO ByteString
getShaderSource Shader
shader) (Shader -> ByteString -> IO ()
setShaderSource Shader
shader)
getShaderSource :: Shader -> IO ByteString
getShaderSource :: Shader -> IO ByteString
getShaderSource = forall a.
(a -> GettableStateVar GLint)
-> (a -> GLint -> Ptr GLint -> Ptr GLchar -> IO ())
-> a
-> IO ByteString
stringQuery Shader -> GettableStateVar GLint
shaderSourceLength (forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLint -> Ptr GLchar -> m ()
glGetShaderSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shader -> GLenum
shaderID)
shaderSourceLength :: Shader -> GettableStateVar GLsizei
shaderSourceLength :: Shader -> GettableStateVar GLint
shaderSourceLength = forall a.
(GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar forall a b. (Integral a, Num b) => a -> b
fromIntegral GetShaderPName
ShaderSourceLength
setShaderSource :: Shader -> ByteString -> IO ()
setShaderSource :: Shader -> ByteString -> IO ()
setShaderSource Shader
shader ByteString
src =
forall b. ByteString -> (Ptr GLchar -> GLint -> IO b) -> IO b
withByteString ByteString
src forall a b. (a -> b) -> a -> b
$ \Ptr GLchar
srcPtr GLint
srcLength ->
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr GLchar
srcPtr forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr GLchar)
srcPtrBuf ->
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLint
srcLength forall a b. (a -> b) -> a -> b
$ \Ptr GLint
srcLengthBuf ->
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr (Ptr GLchar) -> Ptr GLint -> m ()
glShaderSource (Shader -> GLenum
shaderID Shader
shader) GLint
1 Ptr (Ptr GLchar)
srcPtrBuf Ptr GLint
srcLengthBuf
{-# DEPRECATED shaderSource "Use a combination of 'shaderSourceBS' and 'packUtf8' or 'unpackUtf8' instead." #-}
shaderSource :: Shader -> StateVar [String]
shaderSource :: Shader -> StateVar [String]
shaderSource Shader
shader =
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpackUtf8) forall a b. (a -> b) -> a -> b
$ forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (Shader -> StateVar ByteString
shaderSourceBS Shader
shader))
((Shader -> StateVar ByteString
shaderSourceBS Shader
shader forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
packUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
compileShader :: Shader -> IO ()
compileShader :: Shader -> IO ()
compileShader = forall (m :: * -> *). MonadIO m => GLenum -> m ()
glCompileShader forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shader -> GLenum
shaderID
releaseShaderCompiler :: IO ()
releaseShaderCompiler :: IO ()
releaseShaderCompiler = forall (m :: * -> *). MonadIO m => m ()
glReleaseShaderCompiler
shaderType :: Shader -> GettableStateVar ShaderType
shaderType :: Shader -> GettableStateVar ShaderType
shaderType = forall a.
(GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar (GLenum -> ShaderType
unmarshalShaderType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) GetShaderPName
ShaderType
shaderDeleteStatus :: Shader -> GettableStateVar Bool
shaderDeleteStatus :: Shader -> GettableStateVar Bool
shaderDeleteStatus = forall a.
(GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GetShaderPName
ShaderDeleteStatus
compileStatus :: Shader -> GettableStateVar Bool
compileStatus :: Shader -> GettableStateVar Bool
compileStatus = forall a.
(GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GetShaderPName
CompileStatus
shaderInfoLog :: Shader -> GettableStateVar String
shaderInfoLog :: Shader -> GettableStateVar String
shaderInfoLog =
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 Shader -> GettableStateVar GLint
shaderInfoLogLength (forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLint -> Ptr GLchar -> m ()
glGetShaderInfoLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shader -> GLenum
shaderID)
shaderInfoLogLength :: Shader -> GettableStateVar GLsizei
shaderInfoLogLength :: Shader -> GettableStateVar GLint
shaderInfoLogLength = forall a.
(GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar forall a b. (Integral a, Num b) => a -> b
fromIntegral GetShaderPName
ShaderInfoLogLength
data GetShaderPName =
ShaderDeleteStatus
| CompileStatus
| ShaderInfoLogLength
| ShaderSourceLength
| ShaderType
marshalGetShaderPName :: GetShaderPName -> GLenum
marshalGetShaderPName :: GetShaderPName -> GLenum
marshalGetShaderPName GetShaderPName
x = case GetShaderPName
x of
GetShaderPName
ShaderDeleteStatus -> GLenum
GL_DELETE_STATUS
GetShaderPName
CompileStatus -> GLenum
GL_COMPILE_STATUS
GetShaderPName
ShaderInfoLogLength -> GLenum
GL_INFO_LOG_LENGTH
GetShaderPName
ShaderSourceLength -> GLenum
GL_SHADER_SOURCE_LENGTH
GetShaderPName
ShaderType -> GLenum
GL_SHADER_TYPE
shaderVar :: (GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar :: forall a.
(GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar GLint -> a
f GetShaderPName
p Shader
shader =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLint
0 forall a b. (a -> b) -> a -> b
$ \Ptr GLint
buf -> do
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glGetShaderiv (Shader -> GLenum
shaderID Shader
shader) (GetShaderPName -> GLenum
marshalGetShaderPName GetShaderPName
p) Ptr GLint
buf
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLint -> a
f Ptr GLint
buf
data PrecisionType =
LowFloat
| MediumFloat
| HighFloat
| LowInt
| MediumInt
| HighInt
deriving ( PrecisionType -> PrecisionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrecisionType -> PrecisionType -> Bool
$c/= :: PrecisionType -> PrecisionType -> Bool
== :: PrecisionType -> PrecisionType -> Bool
$c== :: PrecisionType -> PrecisionType -> Bool
Eq, Eq PrecisionType
PrecisionType -> PrecisionType -> Bool
PrecisionType -> PrecisionType -> Ordering
PrecisionType -> PrecisionType -> PrecisionType
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 :: PrecisionType -> PrecisionType -> PrecisionType
$cmin :: PrecisionType -> PrecisionType -> PrecisionType
max :: PrecisionType -> PrecisionType -> PrecisionType
$cmax :: PrecisionType -> PrecisionType -> PrecisionType
>= :: PrecisionType -> PrecisionType -> Bool
$c>= :: PrecisionType -> PrecisionType -> Bool
> :: PrecisionType -> PrecisionType -> Bool
$c> :: PrecisionType -> PrecisionType -> Bool
<= :: PrecisionType -> PrecisionType -> Bool
$c<= :: PrecisionType -> PrecisionType -> Bool
< :: PrecisionType -> PrecisionType -> Bool
$c< :: PrecisionType -> PrecisionType -> Bool
compare :: PrecisionType -> PrecisionType -> Ordering
$ccompare :: PrecisionType -> PrecisionType -> Ordering
Ord, Int -> PrecisionType -> ShowS
[PrecisionType] -> ShowS
PrecisionType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrecisionType] -> ShowS
$cshowList :: [PrecisionType] -> ShowS
show :: PrecisionType -> String
$cshow :: PrecisionType -> String
showsPrec :: Int -> PrecisionType -> ShowS
$cshowsPrec :: Int -> PrecisionType -> ShowS
Show )
marshalPrecisionType :: PrecisionType -> GLenum
marshalPrecisionType :: PrecisionType -> GLenum
marshalPrecisionType PrecisionType
x = case PrecisionType
x of
PrecisionType
LowFloat -> GLenum
GL_LOW_FLOAT
PrecisionType
MediumFloat -> GLenum
GL_MEDIUM_FLOAT
PrecisionType
HighFloat -> GLenum
GL_HIGH_FLOAT
PrecisionType
LowInt -> GLenum
GL_LOW_INT
PrecisionType
MediumInt -> GLenum
GL_MEDIUM_INT
PrecisionType
HighInt -> GLenum
GL_HIGH_INT
shaderPrecisionFormat :: ShaderType
-> PrecisionType
-> GettableStateVar ((GLint,GLint),GLint)
shaderPrecisionFormat :: ShaderType
-> PrecisionType -> GettableStateVar ((GLint, GLint), GLint)
shaderPrecisionFormat ShaderType
st PrecisionType
pt =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 forall a b. (a -> b) -> a -> b
$ \Ptr GLint
rangeBuf ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GLint
precisionBuf -> do
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> Ptr GLint -> m ()
glGetShaderPrecisionFormat (ShaderType -> GLenum
marshalShaderType ShaderType
st)
(PrecisionType -> GLenum
marshalPrecisionType PrecisionType
pt)
Ptr GLint
rangeBuf
Ptr GLint
precisionBuf
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (forall a b. Storable a => (a -> a -> b) -> Ptr a -> IO b
peek2 (,) Ptr GLint
rangeBuf) (forall a. Storable a => Ptr a -> IO a
peek Ptr GLint
precisionBuf)