Copyright | 2014 Edward Kmett Charles Durham [2015..2020] Trevor L. McDonell |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Trevor L. McDonell <trevor.mcdonell@gmail.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
4-D Vectors
Synopsis
- data V4 a = V4 !a !a !a !a
- pattern V4_ :: Elt a => Exp a -> Exp a -> Exp a -> Exp a -> Exp (V4 a)
- vector :: forall a. Num a => Exp (V3 a) -> Exp (V4 a)
- point :: forall a. Num a => Exp (V3 a) -> Exp (V4 a)
- normalizePoint :: forall a. Fractional a => Exp (V4 a) -> Exp (V3 a)
- class R1 t => R1 t where
- class (R2 t, R1 t) => R2 t where
- _yx :: forall t a. (R2 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- class (R3 t, R2 t) => R3 t where
- _xz :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _yz :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _zx :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _zy :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _xzy :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _yxz :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _yzx :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _zxy :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _zyx :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- class (R4 t, R3 t) => R4 t where
- _xw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _yw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _zw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _wx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _wy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _wz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))
- _xyw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _xzw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _xwy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _xwz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _yxw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _yzw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _ywx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _ywz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _zxw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _zyw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _zwx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _zwy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _wxy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _wxz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _wyx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _wyz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _wzx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _wzy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))
- _xywz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _xzyw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _xzwy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _xwyz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _xwzy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _yxzw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _yxwz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _yzxw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _yzwx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _ywxz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _ywzx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _zxyw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _zxwy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _zyxw :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _zywx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _zwxy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _zwyx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _wxyz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _wxzy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _wyxz :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _wyzx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _wzxy :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- _wzyx :: forall t a. (R4 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))
- ex :: R1 t => E t
- ey :: R2 t => E t
- ez :: R3 t => E t
- ew :: R4 t => E t
Documentation
A 4-dimensional vector.
V4 !a !a !a !a |
Instances
vector :: forall a. Num a => Exp (V3 a) -> Exp (V4 a) Source #
Convert a 3-dimensional affine vector into a 4-dimensional homogeneous vector.
point :: forall a. Num a => Exp (V3 a) -> Exp (V4 a) Source #
Convert a 3-dimensional affine point into a 4-dimensional homogeneous vector.
normalizePoint :: forall a. Fractional a => Exp (V4 a) -> Exp (V3 a) Source #
Convert 4-dimensional projective coordinates to a 3-dimensional point. This
operation may be denoted, euclidean [x:y:z:w] = (x/w, y/w, z/w)
where
the projective, homogenous, coordinate [x:y:z:w]
is one of many associated
with a single point (x/w, y/w, z/w)
.
class R1 t => R1 t where Source #
A space that has at least 1 basis vector _x
.
Nothing
_x :: (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a) Source #
>>>
test $ (V1_ 2 :: Exp (V1 Int)) ^. _x
2
>>>
test $ (V1_ 2 :: Exp (V1 Int)) & _x .~ 3
V1 3
class (R2 t, R1 t) => R2 t where Source #
Nothing
_y :: (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a) Source #
>>>
test $ (V2_ 1 2 :: Exp (V2 Int)) ^. _y
2
>>>
test $ (V2_ 1 2 :: Exp (V2 Int)) & _y .~ 3
V2 1 3
_xy :: (Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a)) Source #
_yx :: forall t a. (R2 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a)) Source #
>>>
test $ (V2_ 1 2 :: Exp (V2 Int)) ^. _yx
V2 2 1
class (R3 t, R2 t) => R3 t where Source #
Nothing
_z :: forall a. (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a) Source #
>>>
test $ (V3_ 1 2 3 :: Exp (V3 Int)) ^. _z
3
>>>
test $ (V3_ 1 2 3 :: Exp (V3 Int)) & _z .~ 42
V3 1 2 42
_xyz :: forall a. (Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a)) Source #
class (R4 t, R3 t) => R4 t where Source #
A space that distinguishes orthogonal basis vectors _x
, _y
, _z
, and _w
.
(Although it may have more.)
Nothing