#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
#endif
module Linear.V2
( V2(..)
, R1(..)
, R2(..)
, ex, ey
, perp
) where
import Control.Applicative
import Control.Lens hiding ((<.>))
import Data.Data
import Data.Distributive
import Data.Foldable
import Data.Functor.Bind
import Data.Functor.Rep
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 Linear.Metric
import Linear.Epsilon
import Linear.Vector
import Linear.V1 (R1(..),ex)
import Prelude hiding (sum)
data V2 a = V2 !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 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 R1 t => R2 t where
_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)
ey :: R2 t => E t
ey = E _y
instance R1 V2 where
_x f (V2 a b) = (`V2` b) <$> f a
instance R2 V2 where
_y f (V2 a b) = V2 a <$> f b
_xy = id
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
instance Representable V2 where
type Rep V2 = E V2
tabulate f = V2 (f ex) (f ey)
index xs (E l) = view l xs
instance FunctorWithIndex (E V2) V2 where
imap f (V2 a b) = V2 (f ex a) (f ey b)
instance FoldableWithIndex (E V2) V2 where
ifoldMap f (V2 a b) = f ex a `mappend` f ey b
instance TraversableWithIndex (E V2) V2 where
itraverse f (V2 a b) = V2 <$> f ex a <*> f ey b
type instance Index (V2 a) = E V2
type instance IxValue (V2 a) = a
#if MIN_VERSION_lens(4,0,0)
instance Ixed (V2 a) where
ix = el
#else
instance Functor f => Ixed f (V2 a) where
ix i f = el i (indexed f i)
#endif