fwgl-0.1.2.1: FRP 2D/3D game engine

Safe HaskellNone
LanguageHaskell2010

FWGL.Shader

Description

An example of shader variable:

        newtype Transform2 = Transform2 M3
                deriving (Typeable,-- This have a name in the shader.
                          ShaderType, -- This is a type in the GPU (3x3 matrix).
                          UniformCPU CM3) -- This can be used as an uniform
                                             and you can set it using a CPU
                                             3x3 matrix
                                             (FWGL.Vector.M3).

An example of vertex shader:

        vertexShader :: VertexShader
        -- The types of the uniforms:
                                '[Transform2, View2, Depth]
        -- The types of the attributes:
                                '[Position2, UV]
        -- The types of the varying (outputs), excluding VertexShaderOutput.
                                '[UV]
        vertexShader 
        -- Set of uniforms:
                     (Transform2 trans :- View2 view :- Depth z :- N)
        -- Set of attributes:
                     (Position2 (V2 x y) :- uv@(UV _) :- N) =
        -- Matrix and vector multiplication:
                        let V3 x' y' _ = view * trans * V3 x y 1
        -- Set of outputs:
                        in Vertex (V4 x' y' z 1) -- Vertex position.
                           :- uv :- N

Required extensions:

{-# LANGUAGE DataKinds, RebindableSyntax, DeriveDataTypeable,
             GeneralizedNewtypeDeriving, GADTs #-}

Synopsis

Documentation

type Shader gs is os = STList gs -> STList is -> STList os

A function from a (heterogeneous) set of uniforms and a set of inputs (attributes or varyings) to a set of outputs (varyings).

type VertexShader g i o = Shader g i (VertexShaderOutput : o)

A Shader with a VertexShaderOutput output.

type FragmentShader g i = Shader g i (FragmentShaderOutput : [])

A Shader with only a FragmentShaderOutput output.

newtype VertexShaderOutput

The position of the vertex.

Constructors

Vertex V4 

newtype FragmentShaderOutput

The RGBA color of the fragment (1.0 = #FF).

Constructors

Fragment V4 

class Typeable a

The class Typeable allows a concrete representation of a type to be calculated.

Minimal complete definition

typeRep#

class AllTypeable xs

Instances

AllTypeable ([] *) 
(Typeable * x, AllTypeable xs) => AllTypeable ((:) * x xs) 

class Typeable g => AttributeCPU c g | g -> c

CPU types convertible to GPU types (as attributes).

Minimal complete definition

encodeAttribute, setAttribute

data Sampler2D

A GPU sampler (sampler2D in GLSL).

data V2

A GPU 2D vector. NB: This is a different type from FWGL.Vector.V2.

Constructors

V2 Float Float 

data V3

A GPU 3D vector.

Constructors

V3 Float Float Float 

data V4

A GPU 4D vector.

Constructors

V4 Float Float Float Float 

data M2

A GPU 2x2 matrix.

Constructors

M2 V2 V2 

data M3

A GPU 3x3 matrix.

Constructors

M3 V3 V3 V3 

data M4

A GPU 4x4 matrix.

Constructors

M4 V4 V4 V4 V4 

type CFloat = Float

Floats in the CPU.

type CSampler2D = ActiveTexture

Samplers in the CPU.

type CV2 = V2

2D vectors in the CPU.

type CV3 = V3

3D vectors in the CPU.

type CV4 = V4

4D vectors in the CPU.

type CM2 = M2

2x2 matrices in the CPU.

type CM3 = M3

3x3 matrices in the CPU.

type CM4 = M4

4x4 matrices in the CPU.

(*) :: (Mul a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c infixl 7

(/) :: (Mul a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c infixl 7

(+) :: (Sum a, ShaderType a) => a -> a -> a infixl 6

(-) :: (Sum a, ShaderType a) => a -> a -> a infixl 6

(^) :: (ShaderType a, ShaderType b) => a -> b -> a infixr 8

(&&) :: Bool -> Bool -> Bool infixr 3

(||) :: Bool -> Bool -> Bool infixr 2

(==) :: ShaderType a => a -> a -> Bool infix 4

(>=) :: ShaderType a => a -> a -> Bool infix 4

(<=) :: ShaderType a => a -> a -> Bool infix 4

(<) :: ShaderType a => a -> a -> Bool infix 4

(>) :: ShaderType a => a -> a -> Bool infix 4

ifThenElse :: ShaderType a => Bool -> a -> a -> a

Rebinded if.

loop

Arguments

:: ShaderType a 
=> Float

Maximum number of iterations (should be as low as possible, must be an integer literal)

-> a

Initial value

-> (Float -> a -> (a, Bool))

Iteration -> Old value -> (Next, Stop)

-> a 

true :: Bool

false :: Bool

store :: ShaderType a => a -> a

Avoid executing this expression more than one time. Conditionals and loops imply it.

radians :: GenType a => a -> a

degrees :: GenType a => a -> a

sin :: GenType a => a -> a

cos :: GenType a => a -> a

tan :: GenType a => a -> a

asin :: GenType a => a -> a

acos :: GenType a => a -> a

atan :: GenType a => a -> a

atan2 :: GenType a => a -> a -> a

exp :: GenType a => a -> a

log :: GenType a => a -> a

exp2 :: GenType a => a -> a

log2 :: GenType a => a -> a

sqrt :: GenType a => a -> a

inversesqrt :: GenType a => a -> a

abs :: GenType a => a -> a

sign :: GenType a => a -> a

floor :: GenType a => a -> a

ceil :: GenType a => a -> a

fract :: GenType a => a -> a

mod :: (GenType a, GenType b) => a -> b -> a

min :: GenType a => a -> a -> a

max :: GenType a => a -> a -> a

clamp :: (GenType a, GenType b) => a -> b -> b -> a

mix :: (GenType a, GenType b) => a -> a -> b -> a

step :: GenType a => a -> a -> a

smoothstep :: (GenType a, GenType b) => b -> b -> a -> a

length :: GenType a => a -> Float

distance :: GenType a => a -> a -> Float

dot :: GenType a => a -> a -> Float

cross :: V3 -> V3 -> V3

normalize :: GenType a => a -> a

faceforward :: GenType a => a -> a -> a -> a

reflect :: GenType a => a -> a -> a

refract :: GenType a => a -> a -> Float -> a

matrixCompMult :: (Matrix a, Matrix b, Matrix c) => a -> b -> c

position :: V4

The position of the vertex (only works in the vertex shader).

fragColor :: V4

The color of the fragment (only works in the fragment shader).

data STList :: [*] -> * where

An heterogeneous set of ShaderTypes and Typeables.

Constructors

N :: STList [] 
(:-) :: (ShaderType a, Typeable a, IsMember a xs ~ False) => a -> STList xs -> STList (a : xs) infixr 4 

(.) :: (b -> c) -> (a -> b) -> a -> c infixr 9

Function composition.

id :: a -> a

Identity function.

const :: a -> b -> a

Constant function.

flip :: (a -> b -> c) -> b -> a -> c

flip f takes its (first) two arguments in the reverse order of f.

($) :: (a -> b) -> a -> b infixr 0

Application operator. This operator is redundant, since ordinary application (f x) means the same as (f $ x). However, $ has low, right-associative binding precedence, so it sometimes allows parentheses to be omitted; for example:

    f $ g $ h x  =  f (g (h x))

It is also useful in higher-order situations, such as map ($ 0) xs, or zipWith ($) fs xs.

fst :: (a, b) -> a

Extract the first component of a pair.

snd :: (a, b) -> b

Extract the second component of a pair.