{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE ImpredicativeTypes    #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.LinearMap
-- Copyright   :  (c) 2014-2015 diagrams team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Linear maps. Unlike 'Transformation's these are not restricted to the
-- same space. In practice these are used for projections in
-- "Diagrams.ThreeD.Projection". Unless you want to work with
-- projections you're probably better off using 'Diagrams.Transform'.
--
-- Currently only path-like things can be projected. In the future we
-- hope to support projecting diagrams.
--
-----------------------------------------------------------------------------

module Diagrams.LinearMap
  ( -- * Linear maps
    LinearMap (..)
  , LinearMappable (..)
    -- ** Applying linear maps
  , linmap

    -- * Affine maps
  , AffineMap (..)
  , AffineMappable (..)

    -- ** Constructing affine maps
  , mkAffineMap
  , toAffineMap
  ) where

import           Control.Lens
import           Data.FingerTree         as FT
import qualified Data.Foldable           as F

import           Diagrams.Core
import           Diagrams.Core.Transform
import           Diagrams.Located
import           Diagrams.Path
import           Diagrams.Segment
import           Diagrams.Trail          hiding (offset)

import           Linear.Affine
import           Linear.Metric
import           Linear.Vector


-- | Type for holding linear maps. Note that these are not affine transforms so
--   attemping apply a translation with 'LinearMap' will likely produce incorrect
--   results.
newtype LinearMap v u n = LinearMap { forall (v :: * -> *) (u :: * -> *) n. LinearMap v u n -> v n -> u n
lapply :: v n -> u n }

toLinearMap :: Transformation v n -> LinearMap v v n
toLinearMap :: forall (v :: * -> *) n. Transformation v n -> LinearMap v v n
toLinearMap (Transformation (v n -> v n
m :-: v n -> v n
_) v n :-: v n
_ v n
_) = (v n -> v n) -> LinearMap v v n
forall (v :: * -> *) (u :: * -> *) n.
(v n -> u n) -> LinearMap v u n
LinearMap v n -> v n
m

-- | Class of things that have vectors that can be mapped over.
class LinearMappable a b where
  -- | Apply a linear map to an object. If the map is not linear,
  --   behaviour will likely be wrong.
  vmap :: (Vn a -> Vn b) -> a -> b
  -- this uses a function instead of LinearMap so we can also use this
  -- class to change number types

-- Note: instances need to be of the form
--
-- r ~ A u m => LinearMappable (A v n) r
--
-- so ghc knows there's only one possible result from calling vmap.

-- | Apply a linear map.
linmap :: (InSpace v n a, LinearMappable a b, N b ~ n)
     => LinearMap v (V b) n -> a -> b
linmap :: forall (v :: * -> *) n a b.
(InSpace v n a, LinearMappable a b, N b ~ n) =>
LinearMap v (V b) n -> a -> b
linmap = (Vn a -> Vn b) -> a -> b
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap ((Vn a -> Vn b) -> a -> b)
-> (LinearMap (V a) (V b) (N a) -> Vn a -> Vn b)
-> LinearMap (V a) (V b) (N a)
-> a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinearMap (V a) (V b) (N a) -> Vn a -> V b (N a)
LinearMap (V a) (V b) (N a) -> Vn a -> Vn b
forall (v :: * -> *) (u :: * -> *) n. LinearMap v u n -> v n -> u n
lapply

instance r ~ Offset c u m => LinearMappable (Offset c v n) r where
  vmap :: (Vn (Offset c v n) -> Vn r) -> Offset c v n -> r
vmap Vn (Offset c v n) -> Vn r
f (OffsetClosed v n
v) = Vn r -> Offset Closed (V r) (N r)
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed (Vn (Offset c v n) -> Vn r
f v n
Vn (Offset c v n)
v)
  vmap Vn (Offset c v n) -> Vn r
_ Offset c v n
OffsetOpen       = r
Offset Open u m
forall (v :: * -> *) n. Offset Open v n
OffsetOpen
  {-# INLINE vmap #-}

instance r ~ Segment c u m => LinearMappable (Segment c v n) r where
  vmap :: (Vn (Segment c v n) -> Vn r) -> Segment c v n -> r
vmap Vn (Segment c v n) -> Vn r
f (Linear Offset c v n
offset)      = Offset c u m -> Segment c u m
forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear ((Vn (Offset c v n) -> Vn (Offset c u m))
-> Offset c v n -> Offset c u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Segment c v n) -> Vn r
Vn (Offset c v n) -> Vn (Offset c u m)
f Offset c v n
offset)
  vmap Vn (Segment c v n) -> Vn r
f (Cubic v n
v1 v n
v2 Offset c v n
offset) = Vn r -> Vn r -> Offset c (V r) (N r) -> Segment c (V r) (N r)
forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic (Vn (Segment c v n) -> Vn r
f v n
Vn (Segment c v n)
v1) (Vn (Segment c v n) -> Vn r
f v n
Vn (Segment c v n)
v2) ((Vn (Offset c v n) -> Vn (Offset c (V r) (N r)))
-> Offset c v n -> Offset c (V r) (N r)
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Segment c v n) -> Vn r
Vn (Offset c v n) -> Vn (Offset c (V r) (N r))
f Offset c v n
offset)
  {-# INLINE vmap #-}

instance (Metric v, Metric u, OrderedField n, OrderedField m, r ~ SegTree u m)
    => LinearMappable (SegTree v n) r where
  vmap :: (Vn (SegTree v n) -> Vn r) -> SegTree v n -> r
vmap Vn (SegTree v n) -> Vn r
f = ASetter (SegTree v n) r (Unwrapped (SegTree v n)) (Unwrapped r)
-> (Unwrapped (SegTree v n) -> Unwrapped r) -> SegTree v n -> r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (SegTree v n) r (Unwrapped (SegTree v n)) (Unwrapped r)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso (SegTree v n) r (Unwrapped (SegTree v n)) (Unwrapped r)
_Wrapped ((Segment Closed v n -> Segment Closed u m)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
-> FingerTree (SegMeasure u m) (Segment Closed u m)
forall v1 a1 v2 a2.
(Measured v1 a1, Measured v2 a2) =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
fmap' ((Vn (Segment Closed v n) -> Vn (Segment Closed u m))
-> Segment Closed v n -> Segment Closed u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Segment Closed v n) -> Vn (Segment Closed u m)
Vn (SegTree v n) -> Vn r
f))
  {-# INLINE vmap #-}

instance (Metric v, Metric u, OrderedField n, OrderedField m, r ~ Trail' l u m)
    => LinearMappable (Trail' l v n) r where
  vmap :: (Vn (Trail' l v n) -> Vn r) -> Trail' l v n -> r
vmap Vn (Trail' l v n) -> Vn r
f (Line SegTree v n
st)        = SegTree u m -> Trail' Line u m
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line ((Vn (SegTree v n) -> Vn (SegTree u m))
-> SegTree v n -> SegTree u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Trail' l v n) -> Vn r
Vn (SegTree v n) -> Vn (SegTree u m)
f SegTree v n
st)
  vmap Vn (Trail' l v n) -> Vn r
f (Loop SegTree v n
st Segment Open v n
offset) = SegTree u m -> Segment Open u m -> Trail' Loop u m
forall (v :: * -> *) n.
SegTree v n -> Segment Open v n -> Trail' Loop v n
Loop ((Vn (SegTree v n) -> Vn (SegTree u m))
-> SegTree v n -> SegTree u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Trail' l v n) -> Vn r
Vn (SegTree v n) -> Vn (SegTree u m)
f SegTree v n
st) ((Vn (Segment Open v n) -> Vn (Segment Open u m))
-> Segment Open v n -> Segment Open u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Segment Open v n) -> Vn (Segment Open u m)
Vn (Trail' l v n) -> Vn r
f Segment Open v n
offset)
  {-# INLINE vmap #-}

instance (Metric v, Metric u, OrderedField n, OrderedField m, r ~ Trail u m)
    => LinearMappable (Trail v n) r where
  vmap :: (Vn (Trail v n) -> Vn r) -> Trail v n -> r
vmap Vn (Trail v n) -> Vn r
f (Trail (Line SegTree v n
st))        = Trail' Line u m -> Trail u m
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail (Trail' Line u m -> Trail u m) -> Trail' Line u m -> Trail u m
forall a b. (a -> b) -> a -> b
$ SegTree u m -> Trail' Line u m
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line ((Vn (SegTree v n) -> Vn (SegTree u m))
-> SegTree v n -> SegTree u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Trail v n) -> Vn r
Vn (SegTree v n) -> Vn (SegTree u m)
f SegTree v n
st)
  vmap Vn (Trail v n) -> Vn r
f (Trail (Loop SegTree v n
st Segment Open v n
offset)) = Trail' Loop u m -> Trail u m
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail (Trail' Loop u m -> Trail u m) -> Trail' Loop u m -> Trail u m
forall a b. (a -> b) -> a -> b
$ SegTree u m -> Segment Open u m -> Trail' Loop u m
forall (v :: * -> *) n.
SegTree v n -> Segment Open v n -> Trail' Loop v n
Loop ((Vn (SegTree v n) -> Vn (SegTree u m))
-> SegTree v n -> SegTree u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Trail v n) -> Vn r
Vn (SegTree v n) -> Vn (SegTree u m)
f SegTree v n
st) ((Vn (Segment Open v n) -> Vn (Segment Open u m))
-> Segment Open v n -> Segment Open u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Segment Open v n) -> Vn (Segment Open u m)
Vn (Trail v n) -> Vn r
f Segment Open v n
offset)
  {-# INLINE vmap #-}

instance LinearMappable (Point v n) (Point u m) where
  vmap :: (Vn (Point v n) -> Vn (Point u m)) -> Point v n -> Point u m
vmap Vn (Point v n) -> Vn (Point u m)
f (P v n
v) = Vn (Point u m) -> Point (V (Point u m)) (N (Point u m))
forall (f :: * -> *) a. f a -> Point f a
P (Vn (Point v n) -> Vn (Point u m)
f v n
Vn (Point v n)
v)
  {-# INLINE vmap #-}

instance r ~ FixedSegment u m => LinearMappable (FixedSegment v n) r where
  vmap :: (Vn (FixedSegment v n) -> Vn r) -> FixedSegment v n -> r
vmap Vn (FixedSegment v n) -> Vn r
f (FLinear Point v n
p0 Point v n
p1)      = Point u m -> Point u m -> FixedSegment u m
forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear ((Vn (Point v n) -> Vn (Point u m)) -> Point v n -> Point u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Point v n) -> Vn (Point u m)
Vn (FixedSegment v n) -> Vn r
f Point v n
p0) ((Vn (Point v n) -> Vn (Point u m)) -> Point v n -> Point u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Point v n) -> Vn (Point u m)
Vn (FixedSegment v n) -> Vn r
f Point v n
p1)
  vmap Vn (FixedSegment v n) -> Vn r
f (FCubic Point v n
p0 Point v n
p1 Point v n
p2 Point v n
p3) = Point u m
-> Point u m -> Point u m -> Point u m -> FixedSegment u m
forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic ((Vn (Point v n) -> Vn (Point u m)) -> Point v n -> Point u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Point v n) -> Vn (Point u m)
Vn (FixedSegment v n) -> Vn r
f Point v n
p0) ((Vn (Point v n) -> Vn (Point u m)) -> Point v n -> Point u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Point v n) -> Vn (Point u m)
Vn (FixedSegment v n) -> Vn r
f Point v n
p1)
                                       ((Vn (Point v n) -> Vn (Point u m)) -> Point v n -> Point u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Point v n) -> Vn (Point u m)
Vn (FixedSegment v n) -> Vn r
f Point v n
p2) ((Vn (Point v n) -> Vn (Point u m)) -> Point v n -> Point u m
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Point v n) -> Vn (Point u m)
Vn (FixedSegment v n) -> Vn r
f Point v n
p3)
  {-# INLINE vmap #-}

instance (LinearMappable a b, r ~ Located b) => LinearMappable (Located a) r where
  vmap :: (Vn (Located a) -> Vn r) -> Located a -> r
vmap Vn (Located a) -> Vn r
f (Loc Point (V a) (N a)
p a
a) = Point (V b) (N b) -> b -> Located b
forall a. Point (V a) (N a) -> a -> Located a
Loc ((Vn (Point (V a) (N a)) -> Vn (Point (V b) (N b)))
-> Point (V a) (N a) -> Point (V b) (N b)
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Point (V a) (N a)) -> Vn (Point (V b) (N b))
Vn (Located a) -> Vn r
f Point (V a) (N a)
p) ((Vn a -> Vn b) -> a -> b
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn a -> Vn b
Vn (Located a) -> Vn r
f a
a)
  {-# INLINE vmap #-}

instance (Metric v, Metric u, OrderedField n, OrderedField m, r ~ Path u m)
    => LinearMappable (Path v n) r where
  vmap :: (Vn (Path v n) -> Vn r) -> Path v n -> r
vmap Vn (Path v n) -> Vn r
f = (Unwrapped (Path v n) -> Identity (Unwrapped r))
-> Path v n -> Identity r
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso (Path v n) r (Unwrapped (Path v n)) (Unwrapped r)
_Wrapped ((Unwrapped (Path v n) -> Identity (Unwrapped r))
 -> Path v n -> Identity r)
-> ((Located (Trail v n) -> Identity (Located (Trail u m)))
    -> Unwrapped (Path v n) -> Identity (Unwrapped r))
-> (Located (Trail v n) -> Identity (Located (Trail u m)))
-> Path v n
-> Identity r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (Trail v n) -> Identity (Located (Trail u m)))
-> [Located (Trail v n)] -> Identity [Located (Trail u m)]
(Located (Trail v n) -> Identity (Located (Trail u m)))
-> Unwrapped (Path v n) -> Identity (Unwrapped r)
Setter
  [Located (Trail v n)]
  [Located (Trail u m)]
  (Located (Trail v n))
  (Located (Trail u m))
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((Located (Trail v n) -> Identity (Located (Trail u m)))
 -> Path v n -> Identity r)
-> (Located (Trail v n) -> Located (Trail u m)) -> Path v n -> r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Vn (Located (Trail v n)) -> Vn (Located (Trail u m)))
-> Located (Trail v n) -> Located (Trail u m)
forall a b. LinearMappable a b => (Vn a -> Vn b) -> a -> b
vmap Vn (Located (Trail v n)) -> Vn (Located (Trail u m))
Vn (Path v n) -> Vn r
f
  {-# INLINE vmap #-}

-- | Affine linear maps. Unlike 'Transformation' these do not have to be
--   invertible so we can map between spaces.
data AffineMap v u n = AffineMap (LinearMap v u n) (u n)

-- | Make an affine map from a linear function and a translation.
mkAffineMap :: (v n -> u n) -> u n -> AffineMap v u n
mkAffineMap :: forall (v :: * -> *) n (u :: * -> *).
(v n -> u n) -> u n -> AffineMap v u n
mkAffineMap v n -> u n
f = LinearMap v u n -> u n -> AffineMap v u n
forall (v :: * -> *) (u :: * -> *) n.
LinearMap v u n -> u n -> AffineMap v u n
AffineMap ((v n -> u n) -> LinearMap v u n
forall (v :: * -> *) (u :: * -> *) n.
(v n -> u n) -> LinearMap v u n
LinearMap v n -> u n
f)

toAffineMap :: Transformation v n -> AffineMap v v n
toAffineMap :: forall (v :: * -> *) n. Transformation v n -> AffineMap v v n
toAffineMap Transformation v n
t = LinearMap v v n -> v n -> AffineMap v v n
forall (v :: * -> *) (u :: * -> *) n.
LinearMap v u n -> u n -> AffineMap v u n
AffineMap (Transformation v n -> LinearMap v v n
forall (v :: * -> *) n. Transformation v n -> LinearMap v v n
toLinearMap Transformation v n
t) (Transformation v n -> v n
forall (v :: * -> *) n. Transformation v n -> v n
transl Transformation v n
t)

class (LinearMappable a b, N a ~ N b) => AffineMappable a b where
  -- | Affine map over an object. Has a default implimentation of only
  --   applying the linear map
  amap :: (Additive (V a), F.Foldable (V a), Additive (V b), Num (N b))
       => AffineMap (V a) (V b) (N b) -> a -> b
  amap (AffineMap LinearMap (V a) (V b) (N b)
f V b (N b)
_) = LinearMap (V a) (V b) (N b) -> a -> b
forall (v :: * -> *) n a b.
(InSpace v n a, LinearMappable a b, N b ~ n) =>
LinearMap v (V b) n -> a -> b
linmap LinearMap (V a) (V b) (N b)
f
  {-# INLINE amap #-}

instance r ~ Offset c u n => AffineMappable (Offset c v n) r
instance r ~ Segment c u n => AffineMappable (Segment c v n) r
instance (Metric v, Metric u, OrderedField n, r ~ SegTree u n) => AffineMappable (SegTree v n) r
instance (Metric v, Metric u, OrderedField n, r ~ Trail' l u n) => AffineMappable (Trail' l v n) r
instance (Metric v, Metric u, OrderedField n, r ~ Trail u n) => AffineMappable (Trail v n) r

instance (Additive v, Num n, r ~ Point u n) => AffineMappable (Point v n) r where
  amap :: (Additive (V (Point v n)), Foldable (V (Point v n)),
 Additive (V r), Num (N r)) =>
AffineMap (V (Point v n)) (V r) (N r) -> Point v n -> r
amap (AffineMap LinearMap (V (Point v n)) (V r) (N r)
f V r (N r)
v) Point v n
p = LinearMap (V (Point v n)) (V (Point u n)) (N r)
-> Point v n -> Point u n
forall (v :: * -> *) n a b.
(InSpace v n a, LinearMappable a b, N b ~ n) =>
LinearMap v (V b) n -> a -> b
linmap LinearMap (V (Point v n)) (V r) (N r)
LinearMap (V (Point v n)) (V (Point u n)) (N r)
f Point v n
p Point u n -> Diff (Point u) n -> Point u n
forall a. Num a => Point u a -> Diff (Point u) a -> Point u a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V r (N r)
Diff (Point u) n
v
  {-# INLINE amap #-}

instance r ~ FixedSegment u n => AffineMappable (FixedSegment v n) r where
  amap :: (Additive (V (FixedSegment v n)), Foldable (V (FixedSegment v n)),
 Additive (V r), Num (N r)) =>
AffineMap (V (FixedSegment v n)) (V r) (N r)
-> FixedSegment v n -> r
amap AffineMap (V (FixedSegment v n)) (V r) (N r)
m (FLinear Point v n
p0 Point v n
p1)      = Point u n -> Point u n -> FixedSegment u n
forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear (AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
-> Point v n -> Point u n
forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
AffineMap (V (FixedSegment v n)) (V r) (N r)
m Point v n
p0) (AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
-> Point v n -> Point u n
forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
AffineMap (V (FixedSegment v n)) (V r) (N r)
m Point v n
p1)
  amap AffineMap (V (FixedSegment v n)) (V r) (N r)
m (FCubic Point v n
p0 Point v n
p1 Point v n
p2 Point v n
p3) = Point u n
-> Point u n -> Point u n -> Point u n -> FixedSegment u n
forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic (AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
-> Point v n -> Point u n
forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
AffineMap (V (FixedSegment v n)) (V r) (N r)
m Point v n
p0) (AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
-> Point v n -> Point u n
forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
AffineMap (V (FixedSegment v n)) (V r) (N r)
m Point v n
p1) (AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
-> Point v n -> Point u n
forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
AffineMap (V (FixedSegment v n)) (V r) (N r)
m Point v n
p2) (AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
-> Point v n -> Point u n
forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap AffineMap (V (Point v n)) (V (Point u n)) (N (Point u n))
AffineMap (V (FixedSegment v n)) (V r) (N r)
m Point v n
p3)
  {-# INLINE amap #-}

instance (LinearMappable a b, N a ~ N b, r ~ Located b) => AffineMappable (Located a) r where
  amap :: (Additive (V (Located a)), Foldable (V (Located a)),
 Additive (V r), Num (N r)) =>
AffineMap (V (Located a)) (V r) (N r) -> Located a -> r
amap m :: AffineMap (V (Located a)) (V r) (N r)
m@(AffineMap LinearMap (V (Located a)) (V r) (N r)
l V r (N r)
_) (Loc Point (V a) (N a)
p a
x) = Point (V b) (N b) -> b -> Located b
forall a. Point (V a) (N a) -> a -> Located a
Loc (AffineMap
  (V (Point (V a) (N a)))
  (V (Point (V b) (N b)))
  (N (Point (V b) (N b)))
-> Point (V a) (N a) -> Point (V b) (N b)
forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap AffineMap
  (V (Point (V a) (N a)))
  (V (Point (V b) (N b)))
  (N (Point (V b) (N b)))
AffineMap (V (Located a)) (V r) (N r)
m Point (V a) (N a)
p) (LinearMap (V (Located a)) (V b) (N r) -> a -> b
forall (v :: * -> *) n a b.
(InSpace v n a, LinearMappable a b, N b ~ n) =>
LinearMap v (V b) n -> a -> b
linmap LinearMap (V (Located a)) (V b) (N r)
LinearMap (V (Located a)) (V r) (N r)
l a
x)
  {-# INLINE amap #-}

instance (Metric v, Metric u, OrderedField n, r ~ Path u n)
    => AffineMappable (Path v n) r where
  amap :: (Additive (V (Path v n)), Foldable (V (Path v n)), Additive (V r),
 Num (N r)) =>
AffineMap (V (Path v n)) (V r) (N r) -> Path v n -> r
amap AffineMap (V (Path v n)) (V r) (N r)
m = (Unwrapped (Path v n) -> Identity (Unwrapped r))
-> Path v n -> Identity r
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso (Path v n) r (Unwrapped (Path v n)) (Unwrapped r)
_Wrapped ((Unwrapped (Path v n) -> Identity (Unwrapped r))
 -> Path v n -> Identity r)
-> ((Located (Trail v n) -> Identity (Located (Trail u n)))
    -> Unwrapped (Path v n) -> Identity (Unwrapped r))
-> (Located (Trail v n) -> Identity (Located (Trail u n)))
-> Path v n
-> Identity r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (Trail v n) -> Identity (Located (Trail u n)))
-> [Located (Trail v n)] -> Identity [Located (Trail u n)]
(Located (Trail v n) -> Identity (Located (Trail u n)))
-> Unwrapped (Path v n) -> Identity (Unwrapped r)
Setter
  [Located (Trail v n)]
  [Located (Trail u n)]
  (Located (Trail v n))
  (Located (Trail u n))
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((Located (Trail v n) -> Identity (Located (Trail u n)))
 -> Path v n -> Identity r)
-> (Located (Trail v n) -> Located (Trail u n)) -> Path v n -> r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AffineMap
  (V (Located (Trail v n)))
  (V (Located (Trail u n)))
  (N (Located (Trail u n)))
-> Located (Trail v n) -> Located (Trail u n)
forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap AffineMap
  (V (Located (Trail v n)))
  (V (Located (Trail u n)))
  (N (Located (Trail u n)))
AffineMap (V (Path v n)) (V r) (N r)
m
  {-# INLINE amap #-}