#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
#endif
module Linear.Affine where
import Control.Applicative
import Data.Complex (Complex)
import Data.Foldable as Foldable
import Data.Functor.Bind
import Data.Functor.Identity (Identity)
import Data.HashMap.Lazy (HashMap)
import Data.Hashable
import Data.IntMap (IntMap)
import Data.Ix
import Data.Map (Map)
import Data.Traversable as Traversable
import Data.Vector (Vector)
import Foreign.Storable
#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.Core
import Linear.Epsilon
import Linear.Metric
import Linear.Plucker
import Linear.Quaternion
import Linear.V
import Linear.V0
import Linear.V1
import Linear.V2
import Linear.V3
import Linear.V4
import Linear.Vector
class Additive (Diff p) => Affine p where
type Diff p :: * -> *
infixl 6 .-.
(.-.) :: Num a => p a -> p a -> Diff p a
infixl 6 .+^
(.+^) :: Num a => p a -> Diff p a -> p a
infixl 6 .-^
(.-^) :: Num a => p a -> Diff p a -> p a
p .-^ v = p .+^ negated v
qdA :: (Affine p, Foldable (Diff p), Num a) => p a -> p a -> a
qdA a b = Foldable.sum (fmap (join (*)) (a .-. b))
distanceA :: (Floating a, Foldable (Diff p), Affine p) => p a -> p a -> a
distanceA a b = sqrt (qdA a b)
#define ADDITIVEC(CTX,T) instance CTX => Affine T where type Diff T = T ; \
(.-.) = (^-^) ; ; (.+^) = (^+^) ; ; \
(.-^) = (^-^) ;
#define ADDITIVE(T) ADDITIVEC((), T)
ADDITIVE([])
ADDITIVE(Complex)
ADDITIVE(ZipList)
ADDITIVE(Maybe)
ADDITIVE(IntMap)
ADDITIVE(Identity)
ADDITIVE(Vector)
ADDITIVE(V0)
ADDITIVE(V1)
ADDITIVE(V2)
ADDITIVE(V3)
ADDITIVE(V4)
ADDITIVE(Plucker)
ADDITIVE(Quaternion)
ADDITIVE(((->) b))
ADDITIVEC(Ord k, (Map k))
ADDITIVEC((Eq k, Hashable k), (HashMap k))
ADDITIVEC(Dim n, (V n))
newtype Point f a = P (f a)
deriving ( Eq, Ord, Show, Read, Monad, Functor, Applicative, Foldable
, Traversable, Apply, Additive, Metric
, Fractional , Num, Ix, Storable, Epsilon
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
, Generic
#endif
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
)
lensP :: Functor f => (g a -> f (g a)) -> Point g a -> f (Point g a)
lensP afb (P a) = (\b -> P b) <$> afb a
instance Bind f => Bind (Point f) where
join (P m) = P $ join $ fmap (\(P m')->m') m
instance Core f => Core (Point f) where
core f = P $ core (\l->f (lensP . l))
instance R1 f => R1 (Point f) where
_x = lensP . _x
instance R2 f => R2 (Point f) where
_y = lensP . _y
_xy = lensP . _xy
instance R3 f => R3 (Point f) where
_z = lensP . _z
_xyz = lensP . _xyz
instance R4 f => R4 (Point f) where
_w = lensP . _w
_xyzw = lensP . _xyzw
instance Additive f => Affine (Point f) where
type Diff (Point f) = f
P x .-. P y = x ^-^ y
P x .+^ v = P (x ^+^ v)
P x .-^ v = P (x ^-^ v)
origin :: (Additive f, Num a) => Point f a
origin = P zero