#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
#endif
module Linear.V4
( V4(..)
, vector, point, normalizePoint
, R1(..)
, R2(..)
, _yx
, R3(..)
, _xz, _yz, _zx, _zy
, _xzy, _yxz, _yzx, _zxy, _zyx
, R4(..)
, _xw, _yw, _zw, _wx, _wy, _wz
, _xyw, _xzw, _xwy, _xwz, _yxw, _yzw, _ywx, _ywz, _zxw, _zyw, _zwx, _zwy
, _wxy, _wxz, _wyx, _wyz, _wzx, _wzy
, _xywz, _xzyw, _xzwy, _xwyz, _xwzy, _yxzw , _yxwz, _yzxw, _yzwx, _ywxz
, _ywzx, _zxyw, _zxwy, _zyxw, _zywx, _zwxy, _zwyx, _wxyz, _wxzy, _wyxz
, _wyzx, _wzxy, _wzyx
, ex, ey, ez, ew
) where
import Control.Applicative
import Control.DeepSeq (NFData(rnf))
import Control.Monad (liftM)
import Control.Monad.Fix
import Control.Monad.Zip
import Control.Lens hiding ((<.>))
import Data.Data
import Data.Distributive
import Data.Foldable
import Data.Functor.Bind
import Data.Functor.Rep
import Data.Hashable
import Data.Semigroup
import Data.Semigroup.Foldable
import Foreign.Ptr (castPtr)
import Foreign.Storable (Storable(..))
import GHC.Arr (Ix(..))
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
import GHC.Generics (Generic)
#endif
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706
import GHC.Generics (Generic1)
#endif
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed.Base as U
import Linear.Epsilon
import Linear.Metric
import Linear.V2
import Linear.V3
import Linear.Vector
data V4 a = V4 !a !a !a !a deriving (Eq,Ord,Show,Read,Data,Typeable
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
,Generic
#endif
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706
,Generic1
#endif
)
instance Functor V4 where
fmap f (V4 a b c d) = V4 (f a) (f b) (f c) (f d)
a <$ _ = V4 a a a a
instance Foldable V4 where
foldMap f (V4 a b c d) = f a `mappend` f b `mappend` f c `mappend` f d
instance Traversable V4 where
traverse f (V4 a b c d) = V4 <$> f a <*> f b <*> f c <*> f d
instance Foldable1 V4 where
foldMap1 f (V4 a b c d) = f a <> f b <> f c <> f d
instance Traversable1 V4 where
traverse1 f (V4 a b c d) = V4 <$> f a <.> f b <.> f c <.> f d
instance Applicative V4 where
pure a = V4 a a a a
V4 a b c d <*> V4 e f g h = V4 (a e) (b f) (c g) (d h)
instance Apply V4 where
V4 a b c d <.> V4 e f g h = V4 (a e) (b f) (c g) (d h)
instance Additive V4 where
zero = pure 0
liftU2 = liftA2
liftI2 = liftA2
instance Bind V4 where
V4 a b c d >>- f = V4 a' b' c' d' where
V4 a' _ _ _ = f a
V4 _ b' _ _ = f b
V4 _ _ c' _ = f c
V4 _ _ _ d' = f d
instance Monad V4 where
return a = V4 a a a a
V4 a b c d >>= f = V4 a' b' c' d' where
V4 a' _ _ _ = f a
V4 _ b' _ _ = f b
V4 _ _ c' _ = f c
V4 _ _ _ d' = f d
instance Num a => Num (V4 a) where
(+) = liftA2 (+)
(*) = liftA2 (*)
() = liftA2 ()
negate = fmap negate
abs = fmap abs
signum = fmap signum
fromInteger = pure . fromInteger
instance Fractional a => Fractional (V4 a) where
recip = fmap recip
(/) = liftA2 (/)
fromRational = pure . fromRational
instance Metric V4 where
dot (V4 a b c d) (V4 e f g h) = a * e + b * f + c * g + d * h
instance Distributive V4 where
distribute f = V4 (fmap (\(V4 x _ _ _) -> x) f)
(fmap (\(V4 _ y _ _) -> y) f)
(fmap (\(V4 _ _ z _) -> z) f)
(fmap (\(V4 _ _ _ w) -> w) f)
instance Hashable a => Hashable (V4 a) where
hashWithSalt s (V4 a b c d) = s `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d
class R3 t => R4 t where
_w :: Lens' (t a) a
_xyzw :: Lens' (t a) (V4 a)
_xw, _yw, _zw, _wx, _wy, _wz :: R4 t => Lens' (t a) (V2 a)
_xw f = _xyzw $ \(V4 a b c d) -> f (V2 a d) <&> \(V2 a' d') -> V4 a' b c d'
_yw f = _xyzw $ \(V4 a b c d) -> f (V2 b d) <&> \(V2 b' d') -> V4 a b' c d'
_zw f = _xyzw $ \(V4 a b c d) -> f (V2 c d) <&> \(V2 c' d') -> V4 a b c' d'
_wx f = _xyzw $ \(V4 a b c d) -> f (V2 d a) <&> \(V2 d' a') -> V4 a' b c d'
_wy f = _xyzw $ \(V4 a b c d) -> f (V2 d b) <&> \(V2 d' b') -> V4 a b' c d'
_wz f = _xyzw $ \(V4 a b c d) -> f (V2 d c) <&> \(V2 d' c') -> V4 a b c' d'
_xyw, _xzw, _xwy, _xwz, _yxw, _yzw, _ywx, _ywz, _zxw, _zyw, _zwx, _zwy, _wxy, _wxz, _wyx, _wyz, _wzx, _wzy :: R4 t => Lens' (t a) (V3 a)
_xyw f = _xyzw $ \(V4 a b c d) -> f (V3 a b d) <&> \(V3 a' b' d') -> V4 a' b' c d'
_xzw f = _xyzw $ \(V4 a b c d) -> f (V3 a c d) <&> \(V3 a' c' d') -> V4 a' b c' d'
_xwy f = _xyzw $ \(V4 a b c d) -> f (V3 a d b) <&> \(V3 a' d' b') -> V4 a' b' c d'
_xwz f = _xyzw $ \(V4 a b c d) -> f (V3 a d c) <&> \(V3 a' d' c') -> V4 a' b c' d'
_yxw f = _xyzw $ \(V4 a b c d) -> f (V3 b a d) <&> \(V3 b' a' d') -> V4 a' b' c d'
_yzw f = _xyzw $ \(V4 a b c d) -> f (V3 b c d) <&> \(V3 b' c' d') -> V4 a b' c' d'
_ywx f = _xyzw $ \(V4 a b c d) -> f (V3 b d a) <&> \(V3 b' d' a') -> V4 a' b' c d'
_ywz f = _xyzw $ \(V4 a b c d) -> f (V3 b d c) <&> \(V3 b' d' c') -> V4 a b' c' d'
_zxw f = _xyzw $ \(V4 a b c d) -> f (V3 c a d) <&> \(V3 c' a' d') -> V4 a' b c' d'
_zyw f = _xyzw $ \(V4 a b c d) -> f (V3 c b d) <&> \(V3 c' b' d') -> V4 a b' c' d'
_zwx f = _xyzw $ \(V4 a b c d) -> f (V3 c d a) <&> \(V3 c' d' a') -> V4 a' b c' d'
_zwy f = _xyzw $ \(V4 a b c d) -> f (V3 c d b) <&> \(V3 c' d' b') -> V4 a b' c' d'
_wxy f = _xyzw $ \(V4 a b c d) -> f (V3 d a b) <&> \(V3 d' a' b') -> V4 a' b' c d'
_wxz f = _xyzw $ \(V4 a b c d) -> f (V3 d a c) <&> \(V3 d' a' c') -> V4 a' b c' d'
_wyx f = _xyzw $ \(V4 a b c d) -> f (V3 d b a) <&> \(V3 d' b' a') -> V4 a' b' c d'
_wyz f = _xyzw $ \(V4 a b c d) -> f (V3 d b c) <&> \(V3 d' b' c') -> V4 a b' c' d'
_wzx f = _xyzw $ \(V4 a b c d) -> f (V3 d c a) <&> \(V3 d' c' a') -> V4 a' b c' d'
_wzy f = _xyzw $ \(V4 a b c d) -> f (V3 d c b) <&> \(V3 d' c' b') -> V4 a b' c' d'
_xywz, _xzyw, _xzwy, _xwyz, _xwzy, _yxzw , _yxwz, _yzxw, _yzwx, _ywxz
, _ywzx, _zxyw, _zxwy, _zyxw, _zywx, _zwxy, _zwyx, _wxyz, _wxzy, _wyxz
, _wyzx, _wzxy, _wzyx :: R4 t => Lens' (t a) (V4 a)
_xywz f = _xyzw $ \(V4 a b c d) -> f (V4 a b d c) <&> \(V4 a' b' d' c') -> V4 a' b' c' d'
_xzyw f = _xyzw $ \(V4 a b c d) -> f (V4 a c b d) <&> \(V4 a' c' b' d') -> V4 a' b' c' d'
_xzwy f = _xyzw $ \(V4 a b c d) -> f (V4 a c d b) <&> \(V4 a' c' d' b') -> V4 a' b' c' d'
_xwyz f = _xyzw $ \(V4 a b c d) -> f (V4 a d b c) <&> \(V4 a' d' b' c') -> V4 a' b' c' d'
_xwzy f = _xyzw $ \(V4 a b c d) -> f (V4 a d c b) <&> \(V4 a' d' c' b') -> V4 a' b' c' d'
_yxzw f = _xyzw $ \(V4 a b c d) -> f (V4 b a c d) <&> \(V4 b' a' c' d') -> V4 a' b' c' d'
_yxwz f = _xyzw $ \(V4 a b c d) -> f (V4 b a d c) <&> \(V4 b' a' d' c') -> V4 a' b' c' d'
_yzxw f = _xyzw $ \(V4 a b c d) -> f (V4 b c a d) <&> \(V4 b' c' a' d') -> V4 a' b' c' d'
_yzwx f = _xyzw $ \(V4 a b c d) -> f (V4 b c d a) <&> \(V4 b' c' d' a') -> V4 a' b' c' d'
_ywxz f = _xyzw $ \(V4 a b c d) -> f (V4 b d a c) <&> \(V4 b' d' a' c') -> V4 a' b' c' d'
_ywzx f = _xyzw $ \(V4 a b c d) -> f (V4 b d c a) <&> \(V4 b' d' c' a') -> V4 a' b' c' d'
_zxyw f = _xyzw $ \(V4 a b c d) -> f (V4 c a b d) <&> \(V4 c' a' b' d') -> V4 a' b' c' d'
_zxwy f = _xyzw $ \(V4 a b c d) -> f (V4 c a d b) <&> \(V4 c' a' d' b') -> V4 a' b' c' d'
_zyxw f = _xyzw $ \(V4 a b c d) -> f (V4 c b a d) <&> \(V4 c' b' a' d') -> V4 a' b' c' d'
_zywx f = _xyzw $ \(V4 a b c d) -> f (V4 c b d a) <&> \(V4 c' b' d' a') -> V4 a' b' c' d'
_zwxy f = _xyzw $ \(V4 a b c d) -> f (V4 c d a b) <&> \(V4 c' d' a' b') -> V4 a' b' c' d'
_zwyx f = _xyzw $ \(V4 a b c d) -> f (V4 c d b a) <&> \(V4 c' d' b' a') -> V4 a' b' c' d'
_wxyz f = _xyzw $ \(V4 a b c d) -> f (V4 d a b c) <&> \(V4 d' a' b' c') -> V4 a' b' c' d'
_wxzy f = _xyzw $ \(V4 a b c d) -> f (V4 d a c b) <&> \(V4 d' a' c' b') -> V4 a' b' c' d'
_wyxz f = _xyzw $ \(V4 a b c d) -> f (V4 d b a c) <&> \(V4 d' b' a' c') -> V4 a' b' c' d'
_wyzx f = _xyzw $ \(V4 a b c d) -> f (V4 d b c a) <&> \(V4 d' b' c' a') -> V4 a' b' c' d'
_wzxy f = _xyzw $ \(V4 a b c d) -> f (V4 d c a b) <&> \(V4 d' c' a' b') -> V4 a' b' c' d'
_wzyx f = _xyzw $ \(V4 a b c d) -> f (V4 d c b a) <&> \(V4 d' c' b' a') -> V4 a' b' c' d'
ew :: R4 t => E t
ew = E _w
instance R1 V4 where
_x f (V4 a b c d) = (\a' -> V4 a' b c d) <$> f a
instance R2 V4 where
_y f (V4 a b c d) = (\b' -> V4 a b' c d) <$> f b
_xy f (V4 a b c d) = (\(V2 a' b') -> V4 a' b' c d) <$> f (V2 a b)
instance R3 V4 where
_z f (V4 a b c d) = (\c' -> V4 a b c' d) <$> f c
_xyz f (V4 a b c d) = (\(V3 a' b' c') -> V4 a' b' c' d) <$> f (V3 a b c)
instance R4 V4 where
_w f (V4 a b c d) = V4 a b c <$> f d
_xyzw = id
instance Storable a => Storable (V4 a) where
sizeOf _ = 4 * sizeOf (undefined::a)
alignment _ = alignment (undefined::a)
poke ptr (V4 x y z w) = do poke ptr' x
pokeElemOff ptr' 1 y
pokeElemOff ptr' 2 z
pokeElemOff ptr' 3 w
where ptr' = castPtr ptr
peek ptr = V4 <$> peek ptr' <*> peekElemOff ptr' 1
<*> peekElemOff ptr' 2 <*> peekElemOff ptr' 3
where ptr' = castPtr ptr
vector :: Num a => V3 a -> V4 a
vector (V3 a b c) = V4 a b c 0
point :: Num a => V3 a -> V4 a
point (V3 a b c) = V4 a b c 1
normalizePoint :: Fractional a => V4 a -> V3 a
normalizePoint (V4 a b c w) = (1/w) *^ V3 a b c
instance Epsilon a => Epsilon (V4 a) where
nearZero = nearZero . quadrance
instance Ix a => Ix (V4 a) where
range (V4 l1 l2 l3 l4,V4 u1 u2 u3 u4) =
[V4 i1 i2 i3 i4 | i1 <- range (l1,u1)
, i2 <- range (l2,u2)
, i3 <- range (l3,u3)
, i4 <- range (l4,u4)
]
unsafeIndex (V4 l1 l2 l3 l4,V4 u1 u2 u3 u4) (V4 i1 i2 i3 i4) =
unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) *
unsafeIndex (l1,u1) i1))
inRange (V4 l1 l2 l3 l4,V4 u1 u2 u3 u4) (V4 i1 i2 i3 i4) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3 && inRange (l4,u4) i4
instance Representable V4 where
type Rep V4 = E V4
tabulate f = V4 (f ex) (f ey) (f ez) (f ew)
index xs (E l) = view l xs
instance FunctorWithIndex (E V4) V4 where
imap f (V4 a b c d) = V4 (f ex a) (f ey b) (f ez c) (f ew d)
instance FoldableWithIndex (E V4) V4 where
ifoldMap f (V4 a b c d) = f ex a `mappend` f ey b `mappend` f ez c `mappend` f ew d
instance TraversableWithIndex (E V4) V4 where
itraverse f (V4 a b c d) = V4 <$> f ex a <*> f ey b <*> f ez c <*> f ew d
type instance Index (V4 a) = E V4
type instance IxValue (V4 a) = a
instance Ixed (V4 a) where
ix = el
instance Each (V4 a) (V4 b) a b where
each = traverse
data instance U.Vector (V4 a) = V_V4 !Int (U.Vector a)
data instance U.MVector s (V4 a) = MV_V4 !Int (U.MVector s a)
instance U.Unbox a => U.Unbox (V4 a)
instance U.Unbox a => M.MVector U.MVector (V4 a) where
basicLength (MV_V4 n _) = n
basicUnsafeSlice m n (MV_V4 _ v) = MV_V4 n (M.basicUnsafeSlice (4*m) (4*n) v)
basicOverlaps (MV_V4 _ v) (MV_V4 _ u) = M.basicOverlaps v u
basicUnsafeNew n = liftM (MV_V4 n) (M.basicUnsafeNew (4*n))
basicUnsafeRead (MV_V4 _ v) i =
do let o = 4*i
x <- M.basicUnsafeRead v o
y <- M.basicUnsafeRead v (o+1)
z <- M.basicUnsafeRead v (o+2)
w <- M.basicUnsafeRead v (o+3)
return (V4 x y z w)
basicUnsafeWrite (MV_V4 _ v) i (V4 x y z w) =
do let o = 4*i
M.basicUnsafeWrite v o x
M.basicUnsafeWrite v (o+1) y
M.basicUnsafeWrite v (o+2) z
M.basicUnsafeWrite v (o+3) w
instance U.Unbox a => G.Vector U.Vector (V4 a) where
basicUnsafeFreeze (MV_V4 n v) = liftM ( V_V4 n) (G.basicUnsafeFreeze v)
basicUnsafeThaw ( V_V4 n v) = liftM (MV_V4 n) (G.basicUnsafeThaw v)
basicLength ( V_V4 n _) = n
basicUnsafeSlice m n (V_V4 _ v) = V_V4 n (G.basicUnsafeSlice (4*m) (4*n) v)
basicUnsafeIndexM (V_V4 _ v) i =
do let o = 4*i
x <- G.basicUnsafeIndexM v o
y <- G.basicUnsafeIndexM v (o+1)
z <- G.basicUnsafeIndexM v (o+2)
w <- G.basicUnsafeIndexM v (o+3)
return (V4 x y z w)
instance MonadZip V4 where
mzipWith = liftA2
instance MonadFix V4 where
mfix f = V4 (let V4 a _ _ _ = f a in a)
(let V4 _ a _ _ = f a in a)
(let V4 _ _ a _ = f a in a)
(let V4 _ _ _ a = f a in a)
instance Bounded a => Bounded (V4 a) where
minBound = pure minBound
maxBound = pure maxBound
instance NFData a => NFData (V4 a) where
rnf (V4 a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d