fwgl-0.1.4.0: Game engine

Safe HaskellNone
LanguageHaskell2010

FWGL.Shader

Contents

Description

An example of shader variable:

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

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 (Vec2 x y) :- uv@(UV _) :- N) =
        -- Matrix and vector multiplication:
                        let Vec3 x' y' _ = view * trans * Vec3 x y 1
        -- Set of outputs:
                        in Vertex (Vec4 x' y' z 1) -- Vertex position.
                           :- uv :- N

Required extensions:

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

Synopsis

Types

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

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) Source

A Shader with a VertexShaderOutput output.

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

A Shader with only a FragmentShaderOutput output.

newtype VertexShaderOutput Source

The position of the vertex.

Constructors

Vertex Vec4 

newtype FragmentShaderOutput Source

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

Constructors

Fragment Vec4 

class Typeable a

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

Minimal complete definition

typeRep#

class AllTypeable xs Source

Instances

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

class Typeable g => UniformCPU c g | g -> c Source

CPU types convertible to GPU types (as uniforms).

Minimal complete definition

setUniform

Instances

GLES => UniformCPU Float Float Source 
GLES => UniformCPU Int32 Int Source 
GLES => UniformCPU Int32 Bool Source 
GLES => UniformCPU Vec2 Vec2 Source 
GLES => UniformCPU Vec3 Vec3 Source 
GLES => UniformCPU Vec4 Vec4 Source 
GLES => UniformCPU Mat2 Mat2 Source 
GLES => UniformCPU Mat3 Mat3 Source 
GLES => UniformCPU Mat4 Mat4 Source 
GLES => UniformCPU IVec4 BVec4 Source 
GLES => UniformCPU IVec4 IVec4 Source 
GLES => UniformCPU IVec3 BVec3 Source 
GLES => UniformCPU IVec3 IVec3 Source 
GLES => UniformCPU IVec2 BVec2 Source 
GLES => UniformCPU IVec2 IVec2 Source 
GLES => UniformCPU ActiveTexture SamplerCube Source 
GLES => UniformCPU ActiveTexture Sampler2D Source 
GLES => UniformCPU CMat4 View3 Source 
GLES => UniformCPU CMat4 Transform3 Source 
GLES => UniformCPU CMat3 View2 Source 
GLES => UniformCPU CMat3 Transform2 Source 
GLES => UniformCPU CSampler2D Image Source 
GLES => UniformCPU CSampler2D Texture2 Source 
GLES => UniformCPU CFloat Depth Source 
(Typeable Nat n, GLES) => UniformCPU [Float] (Array n Float) Source 
(Typeable Nat n, GLES) => UniformCPU [Int32] (Array n Int) Source 
(Typeable Nat n, GLES) => UniformCPU [Int32] (Array n Bool) Source 
(Typeable Nat n, GLES) => UniformCPU [Vec2] (Array n Vec2) Source 
(Typeable Nat n, GLES) => UniformCPU [Vec3] (Array n Vec3) Source 
(Typeable Nat n, GLES) => UniformCPU [Vec4] (Array n Vec4) Source 
(Typeable Nat n, GLES) => UniformCPU [IVec4] (Array n BVec4) Source 
(Typeable Nat n, GLES) => UniformCPU [IVec4] (Array n IVec4) Source 
(Typeable Nat n, GLES) => UniformCPU [IVec3] (Array n BVec3) Source 
(Typeable Nat n, GLES) => UniformCPU [IVec3] (Array n IVec3) Source 
(Typeable Nat n, GLES) => UniformCPU [IVec2] (Array n BVec2) Source 
(Typeable Nat n, GLES) => UniformCPU [IVec2] (Array n IVec2) Source 

data STList :: [*] -> * where Source

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 

GPU types

data Float Source

A GPU float.

Instances

