module Linear.V2
( V2(..)
, R2(..)
, perp
) where
import Control.Applicative
import Data.Data
import Data.Distributive
import Data.Foldable
import Data.Traversable
import Data.Semigroup
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Functor.Bind
import Foreign.Ptr (castPtr)
import Foreign.Storable (Storable(..))
import GHC.Arr (Ix(..))
import Linear.Core
import Linear.Metric
import Linear.Epsilon
import Linear.Vector
import Prelude hiding (sum)
data V2 a = V2 !a !a deriving (Eq,Ord,Show,Read,Data,Typeable)
instance Functor V2 where
fmap f (V2 a b) = V2 (f a) (f b)
a <$ _ = V2 a a
instance Foldable V2 where
foldMap f (V2 a b) = f a `mappend` f b
instance Traversable V2 where
traverse f (V2 a b) = V2 <$> f a <*> f b
instance Foldable1 V2 where
foldMap1 f (V2 a b) = f a <> f b
instance Traversable1 V2 where
traverse1 f (V2 a b) = V2 <$> f a <.> f b
instance Apply V2 where
V2 a b <.> V2 d e = V2 (a d) (b e)
instance Applicative V2 where
pure a = V2 a a
V2 a b <*> V2 d e = V2 (a d) (b e)
instance Additive V2 where
zero = pure 0
liftU2 = liftA2
liftI2 = liftA2
instance Bind V2 where
V2 a b >>- f = V2 a' b' where
V2 a' _ = f a
V2 _ b' = f b
instance Monad V2 where
return a = V2 a a
V2 a b >>= f = V2 a' b' where
V2 a' _ = f a
V2 _ b' = f b
instance Num a => Num (V2 a) where
(+) = liftA2 (+)
() = liftA2 ()
(*) = liftA2 (*)
negate = fmap negate
abs = fmap abs
signum = fmap signum
fromInteger = pure . fromInteger
instance Fractional a => Fractional (V2 a) where
recip = fmap recip
(/) = liftA2 (/)
fromRational = pure . fromRational
instance Metric V2 where
dot (V2 a b) (V2 c d) = a * c + b * d
class R2 t where
_x :: Functor f => (a -> f a) -> t a -> f (t a)
_x = _xy._x
_y :: Functor f => (a -> f a) -> t a -> f (t a)
_y = _xy._y
_xy :: Functor f => (V2 a -> f (V2 a)) -> t a -> f (t a)
instance R2 V2 where
_x f (V2 a b) = (`V2` b) <$> f a
_y f (V2 a b) = V2 a <$> f b
_xy = id
instance Core V2 where
core f = V2 (f _x) (f _y)
instance Distributive V2 where
distribute f = V2 (fmap (\(V2 x _) -> x) f) (fmap (\(V2 _ y) -> y) f)
perp :: Num a => V2 a -> V2 a
perp (V2 a b) = V2 (negate b) a
instance Epsilon a => Epsilon (V2 a) where
nearZero = nearZero . quadrance
instance Storable a => Storable (V2 a) where
sizeOf _ = 2 * sizeOf (undefined::a)
alignment _ = alignment (undefined::a)
poke ptr (V2 x y) = poke ptr' x >> pokeElemOff ptr' 1 y
where ptr' = castPtr ptr
peek ptr = V2 <$> peek ptr' <*> peekElemOff ptr' 1
where ptr' = castPtr ptr
instance Ix a => Ix (V2 a) where
range (V2 l1 l2,V2 u1 u2) =
[ V2 i1 i2 | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
unsafeIndex (V2 l1 l2,V2 u1 u2) (V2 i1 i2) =
unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
inRange (V2 l1 l2,V2 u1 u2) (V2 i1 i2) =
inRange (l1,u1) i1 && inRange (l2,u2) i2