{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs                #-} -- for ghc < 7.8, TypeFamilies covers GADT patten mathcing in > 7.8
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Tangent
-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Computing tangent and normal vectors for segments and trails.
--
-----------------------------------------------------------------------------
module Diagrams.Tangent
    ( -- ** Tangents
      tangentAtParam
    , tangentAtStart
    , tangentAtEnd

      -- ** Normals
    , normalAtParam
    , normalAtStart
    , normalAtEnd

      -- ** Tangent newtype
    , Tangent(..)
    )
    where

import           Diagrams.Core
import           Diagrams.Located
import           Diagrams.Parametric
import           Diagrams.Segment

import           Linear.Vector
import           Linear.Metric
import           Linear.V2

------------------------------------------------------------
-- Tangent
------------------------------------------------------------

-- | A newtype wrapper used to give different instances of
--   'Parametric' and 'EndValues' that compute tangent vectors.
newtype Tangent t = Tangent t

type instance V (Tangent t) = V t
type instance N (Tangent t) = N t
type instance Codomain (Tangent t) = V t

instance DomainBounds t => DomainBounds (Tangent t) where
  domainLower :: Tangent t -> N (Tangent t)
domainLower (Tangent t
t) = t -> N t
forall p. DomainBounds p => p -> N p
domainLower t
t
  domainUpper :: Tangent t -> N (Tangent t)
domainUpper (Tangent t
t) = t -> N t
forall p. DomainBounds p => p -> N p
domainUpper t
t

instance Parametric (Tangent t) => Parametric (Tangent (Located t)) where
  Tangent Located t
l atParam :: Tangent (Located t)
-> N (Tangent (Located t))
-> Codomain (Tangent (Located t)) (N (Tangent (Located t)))
`atParam` N (Tangent (Located t))
p = t -> Tangent t
forall t. t -> Tangent t
Tangent (Located t -> t
forall a. Located a -> a
unLoc Located t
l) Tangent t -> N (Tangent t) -> Codomain (Tangent t) (N (Tangent t))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N (Tangent t)
N (Tangent (Located t))
p

instance (DomainBounds t, EndValues (Tangent t))
    => EndValues (Tangent (Located t)) where
  atStart :: Tangent (Located t)
-> Codomain (Tangent (Located t)) (N (Tangent (Located t)))
atStart (Tangent Located t
l) = Tangent t -> Codomain (Tangent t) (N (Tangent t))
forall p. EndValues p => p -> Codomain p (N p)
atStart (t -> Tangent t
forall t. t -> Tangent t
Tangent (Located t -> t
forall a. Located a -> a
unLoc Located t
l))
  atEnd :: Tangent (Located t)
-> Codomain (Tangent (Located t)) (N (Tangent (Located t)))
atEnd   (Tangent Located t
l) = Tangent t -> Codomain (Tangent t) (N (Tangent t))
forall p. EndValues p => p -> Codomain p (N p)
atEnd   (t -> Tangent t
forall t. t -> Tangent t
Tangent (Located t -> t
forall a. Located a -> a
unLoc Located t
l))

-- | Compute the tangent vector to a segment or trail at a particular
--   parameter.
--
--   Examples of more specific types this function can have include
--
--   * @Segment Closed V2 -> Double -> V2 Double@
--
--   * @Trail' Line V2 -> Double -> V2 Double@
--
--   * @Located (Trail V2) -> Double -> V2 Double@
--
--   See the instances listed for the 'Tangent' newtype for more.
tangentAtParam :: Parametric (Tangent t) => t -> N t -> Vn t
tangentAtParam :: forall t. Parametric (Tangent t) => t -> N t -> Vn t
tangentAtParam t
t N t
p = t -> Tangent t
forall t. t -> Tangent t
Tangent t
t Tangent t -> N (Tangent t) -> Codomain (Tangent t) (N (Tangent t))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N t
N (Tangent t)
p

-- | Compute the tangent vector at the start of a segment or trail.
tangentAtStart :: EndValues (Tangent t) => t -> Vn t
tangentAtStart :: forall t. EndValues (Tangent t) => t -> Vn t
tangentAtStart = Tangent t -> V t (N t)
Tangent t -> Codomain (Tangent t) (N (Tangent t))
forall p. EndValues p => p -> Codomain p (N p)
atStart (Tangent t -> V t (N t)) -> (t -> Tangent t) -> t -> V t (N t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Tangent t
forall t. t -> Tangent t
Tangent

-- | Compute the tangent vector at the end of a segment or trail.
tangentAtEnd :: EndValues (Tangent t) => t -> Vn t
tangentAtEnd :: forall t. EndValues (Tangent t) => t -> Vn t
tangentAtEnd = Tangent t -> V t (N t)
Tangent t -> Codomain (Tangent t) (N (Tangent t))
forall p. EndValues p => p -> Codomain p (N p)
atEnd (Tangent t -> V t (N t)) -> (t -> Tangent t) -> t -> V t (N t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Tangent t
forall t. t -> Tangent t
Tangent

--------------------------------------------------
-- Segment

instance (Additive v, Num n)
    => Parametric (Tangent (Segment Closed v n)) where
  Tangent (Linear (OffsetClosed v n
v)) atParam :: Tangent (Segment Closed v n)
-> N (Tangent (Segment Closed v n))
-> Codomain
     (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
`atParam` N (Tangent (Segment Closed v n))
_ = v n
Codomain
  (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
v
  Tangent (Cubic v n
c1 v n
c2 (OffsetClosed v n
x2)) `atParam` N (Tangent (Segment Closed v n))
p
    = (n
3n -> n -> n
forall a. Num a => a -> a -> a
*(n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Tangent (Segment Closed v n))
pn -> n -> n
forall a. Num a => a -> a -> a
*n
N (Tangent (Segment Closed v n))
pn -> n -> n
forall a. Num a => a -> a -> a
-n
4n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Tangent (Segment Closed v n))
pn -> n -> n
forall a. Num a => a -> a -> a
+n
1))n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^v n
c1 v n -> v n -> v n
forall a. Num a => v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (n
3n -> n -> n
forall a. Num a => a -> a -> a
*(n
2n -> n -> n
forall a. Num a => a -> a -> a
-n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Tangent (Segment Closed v n))
p)n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Tangent (Segment Closed v n))
p)n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^v n
c2 v n -> v n -> v n
forall a. Num a => v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Tangent (Segment Closed v n))
pn -> n -> n
forall a. Num a => a -> a -> a
*n
N (Tangent (Segment Closed v n))
p)n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^v n
x2

