Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- newtype Shader os s a = Shader (ShaderM s a)
- newtype ShaderM s a = ShaderM (ReaderT UniformAlignment (WriterT ([IO (Drawcall s)], s -> All) (ListT (State (ShaderState s)))) a)
- data ShaderState s = ShaderState Int (RenderIOState s)
- type CompiledShader os s = s -> Render os ()
- newtype Render os a = Render {}
- getNewName :: ShaderM s Int
- tellDrawcall :: IO (Drawcall s) -> ShaderM s ()
- askUniformAlignment :: ShaderM s UniformAlignment
- modifyRenderIO :: (RenderIOState s -> RenderIOState s) -> ShaderM s ()
- compileShader :: (ContextHandler ctx, MonadIO m, MonadException m) => Shader os s () -> ContextT ctx os m (CompiledShader os s)
- mapShader :: (s -> s') -> Shader os s' a -> Shader os s a
- guard' :: (s -> Bool) -> Shader os s ()
- maybeShader :: (s -> Maybe s') -> Shader os s' () -> Shader os s ()
- chooseShader :: (s -> Either s' s'') -> Shader os s' a -> Shader os s'' a -> Shader os s a
- silenceShader :: Shader os s a -> Shader os s a
Documentation
newtype Shader os s a Source #
The monad in which all GPU computations are done. 'Shader os s a' lives in
an object space os
and a context with format f
, closing over an
environent of type s
.
ShaderM (ReaderT UniformAlignment (WriterT ([IO (Drawcall s)], s -> All) (ListT (State (ShaderState s)))) a) |
data ShaderState s Source #
type CompiledShader os s = s -> Render os () Source #
A compiled shader is just a function that takes an environment and returns
a Render
action It could have been called CompiledDrawcall
or Renderer
because it is the same thing.
A monad in which shaders are run.
getNewName :: ShaderM s Int Source #
modifyRenderIO :: (RenderIOState s -> RenderIOState s) -> ShaderM s () Source #
compileShader :: (ContextHandler ctx, MonadIO m, MonadException m) => Shader os s () -> ContextT ctx os m (CompiledShader os s) Source #
Compiles a shader into a CompiledShader
. This action will usually take a
second or more, so put it during a loading sequence or something.
May throw a GPipeException
if the graphics driver doesn't support something
in this shader (e.g. too many interpolated floats sent between a vertex and a
fragment shader)
mapShader :: (s -> s') -> Shader os s' a -> Shader os s a Source #
Map the environment to a different environment and run a Shader in that sub environment, returning it's result.
guard' :: (s -> Bool) -> Shader os s () Source #
Like guard
, but dependent on the Shaders
environment value. Since this
will be evaluated at shader run time, as opposed to shader compile time for
guard
, using this to do recursion will make compileShader
diverge. You
can break that divergence by combining it with a normal guard
and a
maximum loop count.