ShaderType Float Source 
ToMat4 Float Source 
ToMat3 Float Source 
ToMat2 Float Source 
ToBVec4 Float Source 
ToBVec3 Float Source 
ToBVec2 Float Source 
ToIVec4 Float Source 
ToIVec3 Float Source 
ToIVec2 Float Source 
ToVec4 Float Source 
ToVec3 Float Source 
ToVec2 Float Source 
ToFloat Float Source 
ToBool Float Source 
ToInt Float Source 
Num Float Source 
GenType Float Source 
Base Mat4 Float Source 
Base Mat3 Float Source 
Base Mat2 Float Source 
Base Vec4 Float Source 
Base Vec3 Float Source 
Base Vec2 Float Source 
Base Float Float Source 
GLES => AttributeCPU Float Float Source 
GLES => UniformCPU Float Float Source 
Mul Float Float Mat4 Vec4 Vec4 Source 
Mul Float Float Mat3 Vec3 Vec3 Source 
Mul Float Float Mat2 Vec2 Vec2 Source 
Mul Float Float Vec4 Mat4 Vec4 Source 
Mul Float Float Vec3 Mat3 Vec3 Source 
Mul Float Float Vec2 Mat2 Vec2 Source 
Arithmetic Float Float Mat4 Mat4 Mat4 Source 
Arithmetic Float Float Mat4 Float Mat4 Source 
Arithmetic Float Float Mat3 Mat3 Mat3 Source 
Arithmetic Float Float Mat3 Float Mat3 Source 
Arithmetic Float Float Mat2 Mat2 Mat2 Source 
Arithmetic Float Float Mat2 Float Mat2 Source 
Arithmetic Float Float Vec4 Vec4 Vec4 Source 
Arithmetic Float Float Vec4 Float Vec4 Source 
Arithmetic Float Float Vec3 Vec3 Vec3 Source 
Arithmetic Float Float Vec3 Float Vec3 Source 
Arithmetic Float Float Vec2 Vec2 Vec2 Source 
Arithmetic Float Float Vec2 Float Vec2 Source 
Arithmetic Float Float Float Mat4 Mat4 Source 
Arithmetic Float Float Float Mat3 Mat3 Source 
Arithmetic Float Float Float Mat2 Mat2 Source 
Arithmetic Float Float Float Vec4 Vec4 Source 
Arithmetic Float Float Float Vec3 Vec3 Source 
Arithmetic Float Float Float Vec2 Vec2 Source 
Arithmetic Float Float Float Float Float Source 
(Typeable Nat n, GLES) => UniformCPU [Float] (Array n Float) Source 

CPU types

type CInt = Int32 Source

32-bit integers in the CPU.

type CBool = Int32 Source

Booleans in the CPU.

type CFloat = Float Source

Floats in the CPU.

type CSampler2D = ActiveTexture Source

Samplers in the CPU.

type CSamplerCube = ActiveTexture Source

Samplers in the CPU.

type CVec2 = Vec2 Source

2D vectors in the CPU.

type CVec3 = Vec3 Source

3D vectors in the CPU.

type CVec4 = Vec4 Source

4D vectors in the CPU.

type CIVec2 = IVec2 Source

2D integer vectors in the CPU.

type CIVec3 = IVec3 Source

3D integer vectors in the CPU.

type CIVec4 = IVec4 Source

4D integer vectors in the CPU.

type CBVec2 = IVec2 Source

2D boolean vectors in the CPU.

type CBVec3 = IVec3 Source

3D boolean vectors in the CPU.

type CBVec4 = IVec4 Source

4D boolean vectors in the CPU.

type CMat2 = Mat2 Source

2x2 matrices in the CPU.

type CMat3 = Mat3 Source

3x3 matrices in the CPU.

type CMat4 = Mat4 Source

4x4 matrices in the CPU.

type CArray a = [a] Source

Arrays in the CPU.

Functions

loop Source

Arguments

:: ShaderType a 
=> Int

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

-> a

Initial value

-> (Int -> a -> (a, Bool))

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

-> a 

store :: ShaderType a => a -> a Source

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

Math functions

radians :: GenType a => a -> a Source

degrees :: GenType a => a -> a Source

sin :: GenType a => a -> a Source

cos :: GenType a => a -> a Source

tan :: GenType a => a -> a Source

asin :: GenType a => a -> a Source

acos :: GenType a => a -> a Source

atan :: GenType a => a -> a Source

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

exp :: GenType a => a -> a Source

log :: GenType a => a -> a Source

exp2 :: GenType a => a -> a Source

log2 :: GenType a => a -> a Source

