Safe Haskell | Unsafe |
---|---|
Language | Haskell2010 |
Synopsis
- newtype Transformation d r = Transformation {
- _transformationMatrix :: Matrix (d + 1) (d + 1) r
- transformationMatrix :: Iso (Transformation d r) (Transformation d s) (Matrix (d + 1) (d + 1) r) (Matrix (d + 1) (d + 1) s)
- (|.|) :: (Num r, Arity (d + 1)) => Transformation d r -> Transformation d r -> Transformation d r
- inverseOf :: (Fractional r, Invertible (d + 1) r) => Transformation d r -> Transformation d r
- class IsTransformable g where
- transformBy :: Transformation (Dimension g) (NumType g) -> g -> g
- transformAllBy :: (Functor c, IsTransformable g) => Transformation (Dimension g) (NumType g) -> c g -> c g
- transformPointFunctor :: (PointFunctor g, Fractional r, d ~ Dimension (g r), Arity d, Arity (d + 1)) => Transformation d r -> g r -> g r
- translation :: (Num r, Arity d, Arity (d + 1)) => Vector d r -> Transformation d r
- scaling :: (Num r, Arity d, Arity (d + 1)) => Vector d r -> Transformation d r
- uniformScaling :: (Num r, Arity d, Arity (d + 1)) => r -> Transformation d r
- translateBy :: (IsTransformable g, Num (NumType g), Arity (Dimension g), Arity (Dimension g + 1)) => Vector (Dimension g) (NumType g) -> g -> g
- scaleBy :: (IsTransformable g, Num (NumType g), Arity (Dimension g), Arity (Dimension g + 1)) => Vector (Dimension g) (NumType g) -> g -> g
- scaleUniformlyBy :: (IsTransformable g, Num (NumType g), Arity (Dimension g), Arity (Dimension g + 1)) => NumType g -> g -> g
- transRow :: forall n r. (Arity n, Arity (n + 1), Num r) => Int -> r -> Vector (n + 1) r
- rotateTo :: Num r => Vector 3 (Vector 3 r) -> Transformation 3 r
- skewX :: Num r => r -> Transformation 2 r
Transformations
newtype Transformation d r Source #
A type representing a Transformation for d dimensional objects
Transformation | |
|
Instances
transformationMatrix :: Iso (Transformation d r) (Transformation d s) (Matrix (d + 1) (d + 1) r) (Matrix (d + 1) (d + 1) s) Source #
(|.|) :: (Num r, Arity (d + 1)) => Transformation d r -> Transformation d r -> Transformation d r Source #
Compose transformations (right to left)
inverseOf :: (Fractional r, Invertible (d + 1) r) => Transformation d r -> Transformation d r Source #
Compute the inverse transformation
>>>
inverseOf $ translation (Vector2 (10.0) (5.0))
Transformation {_transformationMatrix = Matrix Vector3 [Vector3 [1.0,0.0,-10.0],Vector3 [0.0,1.0,-5.0],Vector3 [0.0,0.0,1.0]]}
Transformable geometry objects
class IsTransformable g where Source #
A class representing types that can be transformed using a transformation
transformBy :: Transformation (Dimension g) (NumType g) -> g -> g Source #
Instances
transformAllBy :: (Functor c, IsTransformable g) => Transformation (Dimension g) (NumType g) -> c g -> c g Source #
transformPointFunctor :: (PointFunctor g, Fractional r, d ~ Dimension (g r), Arity d, Arity (d + 1)) => Transformation d r -> g r -> g r Source #
Common transformations
translation :: (Num r, Arity d, Arity (d + 1)) => Vector d r -> Transformation d r Source #
uniformScaling :: (Num r, Arity d, Arity (d + 1)) => r -> Transformation d r Source #
Functions that execute transformations
translateBy :: (IsTransformable g, Num (NumType g), Arity (Dimension g), Arity (Dimension g + 1)) => Vector (Dimension g) (NumType g) -> g -> g Source #
scaleBy :: (IsTransformable g, Num (NumType g), Arity (Dimension g), Arity (Dimension g + 1)) => Vector (Dimension g) (NumType g) -> g -> g Source #
scaleUniformlyBy :: (IsTransformable g, Num (NumType g), Arity (Dimension g), Arity (Dimension g + 1)) => NumType g -> g -> g Source #
transRow :: forall n r. (Arity n, Arity (n + 1), Num r) => Int -> r -> Vector (n + 1) r Source #
Row in a translation matrix transRow :: forall n r. ( Arity n, Arity (n- 1), ((n - 1) + 1) ~ n , Num r) => Int -> r -> Vector n r transRow i x = set (V.element (Proxy :: Proxy (n-1))) x $ mkRow i 1
3D Rotations
rotateTo :: Num r => Vector 3 (Vector 3 r) -> Transformation 3 r Source #
Given three new unit-length basis vectors (u,v,w) that map to (x,y,z), construct the appropriate rotation that does this.
2D Transformations
skewX :: Num r => r -> Transformation 2 r Source #
Skew transformation that keeps the y-coordinates fixed and shifts the x coordinates.