{-# LANGUAGE DeriveTraversable      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances   #-}
{-|
Module      : Geom2D.CubicBezier.Linear
Copyright   : Written by David Himmelstrup
License     : Unlicense
Maintainer  : lemmih@gmail.com
Stability   : experimental
Portability : POSIX

Convenience wrapper around 'Geom2D.CubicBezier'

-}
module Geom2D.CubicBezier.Linear
  ( AnyBezier(..)
  , CubicBezier(..)
  , QuadBezier(..)
  , OpenPath(..)
  , ClosedPath(..)
  , PathJoin(..)
  , ClosedMetaPath(..)
  , OpenMetaPath(..)
  , MetaJoin(..)
  , MetaNodeType(..)
  , FillRule(..)
  , Tension(..)
  , quadToCubic
  , arcLength
  , arcLengthParam
  , C.splitBezier
  , colinear
  , evalBezier
  , evalBezierDeriv
  , bezierHoriz
  , bezierVert
  , C.bezierSubsegment
  , C.reorient
  , closedPathCurves
  , openPathCurves
  , curvesToClosed
  , closest
  , unmetaOpen
  , unmetaClosed
  , union
  , bezierIntersection
  , interpolateVector
  , vectorDistance
  , findBezierInflection
  , findBezierCusp
  ) where

import qualified Data.Vector.Unboxed as V
import qualified Geom2D.CubicBezier  as C
import           Graphics.SvgTree    (FillRule (..))
import           Linear.V2

------------------------------------------------------------
-- Data types

-- | A bezier curve of any degree.
newtype AnyBezier a = AnyBezier (V.Vector (V2 a))

-- | A cubic bezier curve.
data CubicBezier a = CubicBezier
  { CubicBezier a -> V2 a
cubicC0 :: !(V2 a)
  , CubicBezier a -> V2 a
cubicC1 :: !(V2 a)
  , CubicBezier a -> V2 a
cubicC2 :: !(V2 a)
  , CubicBezier a -> V2 a
cubicC3 :: !(V2 a)
  } deriving (Int -> CubicBezier a -> ShowS
[CubicBezier a] -> ShowS
CubicBezier a -> String
(Int -> CubicBezier a -> ShowS)
-> (CubicBezier a -> String)
-> ([CubicBezier a] -> ShowS)
-> Show (CubicBezier a)
forall a. Show a => Int -> CubicBezier a -> ShowS
forall a. Show a => [CubicBezier a] -> ShowS
forall a. Show a => CubicBezier a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CubicBezier a] -> ShowS
$cshowList :: forall a. Show a => [CubicBezier a] -> ShowS
show :: CubicBezier a -> String
$cshow :: forall a. Show a => CubicBezier a -> String
showsPrec :: Int -> CubicBezier a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CubicBezier a -> ShowS
Show, CubicBezier a -> CubicBezier a -> Bool
(CubicBezier a -> CubicBezier a -> Bool)
-> (CubicBezier a -> CubicBezier a -> Bool) -> Eq (CubicBezier a)
forall a. Eq a => CubicBezier a -> CubicBezier a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CubicBezier a -> CubicBezier a -> Bool
$c/= :: forall a. Eq a => CubicBezier a -> CubicBezier a -> Bool
== :: CubicBezier a -> CubicBezier a -> Bool
$c== :: forall a. Eq a => CubicBezier a -> CubicBezier a -> Bool
Eq)

-- | A quadratic bezier curve.
data QuadBezier a = QuadBezier
  { QuadBezier a -> V2 a
quadC0 :: !(V2 a)
  , QuadBezier a -> V2 a
quadC1 :: !(V2 a)
  , QuadBezier a -> V2 a
quadC2 :: !(V2 a)
  } deriving (Int -> QuadBezier a -> ShowS
[QuadBezier a] -> ShowS
QuadBezier a -> String
(Int -> QuadBezier a -> ShowS)
-> (QuadBezier a -> String)
-> ([QuadBezier a] -> ShowS)
-> Show (QuadBezier a)
forall a. Show a => Int -> QuadBezier a -> ShowS
forall a. Show a => [QuadBezier a] -> ShowS
forall a. Show a => QuadBezier a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuadBezier a] -> ShowS
$cshowList :: forall a. Show a => [QuadBezier a] -> ShowS
show :: QuadBezier a -> String
$cshow :: forall a. Show a => QuadBezier a -> String
showsPrec :: Int -> QuadBezier a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> QuadBezier a -> ShowS
Show, QuadBezier a -> QuadBezier a -> Bool
(QuadBezier a -> QuadBezier a -> Bool)
-> (QuadBezier a -> QuadBezier a -> Bool) -> Eq (QuadBezier a)
forall a. Eq a => QuadBezier a -> QuadBezier a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuadBezier a -> QuadBezier a -> Bool
$c/= :: forall a. Eq a => QuadBezier a -> QuadBezier a -> Bool
== :: QuadBezier a -> QuadBezier a -> Bool
$c== :: forall a. Eq a => QuadBezier a -> QuadBezier a -> Bool
Eq)

-- | Open cubicbezier path.
data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
  deriving (Int -> OpenPath a -> ShowS
[OpenPath a] -> ShowS
OpenPath a -> String
(Int -> OpenPath a -> ShowS)
-> (OpenPath a -> String)
-> ([OpenPath a] -> ShowS)
-> Show (OpenPath a)
forall a. Show a => Int -> OpenPath a -> ShowS
forall a. Show a => [OpenPath a] -> ShowS
forall a. Show a => OpenPath a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenPath a] -> ShowS
$cshowList :: forall a. Show a => [OpenPath a] -> ShowS
show :: OpenPath a -> String
$cshow :: forall a. Show a => OpenPath a -> String
showsPrec :: Int -> OpenPath a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OpenPath a -> ShowS
Show, OpenPath a -> OpenPath a -> Bool
(OpenPath a -> OpenPath a -> Bool)
-> (OpenPath a -> OpenPath a -> Bool) -> Eq (OpenPath a)
forall a. Eq a => OpenPath a -> OpenPath a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenPath a -> OpenPath a -> Bool
$c/= :: forall a. Eq a => OpenPath a -> OpenPath a -> Bool
== :: OpenPath a -> OpenPath a -> Bool
$c== :: forall a. Eq a => OpenPath a -> OpenPath a -> Bool
Eq)

