Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
- class Base a b | a -> b
- class (Base a aBase, Base b bBase) => Arithmetic aBase bBase a b result | a b -> result, b -> aBase bBase, a -> aBase bBase, result -> aBase bBase
- class (Base a aBase, Base b bBase) => Mul aBase bBase a b result | a b -> result, b -> aBase bBase, a -> aBase bBase, result -> aBase bBase
- class (ShaderType a, Base a Float) => FloatVec a
- class ShaderType a => GenType a
- type family GenTypeFloatConstr a b where ...
- type GenTypeFloat a b = (GenTypeFloatConstr a b, ShaderType a, ShaderType b)
- (*) :: (Mul aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c
- (/) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c
- (+) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c
- (-) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c
- (^) :: (ShaderType a, GenType a) => a -> a -> a
- (&&) :: Bool -> Bool -> Bool
- (||) :: Bool -> Bool -> Bool
- (==) :: ShaderType a => a -> a -> Bool
- (/=) :: ShaderType a => a -> a -> Bool
- (>=) :: ShaderType a => a -> a -> Bool
- (<=) :: ShaderType a => a -> a -> Bool
- (<) :: ShaderType a => a -> a -> Bool
- (>) :: ShaderType a => a -> a -> Bool
- class ShaderType a => VecOrd a
- class ShaderType a => VecEq a
- lessThan :: VecOrd a => a -> a -> Bool
- lessThanEqual :: VecOrd a => a -> a -> Bool
- greaterThan :: VecOrd a => a -> a -> Bool
- greaterThanEqual :: VecOrd a => a -> a -> Bool
- equal :: VecEq a => a -> a -> Bool
- notEqual :: VecEq a => a -> a -> Bool
- class ShaderType a => BoolVector a
- anyB :: BoolVector a => a -> Bool
- allB :: BoolVector a => a -> Bool
- notB :: BoolVector a => a -> Bool
- negate :: GenType a => a -> a
- not :: GenType a => a -> a
- class (ShaderType a, Base a a) => Num a where
- fromRational :: Rational -> Float
- 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 :: GenTypeFloat a b => a -> b -> a
- min :: GenTypeFloat a b => a -> b -> a
- max :: GenTypeFloat a b => a -> b -> a
- clamp :: GenTypeFloat a b => a -> b -> b -> a
- mix :: GenTypeFloat a b => a -> a -> b -> a
- step :: GenTypeFloat a b => b -> a -> a
- smoothstep :: GenTypeFloat a b => b -> b -> a -> a
- length :: GenType a => a -> Float
- arrayLength :: (ShaderType t, KnownNat n) => Array n t -> Int
- (!) :: (ShaderType t, KnownNat n) => Array n t -> Int -> t
- distance :: GenType a => a -> a -> Float
- dot :: GenType a => a -> a -> Float
- cross :: Vec3 -> Vec3 -> Vec3
- 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
- class ShaderType a => Matrix a
- matrixCompMult :: (Matrix a, Matrix b, Matrix c) => a -> b -> c
- store :: ShaderType a => a -> a
- true :: Bool
- false :: Bool
- ifThenElse :: ShaderType a => Bool -> a -> a -> a
- loop :: ShaderType a => Int -> a -> (Int -> a -> (a, Bool)) -> a
- texture2D :: Sampler2D -> Vec2 -> Vec4
- texture2DBias :: Sampler2D -> Vec2 -> Float -> Vec4
- texture2DProj :: Sampler2D -> Vec3 -> Vec4
- texture2DProjBias :: Sampler2D -> Vec3 -> Float -> Vec4
- texture2DProj4 :: Sampler2D -> Vec4 -> Vec4
- texture2DProjBias4 :: Sampler2D -> Vec4 -> Float -> Vec4
- texture2DLod :: Sampler2D -> Vec2 -> Float -> Vec4
- texture2DProjLod :: Sampler2D -> Vec3 -> Float -> Vec4
- texture2DProjLod4 :: Sampler2D -> Vec4 -> Float -> Vec4
- textureCube :: SamplerCube -> Vec3 -> Vec4
- textureCubeBias :: SamplerCube -> Vec3 -> Float -> Vec4
- textureCubeLod :: SamplerCube -> Vec3 -> Float -> Vec4
- position :: Vec4
- fragData :: Array 16 Vec4
- fragCoord :: Vec4
- fragFrontFacing :: Bool
- class ShaderType t => ToInt t
- int :: ToInt t => t -> Int
- class ShaderType t => ToBool t
- bool :: ToBool t => t -> Bool
- class ShaderType t => ToFloat t
- float :: ToFloat t => t -> Float
- class ToVec2 t where
- class ToVec3 t where
- class ToVec4 t where
- class ToIVec2 t where
- class ToIVec3 t where
- class ToIVec4 t where
- class ToBVec2 t where
- class ToBVec3 t where
- class ToBVec4 t where
- class ToMat2 t where
- class ToMat3 t where
- class ToMat4 t where
- data CompList count where
- CL :: (1 <= Components t, ShaderType t) => t -> CompList (Components t)
- CLAppend :: CompList x -> CompList y -> CompList (x + y)
- class ToCompList x n | x -> n where
- (#) :: (ToCompList x xn, ToCompList y yn) => x -> y -> CompList (xn + yn)
- type family Components (t :: *) :: Nat where ...
- op1 :: (ShaderType a, ShaderType b) => String -> a -> b
- op2 :: (ShaderType a, ShaderType b, ShaderType c) => String -> a -> b -> c
- fun1 :: (ShaderType a, ShaderType b) => String -> a -> b
- fun2 :: (ShaderType a, ShaderType b, ShaderType c) => String -> a -> b -> c
- fun3 :: (ShaderType a, ShaderType b, ShaderType c, ShaderType d) => String -> a -> b -> c -> d
- funCompList :: (ToCompList cl n, ShaderType r) => String -> cl -> r
Documentation
class (Base a aBase, Base b bBase) => Arithmetic aBase bBase a b result | a b -> result, b -> aBase bBase, a -> aBase bBase, result -> aBase bBase Source #
class (Base a aBase, Base b bBase) => Mul aBase bBase a b result | a b -> result, b -> aBase bBase, a -> aBase bBase, result -> aBase bBase Source #
Types that can be multiplied.
(Arithmetic aBase bBase a b result, Base a aBase, Base b bBase) => Mul aBase bBase a b result 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 # | |
class ShaderType a => GenType a Source #
Floats or vectors.
type family GenTypeFloatConstr a b where ... Source #
GenTypeFloatConstr a Float = GenType a | |
GenTypeFloatConstr a a = GenType a |
type GenTypeFloat a b = (GenTypeFloatConstr a b, ShaderType a, ShaderType b) Source #
(*) :: (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 #
(==) :: 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 a => a -> a -> Bool infix 4 Source #
class ShaderType a => VecOrd a Source #
class ShaderType a => VecEq a Source #
lessThanEqual :: VecOrd a => a -> a -> Bool Source #
greaterThan :: VecOrd a => a -> a -> Bool Source #
greaterThanEqual :: VecOrd a => a -> a -> Bool Source #
class ShaderType a => BoolVector a Source #
anyB :: BoolVector a => a -> Bool Source #
allB :: BoolVector a => a -> Bool Source #
notB :: BoolVector a => a -> Bool Source #
class (ShaderType a, Base a a) => Num a where Source #
fromInteger :: Integer -> a Source #
fromRational :: Rational -> Float Source #
inversesqrt :: 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 #
arrayLength :: (ShaderType t, KnownNat n) => Array n t -> Int Source #
faceforward :: GenType a => a -> a -> a -> a Source #
class ShaderType a => Matrix a Source #
store :: ShaderType a => a -> a Source #
Avoid evaluating the expression of the argument more than one time. Conditionals and loops imply it.
ifThenElse :: ShaderType a => Bool -> a -> a -> a Source #
Rebound if. You don't need to use this function, with -XRebindableSyntax.
:: 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 |
textureCube :: SamplerCube -> Vec3 -> Vec4 Source #
textureCubeBias :: SamplerCube -> Vec3 -> Float -> Vec4 Source #
textureCubeLod :: SamplerCube -> Vec3 -> Float -> Vec4 Source #
fragFrontFacing :: Bool Source #
If the fragment belongs to a front-facing primitive (only works in the fragment shader).
class ShaderType t => ToBool t Source #
class ShaderType t => ToFloat t Source #
data CompList count where Source #
Useful type for constructing vectors and matrices from scalars, vectors and matrices.
CL :: (1 <= Components t, ShaderType t) => t -> CompList (Components t) | |
CLAppend :: CompList x -> CompList y -> CompList (x + y) |
ToCompList (CompList n) n Source # | |
class ToCompList x n | x -> n where Source #
toCompList :: x -> CompList n Source #
((<=) 1 n, ShaderType t, (~) Nat n (Components t)) => ToCompList t n Source # | |
ToCompList (CompList n) n Source # | |
(#) :: (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 CompList
s.
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).
type family Components (t :: *) :: Nat where ... Source #
Components Int = 1 | |
Components Float = 1 | |
Components Bool = 1 | |
Components Vec2 = 2 | |
Components IVec2 = 2 | |
Components BVec2 = 2 | |
Components Vec3 = 3 | |
Components IVec3 = 3 | |
Components BVec3 = 3 | |
Components Vec4 = 4 | |
Components IVec4 = 4 | |
Components BVec4 = 4 | |
Components Mat2 = 4 | |
Components Mat3 = 9 | |
Components Mat4 = 16 | |
Components x = 0 |
op1 :: (ShaderType a, ShaderType b) => String -> a -> b Source #
op2 :: (ShaderType a, ShaderType b, ShaderType c) => String -> a -> b -> c Source #
fun1 :: (ShaderType a, ShaderType b) => String -> a -> b Source #
fun2 :: (ShaderType a, ShaderType b, ShaderType c) => String -> a -> b -> c Source #
fun3 :: (ShaderType a, ShaderType b, ShaderType c, ShaderType d) => String -> a -> b -> c -> d Source #
funCompList :: (ToCompList cl n, ShaderType r) => String -> cl -> r Source #