diagrams-lib-1.0: src/Diagrams/Tangent.hs
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# 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
( tangentAtParam
, tangentAtStart
, tangentAtEnd
, normalAtParam
, normalAtStart
, normalAtEnd
, Tangent(..)
)
where
import Control.Lens (cloneIso, (^.))
import Data.VectorSpace
import Diagrams.Core
import Diagrams.Located
import Diagrams.Parametric
import Diagrams.Segment
import Diagrams.Trail
import Diagrams.TwoD.Types (R2)
import Diagrams.TwoD.Vector (perp)
------------------------------------------------------------
-- 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
instance DomainBounds t => DomainBounds (Tangent t) where
domainLower (Tangent t) = domainLower t
domainUpper (Tangent t) = domainUpper t
type instance Codomain (Tangent (Located t)) = Codomain (Tangent t)
instance Parametric (Tangent t) => Parametric (Tangent (Located t)) where
Tangent l `atParam` p = Tangent (unLoc l) `atParam` p
instance (DomainBounds t, EndValues (Tangent t))
=> EndValues (Tangent (Located t)) where
atStart (Tangent l) = atStart (Tangent (unLoc l))
atEnd (Tangent l) = atEnd (Tangent (unLoc 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 R2 -> Double -> R2@
--
-- * @Trail' Line R2 -> Double -> R2@
--
-- * @Located (Trail R2) -> Double -> R2@
--
-- See the instances listed for the 'Tangent' newtype for more.
tangentAtParam :: Parametric (Tangent t) => t -> Scalar (V t) -> Codomain (Tangent t)
tangentAtParam t p = Tangent t `atParam` p
-- | Compute the tangent vector at the start of a segment or trail.
tangentAtStart :: EndValues (Tangent t) => t -> Codomain (Tangent t)
tangentAtStart = atStart . Tangent
-- | Compute the tangent vector at the end of a segment or trail.
tangentAtEnd :: EndValues (Tangent t) => t -> Codomain (Tangent t)
tangentAtEnd = atEnd . Tangent
--------------------------------------------------
-- Segment
type instance Codomain (Tangent (Segment Closed v)) = Codomain (Segment Closed v)
instance (VectorSpace v, Num (Scalar v))
=> Parametric (Tangent (Segment Closed v)) where
Tangent (Linear (OffsetClosed v)) `atParam` _ = v
Tangent (Cubic c1 c2 (OffsetClosed x2)) `atParam` p
= (3*(3*p*p-4*p+1))*^c1 ^+^ (3*(2-3*p)*p)*^c2 ^+^ (3*p*p)*^x2
instance (VectorSpace v, Num (Scalar v))
=> EndValues (Tangent (Segment Closed v)) where
atStart (Tangent (Linear (OffsetClosed v))) = v
atStart (Tangent (Cubic c1 _ _)) = c1
atEnd (Tangent (Linear (OffsetClosed v))) = v
atEnd (Tangent (Cubic _ c2 (OffsetClosed x2))) = x2 ^-^ c2
--------------------------------------------------
-- Trail' and Trail
type instance Codomain (Tangent (Trail' c v)) = Codomain (Trail' c v)
instance ( Parametric (GetSegment (Trail' c v))
, VectorSpace v
, Num (Scalar v)
)
=> Parametric (Tangent (Trail' c v)) where
Tangent tr `atParam` p =
case GetSegment tr `atParam` p of
Nothing -> zeroV
Just (_, seg, reparam) -> Tangent seg `atParam` (p ^. cloneIso reparam)
instance ( Parametric (GetSegment (Trail' c v))
, EndValues (GetSegment (Trail' c v))
, VectorSpace v
, Num (Scalar v)
)
=> EndValues (Tangent (Trail' c v)) where
atStart (Tangent tr) =
case atStart (GetSegment tr) of
Nothing -> zeroV
Just (_, seg, _) -> atStart (Tangent seg)
atEnd (Tangent tr) =
case atEnd (GetSegment tr) of
Nothing -> zeroV
Just (_, seg, _) -> atEnd (Tangent seg)
type instance Codomain (Tangent (Trail v)) = Codomain (Trail v)
instance ( InnerSpace v
, OrderedField (Scalar v)
, RealFrac (Scalar v)
)
=> Parametric (Tangent (Trail v)) where
Tangent tr `atParam` p
= withTrail
((`atParam` p) . Tangent)
((`atParam` p) . Tangent)
tr
instance ( InnerSpace v
, OrderedField (Scalar v)
, RealFrac (Scalar v)
)
=> EndValues (Tangent (Trail v)) where
atStart (Tangent tr) = withTrail (atStart . Tangent) (atStart . Tangent) tr
atEnd (Tangent tr) = withTrail (atEnd . Tangent) (atEnd . Tangent) tr
------------------------------------------------------------
-- 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 R2 -> Double -> R2@
--
-- * @Trail' Line R2 -> Double -> R2@
--
-- * @Located (Trail R2) -> Double -> P2@
--
-- See the instances listed for the 'Tangent' newtype for more.
normalAtParam
:: (Codomain (Tangent t) ~ R2, Parametric (Tangent t))
=> t -> Scalar (V t) -> R2
normalAtParam t p = normize (t `tangentAtParam` p)
-- | Compute the normal vector at the start of a segment or trail.
normalAtStart
:: (Codomain (Tangent t) ~ R2, EndValues (Tangent t))
=> t -> R2
normalAtStart = normize . tangentAtStart
-- | Compute the normal vector at the end of a segment or trail.
normalAtEnd
:: (Codomain (Tangent t) ~ R2, EndValues (Tangent t))
=> t -> R2
normalAtEnd = normize . tangentAtEnd
-- | Construct a normal vector from a tangent.
normize :: R2 -> R2
normize = negateV . perp . normalized