sqrt :: GenType a => a -> a Source

inversesqrt :: GenType a => a -> a Source

abs :: GenType a => a -> a Source

sign :: GenType a => a -> a Source

floor :: GenType a => a -> a Source

ceil :: GenType a => a -> a Source

fract :: GenType a => a -> a Source

mod :: GenTypeFloat a b => a -> b -> a Source

min :: GenTypeFloat a b => a -> b -> a Source

max :: GenTypeFloat a b => a -> b -> a Source

clamp :: GenTypeFloat a b => a -> b -> b -> a Source

mix :: GenTypeFloat a b => a -> a -> b -> a Source

step :: GenTypeFloat a b => b -> a -> a Source

smoothstep :: GenTypeFloat a b => b -> b -> a -> a Source

length :: GenType a => a -> Float Source

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

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

normalize :: GenType a => a -> a Source

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

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

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

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

Vector relational functions

lessThan :: VecOrd a => a -> a -> Bool Source

lessThanEqual :: VecOrd a => a -> a -> Bool Source

greaterThan :: VecOrd a => a -> a -> Bool Source

equal :: VecEq a => a -> a -> Bool Source

notEqual :: VecEq a => a -> a -> Bool Source

anyB :: BoolVector a => a -> Bool Source

allB :: BoolVector a => a -> Bool Source

notB :: BoolVector a => a -> Bool Source

Constructors

bool :: ToBool t => t -> Bool Source

int :: ToInt t => t -> Int Source

float :: ToFloat t => t -> Float Source

data CompList count Source

Useful type for constructing vectors and matrices from scalars, vectors and matrices.

Instances

class ToCompList x n | x -> n Source

Minimal complete definition

toCompList

Instances

(#) :: (ToCompList x xn, ToCompList y yn) => x -> y -> CompList (xn + yn) infixr 5 Source

You can call *vec* and mat* with a single scalar or with a CompList containing enough components. This function helps you create CompLists.

Examples:

vec2 0
mat2 $ Vec2 2 4 # Vec2 1 3
vec4 $ mat2 (0 # 1 # vec2 2) # 9  -- 9 is discarded
mat4 $ 5 # vec2 5 # Vec3 1 2 3 # Mat2 (vec2 0) (Vec2 1 2) # mat3 0
vec4 $ 1 # vec2 0 -- Not enough components, fails with "Couldn't match type
                  -- ‘'Prelude.False’ with 'Prelude.True’" (because
                  -- Components Vec4 <=? 3 ~ False).

class ToVec2 t where Source

Methods

vec2 :: t -> Vec2 Source

class ToVec3 t where Source

Methods

vec3 :: t -> Vec3 Source

class ToVec4 t where Source

Methods

vec4 :: t -> Vec4 Source

class ToBVec2 t where Source

Methods

bvec2 :: t -> BVec2 Source

class ToBVec3 t where Source

Methods

bvec3 :: t -> BVec3 Source

class ToBVec4 t where Source

Methods

bvec4 :: t -> BVec4 Source

class ToIVec2 t where Source

Methods

ivec2 :: t -> IVec2 Source

class ToIVec3 t where Source

Methods

ivec3 :: t -> IVec3 Source

class ToIVec4 t where Source

Methods

ivec4 :: t -> IVec4 Source

class ToMat2 t where Source

Methods

mat2 :: t -> Mat2 Source

class ToMat3 t where Source

Methods

mat3 :: t -> Mat3 Source

class ToMat4 t where Source

Methods

mat4 :: t -> Mat4 Source

Operators

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

(/) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c infixl 7 Source

(+) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c infixl 6 Source

(-) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c infixl 6 Source

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

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

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

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

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

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

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

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

(!) :: (ShaderType t, KnownNat n) => Array n t -> Int -> t Source

Rebinding functions

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

Rebound if. You don't need to use this function, with -XRebindableSyntax.

negate :: GenType a => a -> a Source

Prelude functions

(.) :: (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.

Variables

position :: Vec4 Source

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

fragColor :: Vec4 Source

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

fragCoord :: Vec4 Source

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

fragFrontFacing :: Bool Source

If the fragment belongs to a front-facing primitive (only works in the fragment shader).