Safe Haskell | None |
---|---|
Language | Haskell2010 |
- data Object gs is where
- class MemberGlobal g gs where
- class RemoveGlobal g gs gs' where
- nothing :: Object [] []
- geom :: Geometry i -> Object [] i
- modifyGeometry :: (Empty is ~ False) => (Geometry is -> Geometry is') -> Object gs is -> Object gs is'
- data Group gs is
- group :: (Set is, Set gs) => [Object is gs] -> Group is gs
- (~~) :: (Equal gs gs', Equal is is') => Group gs is -> Group gs' is' -> Group (Union gs gs') (Union is is')
- unsafeJoin :: Group gs is -> Group gs' is' -> Group (Union gs gs') (Union is is')
- emptyGroup :: Group is gs
- globalGroup :: UniformCPU c g => Global g -> Group gs is -> Group (g : gs) is
- data Layer
- layer :: (Subset progAttr grpAttr, Subset progUni grpUni) => Program progUni progAttr -> Group grpUni grpAttr -> Layer
- combineLayers :: [Layer] -> Layer
- subLayer :: Int -> Int -> Layer -> (Texture -> [Layer]) -> Layer
- depthSubLayer :: Int -> Int -> Layer -> (Texture -> [Layer]) -> Layer
- subRenderLayer :: RenderLayer [Layer] -> Layer
- renderColor :: Int -> Int -> Layer -> (Texture -> a) -> RenderLayer a
- renderDepth :: Int -> Int -> Layer -> (Texture -> a) -> RenderLayer a
- renderColorDepth :: Int -> Int -> Layer -> (Texture -> Texture -> a) -> RenderLayer a
- renderColorInspect :: Int -> Int -> Layer -> Int -> Int -> Int -> Int -> (Texture -> [Color] -> a) -> RenderLayer a
- renderDepthInspect :: Int -> Int -> Layer -> Int -> Int -> Int -> Int -> (Texture -> [Word8] -> a) -> RenderLayer a
- renderColorDepthInspect :: Int -> Int -> Layer -> Int -> Int -> Int -> Int -> (Texture -> Texture -> [Color] -> [Word8] -> a) -> RenderLayer a
- data Program gs is
- program :: (ValidVertex vgs vis vos, Valid fgs vos [], Equal pgs (Union vgs fgs)) => VertexShader vgs vis vos -> FragmentShader fgs vos -> Program pgs vis
- data Global g where
- (:=) :: (Typeable g, UniformCPU c g) => (a -> g) -> Draw c -> Global g
- (-=) :: (Typeable g, UniformCPU c g) => (a -> g) -> c -> Global g
- globalTexture :: (BackendIO, Typeable g, UniformCPU ActiveTexture g) => (a -> g) -> Texture -> Global g
- globalTexSize :: (BackendIO, Typeable g, UniformCPU c g) => (a -> g) -> Texture -> ((Int, Int) -> c) -> Global g
- globalFramebufferSize :: (BackendIO, Typeable g, UniformCPU c g) => (a -> g) -> (Vec2 -> c) -> Global g
- data Geometry is
- data AttrList is where
- AttrListNil :: AttrList []
- AttrListCons :: (Hashable c, AttributeCPU c g, ShaderType g) => (a -> g) -> [c] -> AttrList gs -> AttrList (g : gs)
- mkGeometry :: GLES => AttrList is -> [Word16] -> Geometry is
- extend :: t
- remove :: t
- data Texture
- mkTexture :: GLES => Int -> Int -> [Color] -> Texture
- textureURL :: String -> Texture
- textureFile :: String -> Texture
- data Color = Color !Word8 !Word8 !Word8 !Word8
- colorTex :: GLES => Color -> Texture
- module Data.Vect.Float
- module FWGL.Graphics.Color
Objects
class MemberGlobal g gs where Source
:: UniformCPU c g | |
=> (Draw c -> Global g) | Changing function |
-> Object gs is | |
-> Object gs is |
Modify the global of an Object
.
((~) Bool ((==) * g g1) False, MemberGlobal g gs) => MemberGlobal g ((:) * g1 gs) | |
MemberGlobal g ((:) * g gs) |
class RemoveGlobal g gs gs' where Source
RemoveGlobal g ((:) * g gs) gs | |
((~) Bool ((==) * g g1) False, RemoveGlobal g gs gs') => RemoveGlobal g ((:) * g1 gs) ((:) * g1 gs') |
modifyGeometry :: (Empty is ~ False) => (Geometry is -> Geometry is') -> Object gs is -> Object gs is' Source
Modify the geometry of an Object
.
Groups
(~~) :: (Equal gs gs', Equal is is') => Group gs is -> Group gs' is' -> Group (Union gs gs') (Union is is') Source
Join two groups.
unsafeJoin :: Group gs is -> Group gs' is' -> Group (Union gs gs') (Union is is') Source
Join two groups, even if they don't provide the same variables.
emptyGroup :: Group is gs Source
An empty group.
globalGroup :: UniformCPU c g => Global g -> Group gs is -> Group (g : gs) is Source
Set a global uniform for a Group
.
Layers
layer :: (Subset progAttr grpAttr, Subset progUni grpUni) => Program progUni progAttr -> Group grpUni grpAttr -> Layer Source
Associate a group with a program.
combineLayers :: [Layer] -> Layer Source
Combine some layers.
Sublayers
:: Int | Texture width. |
-> Int | Texture height. |
-> Layer | Layer to draw on a |
-> (Texture -> [Layer]) | Layers using the texture. |
-> Layer |
Use a Layer
as a Texture
on another. Based on renderColor
.
:: Int | Texture width. |
-> Int | Texture height. |
-> Layer | Layer to draw on a
depth |
-> (Texture -> [Layer]) | Layers using the texture. |
-> Layer |
Use a Layer
as a depth Texture
on another. Based on renderDepth
.
subRenderLayer :: RenderLayer [Layer] -> Layer Source
Generalized version of subLayer
and depthSubLayer
.
Render layers
:: Int | Texture width. |
-> Int | Texture height. |
-> Layer | Layer to draw on a |
-> (Texture -> Texture -> a) | Color, depth. |
-> RenderLayer a |
Combination of renderColor
and renderDepth
.
renderColorDepthInspect Source
:: Int | Texture width. |
-> Int | Texture height. |
-> Layer | Layer to draw on a |
-> Int | First pixel to read X |
-> Int | First pixel to read Y |
-> Int | Width of the rectangle to read |
-> Int | Height of the rectangle to read |
-> (Texture -> Texture -> [Color] -> [Word8] -> a) | Layers using the texture. |
-> RenderLayer a |
Combination of renderColorInspect
and renderDepthInspect
. Not supported
on WebGL.
Shaders
A vertex shader associated with a compatible fragment shader.
program :: (ValidVertex vgs vis vos, Valid fgs vos [], Equal pgs (Union vgs fgs)) => VertexShader vgs vis vos -> FragmentShader fgs vos -> Program pgs vis Source
Create a Program
from the shaders.
The value of a GPU uniform.
(:=) :: (Typeable g, UniformCPU c g) => (a -> g) -> Draw c -> Global g infix 3 |
(-=) :: (Typeable g, UniformCPU c g) => (a -> g) -> c -> Global g infixr 4 Source
Create a Global
from a pure value. The first argument is ignored,
it just provides the type (you can use the constructor of the GPU type).
globalTexture :: (BackendIO, Typeable g, UniformCPU ActiveTexture g) => (a -> g) -> Texture -> Global g Source
Create a Global
of CPU type ActiveTexture
using a Texture
.
globalTexSize :: (BackendIO, Typeable g, UniformCPU c g) => (a -> g) -> Texture -> ((Int, Int) -> c) -> Global g Source
globalFramebufferSize :: (BackendIO, Typeable g, UniformCPU c g) => (a -> g) -> (Vec2 -> c) -> Global g Source
Create a Global
using the size of the framebuffer.
Geometries
A heterogeneous list of attributes.
AttrListNil :: AttrList [] | |
AttrListCons :: (Hashable c, AttributeCPU c g, ShaderType g) => (a -> g) -> [c] -> AttrList gs -> AttrList (g : gs) |
Textures
Creates a Texture
from a list of pixels.
textureFile :: String -> Texture Source
The same as textureURL
.
Colors
An RGBA 32-bit color.
module Data.Vect.Float
module FWGL.Graphics.Color