-- | Closed cubicbezier path.
newtype ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
  deriving (Int -> ClosedPath a -> ShowS
[ClosedPath a] -> ShowS
ClosedPath a -> String
(Int -> ClosedPath a -> ShowS)
-> (ClosedPath a -> String)
-> ([ClosedPath a] -> ShowS)
-> Show (ClosedPath a)
forall a. Show a => Int -> ClosedPath a -> ShowS
forall a. Show a => [ClosedPath a] -> ShowS
forall a. Show a => ClosedPath a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClosedPath a] -> ShowS
$cshowList :: forall a. Show a => [ClosedPath a] -> ShowS
show :: ClosedPath a -> String
$cshow :: forall a. Show a => ClosedPath a -> String
showsPrec :: Int -> ClosedPath a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ClosedPath a -> ShowS
Show, ClosedPath a -> ClosedPath a -> Bool
(ClosedPath a -> ClosedPath a -> Bool)
-> (ClosedPath a -> ClosedPath a -> Bool) -> Eq (ClosedPath a)
forall a. Eq a => ClosedPath a -> ClosedPath a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClosedPath a -> ClosedPath a -> Bool
$c/= :: forall a. Eq a => ClosedPath a -> ClosedPath a -> Bool
== :: ClosedPath a -> ClosedPath a -> Bool
$c== :: forall a. Eq a => ClosedPath a -> ClosedPath a -> Bool
Eq)

-- | Join two points with either a straight line or a bezier
--   curve with two control points.
data PathJoin a
  = JoinLine
  | JoinCurve (V2 a) (V2 a)
  deriving (Int -> PathJoin a -> ShowS
[PathJoin a] -> ShowS
PathJoin a -> String
(Int -> PathJoin a -> ShowS)
-> (PathJoin a -> String)
-> ([PathJoin a] -> ShowS)
-> Show (PathJoin a)
forall a. Show a => Int -> PathJoin a -> ShowS
forall a. Show a => [PathJoin a] -> ShowS
forall a. Show a => PathJoin a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathJoin a] -> ShowS
$cshowList :: forall a. Show a => [PathJoin a] -> ShowS
show :: PathJoin a -> String
$cshow :: forall a. Show a => PathJoin a -> String
showsPrec :: Int -> PathJoin a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PathJoin a -> ShowS
Show, PathJoin a -> PathJoin a -> Bool
(PathJoin a -> PathJoin a -> Bool)
-> (PathJoin a -> PathJoin a -> Bool) -> Eq (PathJoin a)
forall a. Eq a => PathJoin a -> PathJoin a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathJoin a -> PathJoin a -> Bool
$c/= :: forall a. Eq a => PathJoin a -> PathJoin a -> Bool
== :: PathJoin a -> PathJoin a -> Bool
$c== :: forall a. Eq a => PathJoin a -> PathJoin a -> Bool
Eq)

-- | Closed meta path.
newtype ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
  deriving (Int -> ClosedMetaPath a -> ShowS
[ClosedMetaPath a] -> ShowS
ClosedMetaPath a -> String
(Int -> ClosedMetaPath a -> ShowS)
-> (ClosedMetaPath a -> String)
-> ([ClosedMetaPath a] -> ShowS)
-> Show (ClosedMetaPath a)
forall a. Show a => Int -> ClosedMetaPath a -> ShowS
forall a. Show a => [ClosedMetaPath a] -> ShowS
forall a. Show a => ClosedMetaPath a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClosedMetaPath a] -> ShowS
$cshowList :: forall a. Show a => [ClosedMetaPath a] -> ShowS
show :: ClosedMetaPath a -> String
$cshow :: forall a. Show a => ClosedMetaPath a -> String
showsPrec :: Int -> ClosedMetaPath a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ClosedMetaPath a -> ShowS
Show, ClosedMetaPath a -> ClosedMetaPath a -> Bool
(ClosedMetaPath a -> ClosedMetaPath a -> Bool)
-> (ClosedMetaPath a -> ClosedMetaPath a -> Bool)
-> Eq (ClosedMetaPath a)
forall a. Eq a => ClosedMetaPath a -> ClosedMetaPath a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClosedMetaPath a -> ClosedMetaPath a -> Bool
$c/= :: forall a. Eq a => ClosedMetaPath a -> ClosedMetaPath a -> Bool
== :: ClosedMetaPath a -> ClosedMetaPath a -> Bool
$c== :: forall a. Eq a => ClosedMetaPath a -> ClosedMetaPath a -> Bool
Eq)

-- | Open meta path
data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
  deriving (Int -> OpenMetaPath a -> ShowS
[OpenMetaPath a] -> ShowS
OpenMetaPath a -> String
(Int -> OpenMetaPath a -> ShowS)
-> (OpenMetaPath a -> String)
-> ([OpenMetaPath a] -> ShowS)
-> Show (OpenMetaPath a)
forall a. Show a => Int -> OpenMetaPath a -> ShowS
forall a. Show a => [OpenMetaPath a] -> ShowS
forall a. Show a => OpenMetaPath a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenMetaPath a] -> ShowS
$cshowList :: forall a. Show a => [OpenMetaPath a] -> ShowS
show :: OpenMetaPath a -> String
$cshow :: forall a. Show a => OpenMetaPath a -> String
showsPrec :: Int -> OpenMetaPath a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OpenMetaPath a -> ShowS
Show, OpenMetaPath a -> OpenMetaPath a -> Bool
(OpenMetaPath a -> OpenMetaPath a -> Bool)
-> (OpenMetaPath a -> OpenMetaPath a -> Bool)
-> Eq (OpenMetaPath a)
forall a. Eq a => OpenMetaPath a -> OpenMetaPath a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenMetaPath a -> OpenMetaPath a -> Bool
$c/= :: forall a. Eq a => OpenMetaPath a -> OpenMetaPath a -> Bool
== :: OpenMetaPath a -> OpenMetaPath a -> Bool
$c== :: forall a. Eq a => OpenMetaPath a -> OpenMetaPath a -> Bool
Eq)

-- | The tension value specifies how /tense/ the curve is.
--   A higher value means the curve approaches a line segment,
--   while a lower value means the curve is more round. Metafont
--   doesn't allow values below 3/4.
data Tension a
  = Tension
    { Tension a -> a
tensionValue :: a }
  | TensionAtLeast -- ^ Like Tension, but keep the segment inside the
                   --   bounding triangle defined by the control points,
                   --   if there is one.
    { tensionValue :: a }
  deriving (a -> Tension b -> Tension a
(a -> b) -> Tension a -> Tension b
(forall a b. (a -> b) -> Tension a -> Tension b)
-> (forall a b. a -> Tension b -> Tension a) -> Functor Tension
forall a b. a -> Tension b -> Tension a
forall a b. (a -> b) -> Tension a -> Tension b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Tension b -> Tension a
$c<$ :: forall a b. a -> Tension b -> Tension a
fmap :: (a -> b) -> Tension a -> Tension b
$cfmap :: forall a b. (a -> b) -> Tension a -> Tension b
Functor, Tension a -> Bool
(a -> m) -> Tension a -> m
(a -> b -> b) -> b -> Tension a -> b
(forall m. Monoid m => Tension m -> m)
-> (forall m a. Monoid m => (a -> m) -> Tension a -> m)
-> (forall m a. Monoid m => (a -> m) -> Tension a -> m)
-> (forall a b. (a -> b -> b) -> b -> Tension a -> b)
-> (forall a b. (a -> b -> b) -> b -> Tension a -> b)
-> (forall b a. (b -> a -> b) -> b -> Tension a -> b)
-> (forall b a. (b -> a -> b) -> b -> Tension a -> b)
-> (forall a. (a -> a -> a) -> Tension a -> a)
-> (forall a. (a -> a -> a) -> Tension a -> a)
-> (forall a. Tension a -> [a])
-> (forall a. Tension a -> Bool)
-> (forall a. Tension a -> Int)
-> (forall a. Eq a => a -> Tension a -> Bool)
-> (forall a. Ord a => Tension a -> a)
-> (forall a. Ord a => Tension a -> a)
-> (forall a. Num a => Tension a -> a)
-> (forall a. Num a => Tension a -> a)
-> Foldable Tension
forall a. Eq a => a -> Tension a -> Bool
forall a. Num a => Tension a -> a
forall a. Ord a => Tension a -> a
forall m. Monoid m => Tension m -> m
forall a. Tension a -> Bool
forall a. Tension a -> Int
forall a. Tension a -> [a]
forall a. (a -> a -> a) -> Tension a -> a
forall m a. Monoid m => (a -> m) -> Tension a -> m
forall b a. (b -> a -> b) -> b -> Tension a -> b
forall a b. (a -> b -> b) -> b -> Tension a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Tension a -> a
$cproduct :: forall a. Num a => Tension a -> a
sum :: Tension a -> a
$csum :: forall a. Num a => Tension a -> a
minimum :: Tension a -> a
$cminimum :: forall a. Ord a => Tension a -> a
maximum :: Tension a -> a
$cmaximum :: forall a. Ord a => Tension a -> a
elem :: a -> Tension a -> Bool
$celem :: forall a. Eq a => a -> Tension a -> Bool
length :: Tension a -> Int
$clength :: forall a. Tension a -> Int
null :: Tension a -> Bool
$cnull :: forall a. Tension a -> Bool
toList :: Tension a -> [a]
$ctoList :: forall a. Tension a -> [a]
foldl1 :: (a -> a -> a) -> Tension a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Tension a -> a
foldr1 :: (a -> a -> a) -> Tension a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Tension a -> a
foldl' :: (b -> a -> b) -> b -> Tension a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Tension a -> b
foldl :: (b -> a -> b) -> b -> Tension a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Tension a -> b
foldr' :: (a -> b -> b) -> b -> Tension a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Tension a -> b
foldr :: (a -> b -> b) -> b -> Tension a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Tension a -> b
foldMap' :: (a -> m) -> Tension a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Tension a -> m
foldMap :: (a -> m) -> Tension a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Tension a -> m
fold :: Tension m -> m
$cfold :: forall m. Monoid m => Tension m -> m
Foldable, Functor Tension
Foldable Tension
Functor Tension
-> Foldable Tension
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Tension a -> f (Tension b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Tension (f a) -> f (Tension a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Tension a -> m (Tension b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Tension (m a) -> m (Tension a))
-> Traversable Tension
(a -> f b) -> Tension a -> f (Tension b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Tension (m a) -> m (Tension a)
forall (f :: * -> *) a.
Applicative f =>
Tension (f a) -> f (Tension a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tension a -> m (Tension b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tension a -> f (Tension b)
sequence :: Tension (m a) -> m (Tension a)
$csequence :: forall (m :: * -> *) a. Monad m => Tension (m a) -> m (Tension a)
mapM :: (a -> m b) -> Tension a -> m (Tension b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tension a -> m (Tension b)
sequenceA :: Tension (f a) -> f (Tension a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Tension (f a) -> f (Tension a)
traverse :: (a -> f b) -> Tension a -> f (Tension b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tension a -> f (Tension b)
$cp2Traversable :: Foldable Tension
$cp1Traversable :: Functor Tension
Traversable, Tension a -> Tension a -> Bool
(Tension a -> Tension a -> Bool)
-> (Tension a -> Tension a -> Bool) -> Eq (Tension a)
forall a. Eq a => Tension a -> Tension a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tension a -> Tension a -> Bool
$c/= :: forall a. Eq a => Tension a -> Tension a -> Bool
== :: Tension a -> Tension a -> Bool
$c== :: forall a. Eq a => Tension a -> Tension a -> Bool
Eq, Int -> Tension a -> ShowS
[Tension a] -> ShowS
Tension a -> String
(Int -> Tension a -> ShowS)
-> (Tension a -> String)
-> ([Tension a] -> ShowS)
-> Show (Tension a)
forall a. Show a => Int -> Tension a -> ShowS
forall a. Show a => [Tension a] -> ShowS
forall a. Show a => Tension a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tension a] -> ShowS
$cshowList :: forall a. Show a => [Tension a] -> ShowS
show :: Tension a -> String
$cshow :: forall a. Show a => Tension a -> String
showsPrec :: Int -> Tension a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Tension a -> ShowS
Show)

-- | Join two meta points with either a bezier curve or tension
--   contraints.
data MetaJoin a
  = MetaJoin
  { MetaJoin a -> MetaNodeType a
metaTypeL :: MetaNodeType a
  , MetaJoin a -> Tension a
tensionL  :: Tension a
  , MetaJoin a -> Tension a
tensionR  :: Tension a
  , MetaJoin a -> MetaNodeType a
metaTypeR :: MetaNodeType a
  }
  | Controls (V2 a) (V2 a)
  deriving (Int -> MetaJoin a -> ShowS
[MetaJoin a] -> ShowS
MetaJoin a -> String
(Int -> MetaJoin a -> ShowS)
-> (MetaJoin a -> String)
-> ([MetaJoin a] -> ShowS)
-> Show (MetaJoin a)
forall a. Show a => Int -> MetaJoin a -> ShowS
forall a. Show a => [MetaJoin a] -> ShowS
forall a. Show a => MetaJoin a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaJoin a] -> ShowS
$cshowList :: forall a. Show a => [MetaJoin a] -> ShowS
show :: MetaJoin a -> String
$cshow :: forall a. Show a => MetaJoin a -> String
showsPrec :: Int -> MetaJoin a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MetaJoin a -> ShowS
Show, MetaJoin a -> MetaJoin a -> Bool
(MetaJoin a -> MetaJoin a -> Bool)
-> (MetaJoin a -> MetaJoin a -> Bool) -> Eq (MetaJoin a)
forall a. Eq a => MetaJoin a -> MetaJoin a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaJoin a -> MetaJoin a -> Bool
$c/= :: forall a. Eq a => MetaJoin a -> MetaJoin a -> Bool
== :: MetaJoin a -> MetaJoin a -> Bool
$c== :: forall a. Eq a => MetaJoin a -> MetaJoin a -> Bool
Eq)

-- | Node constraint type.
data MetaNodeType a
  = Open
  | Curl { MetaNodeType a -> a
curlgamma :: a }
  | Direction { MetaNodeType a -> V2 a
nodedir :: V2 a }
  deriving (Int -> MetaNodeType a -> ShowS
[MetaNodeType a] -> ShowS
MetaNodeType a -> String
(Int -> MetaNodeType a -> ShowS)
-> (MetaNodeType a -> String)
-> ([MetaNodeType a] -> ShowS)
-> Show (MetaNodeType a)
forall a. Show a => Int -> MetaNodeType a -> ShowS
forall a. Show a => [MetaNodeType a] -> ShowS
forall a. Show a => MetaNodeType a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaNodeType a] -> ShowS
$cshowList :: forall a. Show a => [MetaNodeType a] -> ShowS
show :: MetaNodeType a -> String
$cshow :: forall a. Show a => MetaNodeType a -> String
showsPrec :: Int -> MetaNodeType a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MetaNodeType a -> ShowS
Show, MetaNodeType a -> MetaNodeType a -> Bool
(MetaNodeType a -> MetaNodeType a -> Bool)
-> (MetaNodeType a -> MetaNodeType a -> Bool)
-> Eq (MetaNodeType a)
forall a. Eq a => MetaNodeType a -> MetaNodeType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaNodeType a -> MetaNodeType a -> Bool
$c/= :: forall a. Eq a => MetaNodeType a -> MetaNodeType a -> Bool
== :: MetaNodeType a -> MetaNodeType a -> Bool
$c== :: forall a. Eq a => MetaNodeType a -> MetaNodeType a -> Bool
Eq)

------------------------------------------------------------
-- Methods

-- | Convert a quadratic bezier to a cubic bezier.
quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a
quadToCubic :: QuadBezier a -> CubicBezier a
quadToCubic = CubicBezier a -> CubicBezier a
forall a b. Cast a b => b -> a
upCast (CubicBezier a -> CubicBezier a)
-> (QuadBezier a -> CubicBezier a) -> QuadBezier a -> CubicBezier a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBezier a -> CubicBezier a
forall a. Fractional a => QuadBezier a -> CubicBezier a
C.quadToCubic (QuadBezier a -> CubicBezier a)
-> (QuadBezier a -> QuadBezier a) -> QuadBezier a -> CubicBezier a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBezier a -> QuadBezier a
forall a b. Cast a b => a -> b
downCast

-- | @arcLength c t tol@ finds the arclength of the bezier @c@ at @t@,
--   within given tolerance @tol@.
arcLength :: CubicBezier Double -> Double -> Double -> Double
arcLength :: CubicBezier Double -> Double -> Double -> Double
arcLength CubicBezier Double
bezier = CubicBezier Double -> Double -> Double -> Double
C.arcLength (CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast CubicBezier Double
bezier)

-- | @arcLengthParam c len tol@ finds the parameter where the curve @c@
--   has the arclength @len@, within tolerance @tol@.
arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
arcLengthParam CubicBezier Double
bezier = CubicBezier Double -> Double -> Double -> Double
C.arcLengthParam (CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast CubicBezier Double
bezier)

-- | Return @False@ if some points fall outside a line with a thickness of the given tolerance.
colinear :: CubicBezier Double -> Double -> Bool
colinear :: CubicBezier Double -> Double -> Bool
colinear CubicBezier Double
bezier = CubicBezier Double -> Double -> Bool
C.colinear (CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast CubicBezier Double
bezier)

-- | Calculate a value on the bezier curve.
evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) => b a -> a -> V2 a
evalBezier :: b a -> a -> V2 a
evalBezier b a
c a
p = Point a -> V2 a
forall a b. Cast a b => b -> a
upCast (Point a -> V2 a) -> Point a -> V2 a
forall a b. (a -> b) -> a -> b
$ b a -> a -> Point a
forall (b :: * -> *) a.
(GenericBezier b, Unbox a, Fractional a) =>
b a -> a -> Point a
C.evalBezier b a
c a
p

-- | Calculate a value and the first derivative on the curve.
evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) => b a -> a -> (V2 a, V2 a)
evalBezierDeriv :: b a -> a -> (V2 a, V2 a)
evalBezierDeriv b a
c a
p = (Point a, Point a) -> (V2 a, V2 a)
forall a b. Cast a b => b -> a
upCast ((Point a, Point a) -> (V2 a, V2 a))
-> (Point a, Point a) -> (V2 a, V2 a)
forall a b. (a -> b) -> a -> b
$ b a -> a -> (Point a, Point a)
forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
C.evalBezierDeriv b a
c a
p

-- | Find the parameter where the bezier curve is horizontal.
bezierHoriz :: CubicBezier Double -> [Double]
bezierHoriz :: CubicBezier Double -> [Double]
bezierHoriz = CubicBezier Double -> [Double]
C.bezierHoriz (CubicBezier Double -> [Double])
-> (CubicBezier Double -> CubicBezier Double)
-> CubicBezier Double
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast

-- | Find the parameter where the bezier curve is vertical.
bezierVert :: CubicBezier Double -> [Double]
bezierVert :: CubicBezier Double -> [Double]
bezierVert = CubicBezier Double -> [Double]
C.bezierVert (CubicBezier Double -> [Double])
-> (CubicBezier Double -> CubicBezier Double)
-> CubicBezier Double
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast

-- | Create a normal path from a metapath.
unmetaOpen :: OpenMetaPath Double -> OpenPath Double
unmetaOpen :: OpenMetaPath Double -> OpenPath Double
unmetaOpen = OpenPath Double -> OpenPath Double
forall a b. Cast a b => b -> a
upCast (OpenPath Double -> OpenPath Double)
-> (OpenMetaPath Double -> OpenPath Double)
-> OpenMetaPath Double
-> OpenPath Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenMetaPath Double -> OpenPath Double
C.unmetaOpen (OpenMetaPath Double -> OpenPath Double)
-> (OpenMetaPath Double -> OpenMetaPath Double)
-> OpenMetaPath Double
-> OpenPath Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenMetaPath Double -> OpenMetaPath Double
forall a b. Cast a b => a -> b
downCast

-- | Create a normal path from a metapath.
unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
unmetaClosed = ClosedPath Double -> ClosedPath Double
forall a b. Cast a b => b -> a
upCast (ClosedPath Double -> ClosedPath Double)
-> (ClosedMetaPath Double -> ClosedPath Double)
-> ClosedMetaPath Double
-> ClosedPath Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosedMetaPath Double -> ClosedPath Double
C.unmetaClosed (ClosedMetaPath Double -> ClosedPath Double)
-> (ClosedMetaPath Double -> ClosedMetaPath Double)
-> ClosedMetaPath Double
-> ClosedPath Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosedMetaPath Double -> ClosedMetaPath Double
forall a b. Cast a b => a -> b
downCast

-- | `O((n+m)*log(n+m))`, for n segments and m intersections.
--   Union of paths, removing overlap and rounding to the given tolerance.
union :: [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
union :: [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
union [ClosedPath Double]
p FillRule
fill Double
tol = [ClosedPath Double] -> [ClosedPath Double]
forall a b. Cast a b => b -> a
upCast ([ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
C.union ([ClosedPath Double] -> [ClosedPath Double]
forall a b. Cast a b => a -> b
downCast [ClosedPath Double]
p) (FillRule -> FillRule
forall a b. Cast a b => a -> b
downCast FillRule
fill) Double
tol)

-- | Find the intersections between two Bezier curves, using the Bezier Clip algorithm.
--   Returns the parameters for both curves.
bezierIntersection :: CubicBezier Double -> CubicBezier Double -> Double -> [(Double, Double)]
bezierIntersection :: CubicBezier Double
-> CubicBezier Double -> Double -> [(Double, Double)]
bezierIntersection CubicBezier Double
a CubicBezier Double
b = CubicBezier Double
-> CubicBezier Double -> Double -> [(Double, Double)]
C.bezierIntersection (CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast CubicBezier Double
a) (CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast CubicBezier Double
b)

-- | Find the closest value on the bezier to the given point, within tolerance.
--   Return the first value found.
closest :: CubicBezier Double -> V2 Double -> Double -> Double
closest :: CubicBezier Double -> V2 Double -> Double -> Double
closest CubicBezier Double
c V2 Double
p = CubicBezier Double -> DPoint -> Double -> Double
C.closest (CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast CubicBezier Double
c) (V2 Double -> DPoint
forall a b. Cast a b => a -> b
downCast V2 Double
p)

-- | Return the closed path as a list of curves.
closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
closedPathCurves :: ClosedPath a -> [CubicBezier a]
closedPathCurves = [CubicBezier a] -> [CubicBezier a]
forall a b. Cast a b => b -> a
upCast ([CubicBezier a] -> [CubicBezier a])
-> (ClosedPath a -> [CubicBezier a])
-> ClosedPath a
-> [CubicBezier a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosedPath a -> [CubicBezier a]
forall a. Fractional a => ClosedPath a -> [CubicBezier a]
C.closedPathCurves (ClosedPath a -> [CubicBezier a])
-> (ClosedPath a -> ClosedPath a)
-> ClosedPath a
-> [CubicBezier a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosedPath a -> ClosedPath a
forall a b. Cast a b => a -> b
downCast

-- | Return the open path as a list of curves.
openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
openPathCurves :: OpenPath a -> [CubicBezier a]
openPathCurves = [CubicBezier a] -> [CubicBezier a]
forall a b. Cast a b => b -> a
upCast ([CubicBezier a] -> [CubicBezier a])
-> (OpenPath a -> [CubicBezier a]) -> OpenPath a -> [CubicBezier a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenPath a -> [CubicBezier a]
forall a. Fractional a => OpenPath a -> [CubicBezier a]
C.openPathCurves (OpenPath a -> [CubicBezier a])
-> (OpenPath a -> OpenPath a) -> OpenPath a -> [CubicBezier a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenPath a -> OpenPath a
forall a b. Cast a b => a -> b
downCast

-- | Make an open path from a list of curves. The last control point of each curve is ignored.
curvesToClosed :: [CubicBezier a] -> ClosedPath a
curvesToClosed :: [CubicBezier a] -> ClosedPath a
curvesToClosed = ClosedPath a -> ClosedPath a
forall a b. Cast a b => b -> a
upCast (ClosedPath a -> ClosedPath a)
-> ([CubicBezier a] -> ClosedPath a)
-> [CubicBezier a]
-> ClosedPath a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CubicBezier a] -> ClosedPath a
forall a. [CubicBezier a] -> ClosedPath a
C.curvesToClosed ([CubicBezier a] -> ClosedPath a)
-> ([CubicBezier a] -> [CubicBezier a])
-> [CubicBezier a]
-> ClosedPath a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CubicBezier a] -> [CubicBezier a]
forall a b. Cast a b => a -> b
downCast

-- | Interpolate between two vectors.
interpolateVector :: Num a => V2 a -> V2 a -> a -> V2 a
interpolateVector :: V2 a -> V2 a -> a -> V2 a
interpolateVector V2 a
a V2 a
b a
p = Point a -> V2 a
forall a b. Cast a b => b -> a
upCast (Point a -> V2 a) -> Point a -> V2 a
forall a b. (a -> b) -> a -> b
$ Point a -> Point a -> a -> Point a
forall a. Num a => Point a -> Point a -> a -> Point a
C.interpolateVector (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
a) (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
b) a
p

-- | Distance between two vectors.
vectorDistance :: Floating a => V2 a -> V2 a -> a
vectorDistance :: V2 a -> V2 a -> a
vectorDistance V2 a
a V2 a
b = Point a -> Point a -> a
forall a. Floating a => Point a -> Point a -> a
C.vectorDistance (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
a) (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
b)

-- | Find inflection points on the curve.
findBezierInflection :: CubicBezier Double -> [Double]
findBezierInflection :: CubicBezier Double -> [Double]
findBezierInflection = CubicBezier Double -> [Double]
C.findBezierInflection (CubicBezier Double -> [Double])
-> (CubicBezier Double -> CubicBezier Double)
-> CubicBezier Double
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast

-- | Find the cusps of a bezier.
findBezierCusp :: CubicBezier Double -> [Double]
findBezierCusp :: CubicBezier Double -> [Double]
findBezierCusp = CubicBezier Double -> [Double]
C.findBezierCusp (CubicBezier Double -> [Double])
-> (CubicBezier Double -> CubicBezier Double)
-> CubicBezier Double
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier Double -> CubicBezier Double
forall a b. Cast a b => a -> b
downCast

------------------------------------------------------------
-- Instances

instance C.GenericBezier QuadBezier where
  degree :: QuadBezier a -> Int
degree = QuadBezier a -> Int
forall (b :: * -> *) a. (GenericBezier b, Unbox a) => b a -> Int
C.degree (QuadBezier a -> Int)
-> (QuadBezier a -> QuadBezier a) -> QuadBezier a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBezier a -> QuadBezier a
forall a b. Cast a b => a -> b
downCast
  toVector :: QuadBezier a -> Vector (a, a)
toVector = QuadBezier a -> Vector (a, a)
forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
b a -> Vector (a, a)
C.toVector (QuadBezier a -> Vector (a, a))
-> (QuadBezier a -> QuadBezier a) -> QuadBezier a -> Vector (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBezier a -> QuadBezier a
forall a b. Cast a b => a -> b
downCast
  unsafeFromVector :: Vector (a, a) -> QuadBezier a
unsafeFromVector = QuadBezier a -> QuadBezier a
forall a b. Cast a b => b -> a
upCast (QuadBezier a -> QuadBezier a)
-> (Vector (a, a) -> QuadBezier a) -> Vector (a, a) -> QuadBezier a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (a, a) -> QuadBezier a
forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
Vector (a, a) -> b a
C.unsafeFromVector

instance C.GenericBezier CubicBezier where
  degree :: CubicBezier a -> Int
degree = CubicBezier a -> Int
forall (b :: * -> *) a. (GenericBezier b, Unbox a) => b a -> Int
C.degree (CubicBezier a -> Int)
-> (CubicBezier a -> CubicBezier a) -> CubicBezier a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier a -> CubicBezier a
forall a b. Cast a b => a -> b
downCast
  toVector :: CubicBezier a -> Vector (a, a)
toVector = CubicBezier a -> Vector (a, a)
forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
b a -> Vector (a, a)
C.toVector (CubicBezier a -> Vector (a, a))
-> (CubicBezier a -> CubicBezier a)
-> CubicBezier a
-> Vector (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier a -> CubicBezier a
forall a b. Cast a b => a -> b
downCast
  unsafeFromVector :: Vector (a, a) -> CubicBezier a
unsafeFromVector = CubicBezier a -> CubicBezier a
forall a b. Cast a b => b -> a
upCast (CubicBezier a -> CubicBezier a)
-> (Vector (a, a) -> CubicBezier a)
-> Vector (a, a)
-> CubicBezier a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (a, a) -> CubicBezier a
forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
Vector (a, a) -> b a
C.unsafeFromVector

instance C.GenericBezier AnyBezier where
  degree :: AnyBezier a -> Int
degree = AnyBezier a -> Int
forall (b :: * -> *) a. (GenericBezier b, Unbox a) => b a -> Int
C.degree (AnyBezier a -> Int)
-> (AnyBezier a -> AnyBezier a) -> AnyBezier a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyBezier a -> AnyBezier a
forall a b. Cast a b => a -> b
downCast
  toVector :: AnyBezier a -> Vector (a, a)
toVector = AnyBezier a -> Vector (a, a)
forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
b a -> Vector (a, a)
C.toVector (AnyBezier a -> Vector (a, a))
-> (AnyBezier a -> AnyBezier a) -> AnyBezier a -> Vector (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyBezier a -> AnyBezier a
forall a b. Cast a b => a -> b
downCast
  unsafeFromVector :: Vector (a, a) -> AnyBezier a
unsafeFromVector = AnyBezier a -> AnyBezier a
forall a b. Cast a b => b -> a
upCast (AnyBezier a -> AnyBezier a)
-> (Vector (a, a) -> AnyBezier a) -> Vector (a, a) -> AnyBezier a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (a, a) -> AnyBezier a
forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
Vector (a, a) -> b a
C.unsafeFromVector

------------------------------------------------------------
-- Casting

class Cast a b | a -> b, b -> a where
  downCast :: a -> b
  upCast   :: b -> a

instance Cast a b => Cast [a] [b] where
  downCast :: [a] -> [b]
downCast = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
forall a b. Cast a b => a -> b
downCast
  upCast :: [b] -> [a]
upCast = (b -> a) -> [b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map b -> a
forall a b. Cast a b => b -> a
upCast

instance (Cast a a', Cast b b') => Cast (a,b) (a',b') where
  downCast :: (a, b) -> (a', b')
downCast (a
a, b
b) = (a -> a'
forall a b. Cast a b => a -> b
downCast a
a, b -> b'
forall a b. Cast a b => a -> b
downCast b
b)
  upCast :: (a', b') -> (a, b)
upCast (a'
a, b'
b) = (a' -> a
forall a b. Cast a b => b -> a
upCast a'
a, b' -> b
forall a b. Cast a b => b -> a
upCast b'
b)

instance Cast (V2 a) (C.Point a) where
  downCast :: V2 a -> Point a
downCast (V2 a
a a
b) = a -> a -> Point a
forall a. a -> a -> Point a
C.Point a
a a
b
  upCast :: Point a -> V2 a
upCast (C.Point a
a a
b) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
a a
b

instance Cast FillRule C.FillRule where
  downCast :: FillRule -> FillRule
downCast FillRule
FillEvenOdd = FillRule
C.EvenOdd
  downCast FillRule
FillNonZero = FillRule
C.NonZero
  upCast :: FillRule -> FillRule
upCast FillRule
C.EvenOdd = FillRule
FillEvenOdd
  upCast FillRule
C.NonZero = FillRule
FillNonZero

instance Cast (CubicBezier a) (C.CubicBezier a) where
  downCast :: CubicBezier a -> CubicBezier a
downCast (CubicBezier V2 a
a V2 a
b V2 a
c V2 a
d) = Point a -> Point a -> Point a -> Point a -> CubicBezier a
forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
C.CubicBezier
    (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
a) (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
b) (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
c) (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
d)
  upCast :: CubicBezier a -> CubicBezier a
upCast (C.CubicBezier Point a
a Point a
b Point a
c Point a
d) = V2 a -> V2 a -> V2 a -> V2 a -> CubicBezier a
forall a. V2 a -> V2 a -> V2 a -> V2 a -> CubicBezier a
CubicBezier
    (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
a) (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
b) (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
c) (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
d)

instance Cast (QuadBezier a) (C.QuadBezier a) where
  downCast :: QuadBezier a -> QuadBezier a
downCast (QuadBezier V2 a
a V2 a
b V2 a
c) = Point a -> Point a -> Point a -> QuadBezier a
forall a. Point a -> Point a -> Point a -> QuadBezier a
C.QuadBezier
    (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
a) (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
b) (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
c)
  upCast :: QuadBezier a -> QuadBezier a
upCast (C.QuadBezier Point a
a Point a
b Point a
c)= V2 a -> V2 a -> V2 a -> QuadBezier a
forall a. V2 a -> V2 a -> V2 a -> QuadBezier a
QuadBezier
    (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
a) (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
b) (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
c)

instance V.Unbox a => Cast (AnyBezier a) (C.AnyBezier a) where
  downCast :: AnyBezier a -> AnyBezier a
downCast (AnyBezier Vector (V2 a)
arr) = Vector (a, a) -> AnyBezier a
forall a. Vector (a, a) -> AnyBezier a
C.AnyBezier (Vector (a, a) -> AnyBezier a) -> Vector (a, a) -> AnyBezier a
forall a b. (a -> b) -> a -> b
$
    (V2 a -> (a, a)) -> Vector (V2 a) -> Vector (a, a)
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
V.map (\(V2 a
a a
b) -> (a
a,a
b)) Vector (V2 a)
arr
  upCast :: AnyBezier a -> AnyBezier a
upCast (C.AnyBezier Vector (a, a)
arr) = Vector (V2 a) -> AnyBezier a
forall a. Vector (V2 a) -> AnyBezier a
AnyBezier (Vector (V2 a) -> AnyBezier a) -> Vector (V2 a) -> AnyBezier a
forall a b. (a -> b) -> a -> b
$
    ((a, a) -> V2 a) -> Vector (a, a) -> Vector (V2 a)
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
V.map ((a -> a -> V2 a) -> (a, a) -> V2 a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> V2 a
forall a. a -> a -> V2 a
V2) Vector (a, a)
arr

instance Cast (MetaNodeType a) (C.MetaNodeType a) where
  downCast :: MetaNodeType a -> MetaNodeType a
downCast MetaNodeType a
Open            = MetaNodeType a
forall a. MetaNodeType a
C.Open
  downCast (Curl a
gamma)    = a -> MetaNodeType a
forall a. a -> MetaNodeType a
C.Curl a
gamma
  downCast (Direction V2 a
dir) = Point a -> MetaNodeType a
forall a. Point a -> MetaNodeType a
C.Direction (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
dir)
  upCast :: MetaNodeType a -> MetaNodeType a
upCast MetaNodeType a
C.Open            = MetaNodeType a
forall a. MetaNodeType a
Open
  upCast (C.Curl a
gamma)    = a -> MetaNodeType a
forall a. a -> MetaNodeType a
Curl a
gamma
  upCast (C.Direction Point a
dir) = V2 a -> MetaNodeType a
forall a. V2 a -> MetaNodeType a
Direction (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
dir)

instance Cast (Tension a) (C.Tension a) where
  downCast :: Tension a -> Tension a
downCast (Tension a
v)        = a -> Tension a
forall a. a -> Tension a
C.Tension a
v
  downCast (TensionAtLeast a
v) = a -> Tension a
forall a. a -> Tension a
C.TensionAtLeast a
v
  upCast :: Tension a -> Tension a
upCast (C.Tension a
v)        = a -> Tension a
forall a. a -> Tension a
Tension a
v
  upCast (C.TensionAtLeast a
v) = a -> Tension a
forall a. a -> Tension a
TensionAtLeast a
v

instance Cast (MetaJoin a) (C.MetaJoin a) where
  downCast :: MetaJoin a -> MetaJoin a
downCast (MetaJoin MetaNodeType a
tyL Tension a
tL Tension a
tR MetaNodeType a
tyR) =
    MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
C.MetaJoin (MetaNodeType a -> MetaNodeType a
forall a b. Cast a b => a -> b
downCast MetaNodeType a
tyL) (Tension a -> Tension a
forall a b. Cast a b => a -> b
downCast Tension a
tL) (Tension a -> Tension a
forall a b. Cast a b => a -> b
downCast Tension a
tR) (MetaNodeType a -> MetaNodeType a
forall a b. Cast a b => a -> b
downCast MetaNodeType a
tyR)
  downCast (Controls V2 a
p1 V2 a
p2) = Point a -> Point a -> MetaJoin a
forall a. Point a -> Point a -> MetaJoin a
C.Controls (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
p1) (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
p2)
  upCast :: MetaJoin a -> MetaJoin a
upCast (C.MetaJoin MetaNodeType a
tyL Tension a
tL Tension a
tR MetaNodeType a
tyR) =
    MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin (MetaNodeType a -> MetaNodeType a
forall a b. Cast a b => b -> a
upCast MetaNodeType a
tyL) (Tension a -> Tension a
forall a b. Cast a b => b -> a
upCast Tension a
tL) (Tension a -> Tension a
forall a b. Cast a b => b -> a
upCast Tension a
tR) (MetaNodeType a -> MetaNodeType a
forall a b. Cast a b => b -> a
upCast MetaNodeType a
tyR)
  upCast (C.Controls Point a
p1 Point a
p2)         = V2 a -> V2 a -> MetaJoin a
forall a. V2 a -> V2 a -> MetaJoin a
Controls (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
p1) (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
p2)

instance Cast (PathJoin a) (C.PathJoin a) where
  downCast :: PathJoin a -> PathJoin a
downCast PathJoin a
JoinLine        = PathJoin a
forall a. PathJoin a
C.JoinLine
  downCast (JoinCurve V2 a
a V2 a
b) = Point a -> Point a -> PathJoin a
forall a. Point a -> Point a -> PathJoin a
C.JoinCurve (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
a) (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
b)
  upCast :: PathJoin a -> PathJoin a
upCast PathJoin a
C.JoinLine        = PathJoin a
forall a. PathJoin a
JoinLine
  upCast (C.JoinCurve Point a
a Point a
b) = V2 a -> V2 a -> PathJoin a
forall a. V2 a -> V2 a -> PathJoin a
JoinCurve (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
a) (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
b)

instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
  downCast :: OpenMetaPath a -> OpenMetaPath a
downCast (OpenMetaPath [(V2 a, MetaJoin a)]
lst V2 a
end) = [(Point a, MetaJoin a)] -> Point a -> OpenMetaPath a
forall a. [(Point a, MetaJoin a)] -> Point a -> OpenMetaPath a
C.OpenMetaPath
    [ (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
p, MetaJoin a -> MetaJoin a
forall a b. Cast a b => a -> b
downCast MetaJoin a
j)
    | (V2 a
p, MetaJoin a
j) <- [(V2 a, MetaJoin a)]
lst ] (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
end)
  upCast :: OpenMetaPath a -> OpenMetaPath a
upCast (C.OpenMetaPath [(Point a, MetaJoin a)]
lst Point a
end) = [(V2 a, MetaJoin a)] -> V2 a -> OpenMetaPath a
forall a. [(V2 a, MetaJoin a)] -> V2 a -> OpenMetaPath a
OpenMetaPath
    [ (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
p, MetaJoin a -> MetaJoin a
forall a b. Cast a b => b -> a
upCast MetaJoin a
j)
    | (Point a
p, MetaJoin a
j) <- [(Point a, MetaJoin a)]
lst ] (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
end)

instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
  downCast :: ClosedMetaPath a -> ClosedMetaPath a
downCast (ClosedMetaPath [(V2 a, MetaJoin a)]
lst) = [(Point a, MetaJoin a)] -> ClosedMetaPath a
forall a. [(Point a, MetaJoin a)] -> ClosedMetaPath a
C.ClosedMetaPath
    [ (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
p, MetaJoin a -> MetaJoin a
forall a b. Cast a b => a -> b
downCast MetaJoin a
j)
    | (V2 a
p, MetaJoin a
j) <- [(V2 a, MetaJoin a)]
lst ]
  upCast :: ClosedMetaPath a -> ClosedMetaPath a
upCast (C.ClosedMetaPath [(Point a, MetaJoin a)]
lst) = [(V2 a, MetaJoin a)] -> ClosedMetaPath a
forall a. [(V2 a, MetaJoin a)] -> ClosedMetaPath a
ClosedMetaPath
    [ (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
p, MetaJoin a -> MetaJoin a
forall a b. Cast a b => b -> a
upCast MetaJoin a
j)
    | (Point a
p, MetaJoin a
j) <- [(Point a, MetaJoin a)]
lst ]

instance Cast (OpenPath a) (C.OpenPath a) where
  downCast :: OpenPath a -> OpenPath a
downCast (OpenPath [(V2 a, PathJoin a)]
lst V2 a
end) = [(Point a, PathJoin a)] -> Point a -> OpenPath a
forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
C.OpenPath
    [ (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
p, PathJoin a -> PathJoin a
forall a b. Cast a b => a -> b
downCast PathJoin a
j)
    | (V2 a
p, PathJoin a
j) <- [(V2 a, PathJoin a)]
lst ] (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
end)
  upCast :: OpenPath a -> OpenPath a
upCast (C.OpenPath [(Point a, PathJoin a)]
lst Point a
end) = [(V2 a, PathJoin a)] -> V2 a -> OpenPath a
forall a. [(V2 a, PathJoin a)] -> V2 a -> OpenPath a
OpenPath
    [ (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
p, PathJoin a -> PathJoin a
forall a b. Cast a b => b -> a
upCast PathJoin a
j)
    | (Point a
p, PathJoin a
j) <- [(Point a, PathJoin a)]
lst ] (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
end)

instance Cast (ClosedPath a) (C.ClosedPath a) where
  downCast :: ClosedPath a -> ClosedPath a
downCast (ClosedPath [(V2 a, PathJoin a)]
lst) = [(Point a, PathJoin a)] -> ClosedPath a
forall a. [(Point a, PathJoin a)] -> ClosedPath a
C.ClosedPath
    [ (V2 a -> Point a
forall a b. Cast a b => a -> b
downCast V2 a
p, PathJoin a -> PathJoin a
forall a b. Cast a b => a -> b
downCast PathJoin a
j)
    | (V2 a
p, PathJoin a
j) <- [(V2 a, PathJoin a)]
lst ]
  upCast :: ClosedPath a -> ClosedPath a
upCast (C.ClosedPath [(Point a, PathJoin a)]
lst) = [(V2 a, PathJoin a)] -> ClosedPath a
forall a. [(V2 a, PathJoin a)] -> ClosedPath a
ClosedPath
    [ (Point a -> V2 a
forall a b. Cast a b => b -> a
upCast Point a
p, PathJoin a -> PathJoin a
forall a b. Cast a b => b -> a
upCast PathJoin a
j)
    | (Point a
p, PathJoin a
j) <- [(Point a, PathJoin a)]
lst ]