instance (Additive v, Num n)
    => EndValues (Tangent (Segment Closed v n)) where
  atStart :: Tangent (Segment Closed v n)
-> Codomain
     (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
atStart (Tangent (Linear (OffsetClosed v n
v)))      = v n
Codomain
  (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
v
  atStart (Tangent (Cubic v n
c1 v n
_ Offset Closed v n
_))                 = v n
Codomain
  (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
c1
  atEnd :: Tangent (Segment Closed v n)
-> Codomain
     (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
atEnd   (Tangent (Linear (OffsetClosed v n
v)))      = v n
Codomain
  (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
v
  atEnd   (Tangent (Cubic v n
_ v n
c2 (OffsetClosed v n
x2))) = v n
x2 v n -> v n -> v n
forall a. Num a => v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
c2

instance (Additive v, Num n)
    => Parametric (Tangent (FixedSegment v n)) where
  atParam :: Tangent (FixedSegment v n)
-> N (Tangent (FixedSegment v n))
-> Codomain
     (Tangent (FixedSegment v n)) (N (Tangent (FixedSegment v n)))
atParam (Tangent FixedSegment v n
fSeg) = Tangent (Located (Segment Closed v n))
-> N (Tangent (Located (Segment Closed v n)))
-> Codomain
     (Tangent (Located (Segment Closed v n)))
     (N (Tangent (Located (Segment Closed v n))))
forall p. Parametric p => p -> N p -> Codomain p (N p)
atParam (Tangent (Located (Segment Closed v n))
 -> N (Tangent (Located (Segment Closed v n)))
 -> Codomain
      (Tangent (Located (Segment Closed v n)))
      (N (Tangent (Located (Segment Closed v n)))))
-> Tangent (Located (Segment Closed v n))
-> N (Tangent (Located (Segment Closed v n)))
-> Codomain
     (Tangent (Located (Segment Closed v n)))
     (N (Tangent (Located (Segment Closed v n))))
forall a b. (a -> b) -> a -> b
$ Located (Segment Closed v n)
-> Tangent (Located (Segment Closed v n))
forall t. t -> Tangent t
Tangent (FixedSegment v n -> Located (Segment Closed v n)
forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg FixedSegment v n
fSeg)

instance (Additive v, Num n)
    => EndValues (Tangent (FixedSegment v n)) where
  atStart :: Tangent (FixedSegment v n)
-> Codomain
     (Tangent (FixedSegment v n)) (N (Tangent (FixedSegment v n)))
atStart (Tangent FixedSegment v n
fSeg) = Tangent (Located (Segment Closed v n))
-> Codomain
     (Tangent (Located (Segment Closed v n)))
     (N (Tangent (Located (Segment Closed v n))))
forall p. EndValues p => p -> Codomain p (N p)
atStart (Tangent (Located (Segment Closed v n))
 -> Codomain
      (Tangent (Located (Segment Closed v n)))
      (N (Tangent (Located (Segment Closed v n)))))
-> Tangent (Located (Segment Closed v n))
-> Codomain
     (Tangent (Located (Segment Closed v n)))
     (N (Tangent (Located (Segment Closed v n))))
forall a b. (a -> b) -> a -> b
$ Located (Segment Closed v n)
-> Tangent (Located (Segment Closed v n))
forall t. t -> Tangent t
Tangent (FixedSegment v n -> Located (Segment Closed v n)
forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg FixedSegment v n
fSeg)
  atEnd :: Tangent (FixedSegment v n)
-> Codomain
     (Tangent (FixedSegment v n)) (N (Tangent (FixedSegment v n)))
atEnd (Tangent FixedSegment v n
fSeg)   = Tangent (Located (Segment Closed v n))
-> Codomain
     (Tangent (Located (Segment Closed v n)))
     (N (Tangent (Located (Segment Closed v n))))
forall p. EndValues p => p -> Codomain p (N p)
atEnd (Tangent (Located (Segment Closed v n))
 -> Codomain
      (Tangent (Located (Segment Closed v n)))
      (N (Tangent (Located (Segment Closed v n)))))
-> Tangent (Located (Segment Closed v n))
-> Codomain
     (Tangent (Located (Segment Closed v n)))
     (N (Tangent (Located (Segment Closed v n))))
forall a b. (a -> b) -> a -> b
$ Located (Segment Closed v n)
-> Tangent (Located (Segment Closed v n))
forall t. t -> Tangent t
Tangent (FixedSegment v n -> Located (Segment Closed v n)
forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg FixedSegment v n
fSeg)

------------------------------------------------------------
-- Normal
------------------------------------------------------------

-- | Compute the (unit) normal vector to a segment or trail at a
--   particular parameter.
--
--   Examples of more specific types this function can have include
--
--   * @Segment Closed V2 Double -> Double -> V2 Double@
--
--   * @Trail' Line V2 Double -> Double -> V2 Double@
--
--   * @Located (Trail V2 Double) -> Double -> V2 Double@
--
--   See the instances listed for the 'Tangent' newtype for more.
normalAtParam
  :: (InSpace V2 n t, Parametric (Tangent t), Floating n)
  => t -> n -> V2 n
normalAtParam :: forall n t.
(InSpace V2 n t, Parametric (Tangent t), Floating n) =>
t -> n -> V2 n
normalAtParam t
t n
p = V2 n -> V2 n
forall n. Floating n => V2 n -> V2 n
normize (t
t t -> N t -> Vn t
forall t. Parametric (Tangent t) => t -> N t -> Vn t
`tangentAtParam` n
N t
p)

-- | Compute the normal vector at the start of a segment or trail.
normalAtStart
  :: (InSpace V2 n t, EndValues (Tangent t), Floating n)
  => t -> V2 n
normalAtStart :: forall n t.
(InSpace V2 n t, EndValues (Tangent t), Floating n) =>
t -> V2 n
normalAtStart = V2 n -> V2 n
forall n. Floating n => V2 n -> V2 n
normize (V2 n -> V2 n) -> (t -> V2 n) -> t -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Vn t
t -> V2 n
forall t. EndValues (Tangent t) => t -> Vn t
tangentAtStart

-- | Compute the normal vector at the end of a segment or trail.
normalAtEnd
  :: (InSpace V2 n t, EndValues (Tangent t), Floating n)
  => t -> V2 n
normalAtEnd :: forall n t.
(InSpace V2 n t, EndValues (Tangent t), Floating n) =>
t -> V2 n
normalAtEnd = V2 n -> V2 n
forall n. Floating n => V2 n -> V2 n
normize (V2 n -> V2 n) -> (t -> V2 n) -> t -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Vn t
t -> V2 n
forall t. EndValues (Tangent t) => t -> Vn t
tangentAtEnd

-- | Construct a normal vector from a tangent.
normize :: Floating n => V2 n -> V2 n
normize :: forall n. Floating n => V2 n -> V2 n
normize = V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> V2 n
forall a. Num a => V2 a -> V2 a
perp (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> V2 n
forall n. Floating n => V2 n -> V2 n
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm