{-# 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) = forall p. DomainBounds p => p -> N p
domainLower t
t
  domainUpper :: Tangent t -> N (Tangent t)
domainUpper (Tangent t
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 = forall t. t -> Tangent t
Tangent (forall a. Located a -> a
unLoc Located t
l) forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` 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) = forall p. EndValues p => p -> Codomain p (N p)
atStart (forall t. t -> Tangent t
Tangent (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) = forall p. EndValues p => p -> Codomain p (N p)
atEnd   (forall t. t -> Tangent t
Tangent (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 = forall t. t -> Tangent t
Tangent t
t forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N 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 = forall p. EndValues p => p -> Codomain p (N p)
atStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall p. EndValues p => p -> Codomain p (N p)
atEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
v
  Tangent (Cubic v n
c1 v n
c2 (OffsetClosed v n
x2)) `atParam` N (Tangent (Segment Closed v n))
p
    = (n
3forall a. Num a => a -> a -> a
*(n
3forall a. Num a => a -> a -> a
*N (Tangent (Segment Closed v n))
pforall a. Num a => a -> a -> a
*N (Tangent (Segment Closed v n))
pforall a. Num a => a -> a -> a
-n
4forall a. Num a => a -> a -> a
*N (Tangent (Segment Closed v n))
pforall a. Num a => a -> a -> a
+n
1))forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^v n
c1 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (n
3forall a. Num a => a -> a -> a
*(n
2forall a. Num a => a -> a -> a
-n
3forall a. Num a => a -> a -> a
*N (Tangent (Segment Closed v n))
p)forall a. Num a => a -> a -> a
*N (Tangent (Segment Closed v n))
p)forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^v n
c2 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (n
3forall a. Num a => a -> a -> a
*N (Tangent (Segment Closed v n))
pforall a. Num a => a -> a -> a
*N (Tangent (Segment Closed v n))
p)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
v
  atStart (Tangent (Cubic v n
c1 v n
_ Offset Closed v n
_))                 = 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
v
  atEnd   (Tangent (Cubic v n
_ v n
c2 (OffsetClosed v n
x2))) = v n
x2 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) = forall p. Parametric p => p -> N p -> Codomain p (N p)
atParam forall a b. (a -> b) -> a -> b
$ forall t. t -> Tangent t
Tangent (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) = forall p. EndValues p => p -> Codomain p (N p)
atStart forall a b. (a -> b) -> a -> b
$ forall t. t -> Tangent t
Tangent (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)   = forall p. EndValues p => p -> Codomain p (N p)
atEnd forall a b. (a -> b) -> a -> b
$ forall t. t -> Tangent t
Tangent (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 = forall n. Floating n => V2 n -> V2 n
normize (t
t forall t. Parametric (Tangent t) => t -> N t -> Vn t
`tangentAtParam` n
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 = forall n. Floating n => V2 n -> V2 n
normize forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall n. Floating n => V2 n -> V2 n
normize forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => V2 a -> V2 a
perp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm