License | BSD3 |
---|---|
Maintainer | ziocroc@gmail.com |
Stability | experimental |
Portability | GHC only |
Safe Haskell | None |
Language | Haskell2010 |
- module Graphics.Rendering.Ombra.Shader.Language
- data ShaderStage
- data Shader s i o
- type VertexShader = Shader VertexShaderStage
- type FragmentShader = Shader FragmentShaderStage
- uniform :: forall u s. Uniform u => Shader s (CPUUniform u) u
- (~~) :: Uniform u => Shader s (u, i) o -> CPUUniform u -> Shader s i o
- foldUniforms :: forall a u s. (ShaderInput a, ArrayUniform u, GLES) => Shader s ((a -> u -> a, a), [CPUBase u]) a
- data UniformSetter x
- shader :: (MultiShaderType i, MultiShaderType o) => Shader s i o -> Shader s i o
- sarr :: (MultiShaderType i, MultiShaderType o) => (i -> o) -> Shader s i o
- shaderParam :: (HasTrie p, MultiShaderType i, MultiShaderType o) => Shader s (p, i) o -> Shader s (p, i) o
- pshader :: (HasTrie p, MultiShaderType i, MultiShaderType o) => (p -> Shader s i o) -> p -> Shader s i o
- ushader :: (MultiShaderType i, MultiShaderType o) => (UniformSetter x -> Shader s i o) -> UniformSetter x -> Shader s i o
- pushader :: (HasTrie p, MultiShaderType i, MultiShaderType o) => (p -> UniformSetter x -> Shader s i o) -> p -> UniformSetter x -> Shader s i o
- uniform' :: Uniform u => Shader s (UniformSetter (CPUUniform u)) u
- (~*) :: Uniform u => Shader s (u, i) o -> UniformSetter (CPUUniform u) -> Shader s i o
- data Fragment = Fragment {}
- farr :: (MultiShaderType i, MultiShaderType o) => (Fragment -> i -> o) -> FragmentShader i o
- fragment :: FragmentShader a Fragment
- forLoop :: ShaderInput a => Int -> a -> (GInt -> a -> (a, GBool)) -> a
- foldGArray :: forall t n a. (ShaderType t, KnownNat n, ShaderInput a) => (a -> t -> a) -> a -> GArray n t -> a
- class HasTrie (ExprMST a) => MultiShaderType a where
- type ExprMST a
- class MultiShaderType a => ShaderInput a where
- class (MultiShaderType o, KnownNat (NFloats o)) => FragmentShaderOutput o where
- class MapShader f s | f -> s where
- class ShaderInput a => Uniform a where
- type CPUUniform a
Documentation
A function that runs in the GPU.
type VertexShader = Shader VertexShaderStage Source #
A shader that transforms vertices.
type FragmentShader = Shader FragmentShaderStage Source #
A shader that transforms fragments.
Uniforms
uniform :: forall u s. Uniform u => Shader s (CPUUniform u) u Source #
Add a shader variable that can be set with a CPU value.
(~~) :: Uniform u => Shader s (u, i) o -> CPUUniform u -> Shader s i o infixl 9 Source #
Add a uniform and directly set it with the second operand.
foldUniforms :: forall a u s. (ShaderInput a, ArrayUniform u, GLES) => Shader s ((a -> u -> a, a), [CPUBase u]) a Source #
Optimized shaders
data UniformSetter x Source #
shader :: (MultiShaderType i, MultiShaderType o) => Shader s i o -> Shader s i o Source #
Create a shader function that can be reused efficiently.
sarr :: (MultiShaderType i, MultiShaderType o) => (i -> o) -> Shader s i o Source #
shaderParam :: (HasTrie p, MultiShaderType i, MultiShaderType o) => Shader s (p, i) o -> Shader s (p, i) o Source #
This variant of shader
can be used with shaders that have a mostly static
parameter. It will create a different shader every time the parameter changes
to a new value, therefore parameters should not be used for things like
model matrices (for which uniforms are more appropriate). Unlike uniforms,
parameters can be used anywhere, in particular they can be used to change the
shader structure.
pshader :: (HasTrie p, MultiShaderType i, MultiShaderType o) => (p -> Shader s i o) -> p -> Shader s i o Source #
See shaderParam
.
ushader :: (MultiShaderType i, MultiShaderType o) => (UniformSetter x -> Shader s i o) -> UniformSetter x -> Shader s i o Source #
shader
with an additional parameter that can be used to set the values of
the uniforms.
pushader :: (HasTrie p, MultiShaderType i, MultiShaderType o) => (p -> UniformSetter x -> Shader s i o) -> p -> UniformSetter x -> Shader s i o Source #
uniform' :: Uniform u => Shader s (UniformSetter (CPUUniform u)) u Source #
Like uniform
but uses a UniformSetter
.
(~*) :: Uniform u => Shader s (u, i) o -> UniformSetter (CPUUniform u) -> Shader s i o infixl 9 Source #
Add a uniform and directly set it with a UniformSetter
.
Fragment shader functionalities
Fragment | |
|
farr :: (MultiShaderType i, MultiShaderType o) => (Fragment -> i -> o) -> FragmentShader i o Source #
Loops
:: ShaderInput a | |
=> Int | Maximum number of iterations (should be as low as possible) |
-> a | Initial value |
-> (GInt -> a -> (a, GBool)) | Iteration -> Old value -> (Next, Stop) |
-> a |
This function implements raw GLSL loops. The same effect can be achieved using Haskell list functions, but that may result in a large compiled GLSL source, which in turn might slow down compilation or cause an out of memory error.
foldGArray :: forall t n a. (ShaderType t, KnownNat n, ShaderInput a) => (a -> t -> a) -> a -> GArray n t -> a Source #
Classes
class HasTrie (ExprMST a) => MultiShaderType a where Source #
Types that contain zero or more ShaderType
s.
mapMST :: (forall x. ShaderType x => x -> x) -> a -> a Source #
mapMST :: (Generic a, GMultiShaderType (Rep a)) => (forall x. ShaderType x => x -> x) -> a -> a Source #
foldrMST :: (forall x. ShaderType x => x -> b -> b) -> b -> a -> b Source #
foldrMST :: (Generic a, GMultiShaderType (Rep a)) => (forall x. ShaderType x => x -> b -> b) -> b -> a -> b Source #
toExprMST :: a -> ExprMST a Source #
toExprMST :: (Generic a, GMultiShaderType (Rep a), ExprMST a ~ GExprMST (Rep a)) => a -> ExprMST a Source #
fromExprMST :: ExprMST a -> a Source #
fromExprMST :: (Generic a, GMultiShaderType (Rep a), ExprMST a ~ GExprMST (Rep a)) => ExprMST a -> a Source #
MultiShaderType () Source # | |
MultiShaderType GMat4 Source # | |
MultiShaderType GMat3 Source # | |
MultiShaderType GMat2 Source # | |
MultiShaderType GBVec4 Source # | |
MultiShaderType GBVec3 Source # | |
MultiShaderType GBVec2 Source # | |
MultiShaderType GIVec4 Source # | |
MultiShaderType GIVec3 Source # | |
MultiShaderType GIVec2 Source # | |
MultiShaderType GVec4 Source # | |
MultiShaderType GVec3 Source # | |
MultiShaderType GVec2 Source # | |
MultiShaderType GInt Source # | |
MultiShaderType GFloat Source # | |
MultiShaderType GBool Source # | |
MultiShaderType a => MultiShaderType [a] Source # | |
MultiShaderType (DepthBufferSampler t) Source # | |
(ShaderInput a, MultiShaderType b) => MultiShaderType (a -> b) Source # | |
(MultiShaderType a, MultiShaderType b) => MultiShaderType (a, b) Source # | |
(KnownNat n, ShaderType t) => MultiShaderType (GArray n t) Source # | |
FragmentShaderOutput o => MultiShaderType (GBufferSampler t o) Source # | |
(MultiShaderType a, MultiShaderType b, MultiShaderType c) => MultiShaderType (a, b, c) Source # | |
class MultiShaderType a => ShaderInput a where Source #
Types that contain a finite amount of ShaderType
s.
buildMST :: (forall x. ShaderType x => Int -> x) -> Int -> (a, Int) Source #
buildMST :: (Generic a, GShaderInput (Rep a)) => (forall x. ShaderType x => Int -> x) -> Int -> (a, Int) Source #
ShaderInput () Source # | |
ShaderInput GMat4 Source # | |
ShaderInput GMat3 Source # | |
ShaderInput GMat2 Source # | |
ShaderInput GBVec4 Source # | |
ShaderInput GBVec3 Source # | |
ShaderInput GBVec2 Source # | |
ShaderInput GIVec4 Source # | |
ShaderInput GIVec3 Source # | |
ShaderInput GIVec2 Source # | |
ShaderInput GVec4 Source # | |
ShaderInput GVec3 Source # | |
ShaderInput GVec2 Source # | |
ShaderInput GInt Source # | |
ShaderInput GFloat Source # | |
ShaderInput GBool Source # | |
ShaderInput (DepthBufferSampler t) Source # | |
(ShaderInput a, ShaderInput b) => ShaderInput (a, b) Source # | |
(KnownNat n, ShaderType t) => ShaderInput (GArray n t) Source # | |
FragmentShaderOutput o => ShaderInput (GBufferSampler t o) Source # | |
(ShaderInput a, ShaderInput b, ShaderInput c) => ShaderInput (a, b, c) Source # | |
class (MultiShaderType o, KnownNat (NFloats o)) => FragmentShaderOutput o where Source #
Types that contain GFloat
s.
fromGFloats :: [GFloat] -> (o, [GFloat]) Source #
fromGFloats :: (Generic o, GFragmentShaderOutput (Rep o)) => [GFloat] -> (o, [GFloat]) Source #
toGFloats :: o -> [GFloat] -> [GFloat] Source #
toGFloats :: (Generic o, GFragmentShaderOutput (Rep o)) => o -> [GFloat] -> [GFloat] Source #
FragmentShaderOutput () Source # | |
FragmentShaderOutput GVec4 Source # | |
FragmentShaderOutput GVec3 Source # | |
FragmentShaderOutput GVec2 Source # | |
FragmentShaderOutput GFloat Source # | |
(FragmentShaderOutput a, FragmentShaderOutput b, KnownNat ((+) (NFloats a) (NFloats b))) => FragmentShaderOutput (a, b) Source # | |
(FragmentShaderOutput a, FragmentShaderOutput b, FragmentShaderOutput c, KnownNat ((+) ((+) (NFloats a) (NFloats b)) (NFloats c))) => FragmentShaderOutput (a, b, c) Source # | |
class ShaderInput a => Uniform a where Source #
Types that contain uniform values.
type CPUUniform a Source #
foldrUniform :: Proxy a -> (UniformValue -> b -> b) -> b -> CPUUniform a -> b Source #
foldrUniform :: (Generic a, Generic (CPUUniform a), GUniform (Rep a) (Rep (CPUUniform a))) => Proxy a -> (UniformValue -> b -> b) -> b -> CPUUniform a -> b Source #
Uniform () Source # | |
GLES => Uniform GMat4 Source # | |
GLES => Uniform GMat3 Source # | |
GLES => Uniform GMat2 Source # | |
GLES => Uniform GBVec4 Source # | |
GLES => Uniform GBVec3 Source # | |
GLES => Uniform GBVec2 Source # | |
GLES => Uniform GIVec4 Source # | |
GLES => Uniform GIVec3 Source # | |
GLES => Uniform GIVec2 Source # | |
GLES => Uniform GVec4 Source # | |
GLES => Uniform GVec3 Source # | |
GLES => Uniform GVec2 Source # | |
GLES => Uniform GInt Source # | |
GLES => Uniform GFloat Source # | |
GLES => Uniform GBool Source # | |
Uniform (DepthBufferSampler t) Source # | |
(Uniform a, Uniform b) => Uniform (a, b) Source # | |
(KnownNat n, ShaderType t, BaseUniform (GArray n t), GLES) => Uniform (GArray n t) Source # | |
FragmentShaderOutput o => Uniform (GBufferSampler t o) Source # | |
(Uniform a, Uniform b, Uniform c) => Uniform (a, b, c) Source # | |