{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE BangPatterns, DeriveFunctor #-}
-- | This module implements an extension to paths as used in
-- D.E.Knuth's /Metafont/.  Metafont gives an alternate way
-- to specify paths using bezier curves.  I'll give a brief overview of
-- the metafont curves.  A more in depth explanation can be found in 
-- /The MetafontBook/.
-- 
-- Each spline has a tension parameter, which is a relative measure of
-- the length of the curve.  You can specify the tension for the left
-- side and the right side of the spline separately.  By default
-- metafont gives a tension of 1, which gives a good looking curve.
-- Tensions shouldn't be less than 3/4, but this implementation
-- doesn't check for it.  If you want to avoid points of inflection on
-- the spline, you can use @TensionAtLeast@ instead of @Tension@,
-- which will adjust the length of the control points so they fall
-- into the /bounding triangle/, if such a triangle exist.
--
-- You can either give directions for each node, or let metafont find
-- them.  Metafont will solve a set of equations to find the
-- directions.  You can also let metafont find directions at corner
-- points by setting the /curl/, which is how much the point /curls/
-- at that point.  At endpoints a curl of 1 is implied when it is not
-- given.
--
-- Metafont will then find the control points from the path for you.
-- You can also specify the control points explicitly.
--
-- Here is an example path from the metafont program text:
-- 
-- @
-- z0..z1..tension atleast 1..{curl 2}z2..z3{-1,-2}..tension 3 and 4..z4..controls z45 and z54..z5
-- @
-- 
-- This path is equivalent to:
--
-- @
-- z0{curl 1}..tension atleast 1 and atleast 1..{curl 2}z2{curl 2}..tension 1 and 1..
-- {-1,-2}z3{-1,-2}..tension 3 and 4..z4..controls z45 and z54..z5
-- @
--
-- This path can be used with the following datatype:
-- 
-- @
-- OpenMetaPath [ (z0, MetaJoin Open (Tension 1) (Tension 1) Open)
--              , (z1, MetaJoin Open (TensionAtLeast 1) (TensionAtLeast 1) (Curl 2))
--              , (z2, MetaJoin Open (Tension 1) (Tension 1) Open)
--              , (z3, MetaJoin (Direction (Point (-1) (-2))) (Tension 3) (Tension 4) Open)
--              , (z4, Controls z45 z54)
--              ] z5
-- @
--
-- Cyclic paths are similar, but use the @CyclicMetaPath@ contructor.
-- There is no ending point, since the ending point will be the same
-- as the first point.

module Geom2D.CubicBezier.MetaPath
       (unmetaOpen, unmetaClosed, ClosedMetaPath(..), OpenMetaPath (..),
        MetaJoin (..), MetaNodeType (..), Tension (..))
where
import Geom2D
import Geom2D.CubicBezier.Basic
import Data.List
import Text.Printf
import qualified Data.Vector.Unboxed as V
import Geom2D.CubicBezier.Numeric

data OpenMetaPath a = OpenMetaPath [(Point a, MetaJoin a)] (Point a)
                        -- ^ A metapath with endpoints
                    deriving (forall a b. a -> OpenMetaPath b -> OpenMetaPath a
forall a b. (a -> b) -> OpenMetaPath a -> OpenMetaPath b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> OpenMetaPath b -> OpenMetaPath a
$c<$ :: forall a b. a -> OpenMetaPath b -> OpenMetaPath a
fmap :: forall a b. (a -> b) -> OpenMetaPath a -> OpenMetaPath b
$cfmap :: forall a b. (a -> b) -> OpenMetaPath a -> OpenMetaPath b
Functor, Functor OpenMetaPath
Foldable OpenMetaPath
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 =>
OpenMetaPath (m a) -> m (OpenMetaPath a)
forall (f :: * -> *) a.
Applicative f =>
OpenMetaPath (f a) -> f (OpenMetaPath a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OpenMetaPath a -> m (OpenMetaPath b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OpenMetaPath a -> f (OpenMetaPath b)
sequence :: forall (m :: * -> *) a.
Monad m =>
OpenMetaPath (m a) -> m (OpenMetaPath a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
OpenMetaPath (m a) -> m (OpenMetaPath a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OpenMetaPath a -> m (OpenMetaPath b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OpenMetaPath a -> m (OpenMetaPath b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
OpenMetaPath (f a) -> f (OpenMetaPath a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
OpenMetaPath (f a) -> f (OpenMetaPath a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OpenMetaPath a -> f (OpenMetaPath b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OpenMetaPath a -> f (OpenMetaPath b)
Traversable, forall a. Eq a => a -> OpenMetaPath a -> Bool
forall a. Num a => OpenMetaPath a -> a
forall a. Ord a => OpenMetaPath a -> a
forall m. Monoid m => OpenMetaPath m -> m
forall a. OpenMetaPath a -> Bool
forall a. OpenMetaPath a -> Int
forall a. OpenMetaPath a -> [a]
forall a. (a -> a -> a) -> OpenMetaPath a -> a
forall m a. Monoid m => (a -> m) -> OpenMetaPath a -> m
forall b a. (b -> a -> b) -> b -> OpenMetaPath a -> b
forall a b. (a -> b -> b) -> b -> OpenMetaPath 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 :: forall a. Num a => OpenMetaPath a -> a
$cproduct :: forall a. Num a => OpenMetaPath a -> a
sum :: forall a. Num a => OpenMetaPath a -> a
$csum :: forall a. Num a => OpenMetaPath a -> a
minimum :: forall a. Ord a => OpenMetaPath a -> a
$cminimum :: forall a. Ord a => OpenMetaPath a -> a
maximum :: forall a. Ord a => OpenMetaPath a -> a
$cmaximum :: forall a. Ord a => OpenMetaPath a -> a
elem :: forall a. Eq a => a -> OpenMetaPath a -> Bool
$celem :: forall a. Eq a => a -> OpenMetaPath a -> Bool
length :: forall a. OpenMetaPath a -> Int
$clength :: forall a. OpenMetaPath a -> Int
null :: forall a. OpenMetaPath a -> Bool
$cnull :: forall a. OpenMetaPath a -> Bool
toList :: forall a. OpenMetaPath a -> [a]
$ctoList :: forall a. OpenMetaPath a -> [a]
foldl1 :: forall a. (a -> a -> a) -> OpenMetaPath a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> OpenMetaPath a -> a
foldr1 :: forall a. (a -> a -> a) -> OpenMetaPath a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> OpenMetaPath a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> OpenMetaPath a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> OpenMetaPath a -> b
foldl :: forall b a. (b -> a -> b) -> b -> OpenMetaPath a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> OpenMetaPath a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> OpenMetaPath a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> OpenMetaPath a -> b
foldr :: forall a b. (a -> b -> b) -> b -> OpenMetaPath a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> OpenMetaPath a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> OpenMetaPath a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> OpenMetaPath a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> OpenMetaPath a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> OpenMetaPath a -> m
fold :: forall m. Monoid m => OpenMetaPath m -> m
$cfold :: forall m. Monoid m => OpenMetaPath m -> m
Foldable)


data ClosedMetaPath a = ClosedMetaPath [(Point a, MetaJoin a)]
                        -- ^ A metapath with cycles.  The last join
                        -- joins the last point with the first.
                      deriving (ClosedMetaPath a -> ClosedMetaPath a -> Bool
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, forall a b. a -> ClosedMetaPath b -> ClosedMetaPath a
forall a b. (a -> b) -> ClosedMetaPath a -> ClosedMetaPath b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ClosedMetaPath b -> ClosedMetaPath a
$c<$ :: forall a b. a -> ClosedMetaPath b -> ClosedMetaPath a
fmap :: forall a b. (a -> b) -> ClosedMetaPath a -> ClosedMetaPath b
$cfmap :: forall a b. (a -> b) -> ClosedMetaPath a -> ClosedMetaPath b
Functor, Functor ClosedMetaPath
Foldable ClosedMetaPath
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 =>
ClosedMetaPath (m a) -> m (ClosedMetaPath a)
forall (f :: * -> *) a.
Applicative f =>
ClosedMetaPath (f a) -> f (ClosedMetaPath a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ClosedMetaPath a -> m (ClosedMetaPath b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ClosedMetaPath a -> f (ClosedMetaPath b)
sequence :: forall (m :: * -> *) a.
Monad m =>
ClosedMetaPath (m a) -> m (ClosedMetaPath a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ClosedMetaPath (m a) -> m (ClosedMetaPath a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ClosedMetaPath a -> m (ClosedMetaPath b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ClosedMetaPath a -> m (ClosedMetaPath b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ClosedMetaPath (f a) -> f (ClosedMetaPath a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ClosedMetaPath (f a) -> f (ClosedMetaPath a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ClosedMetaPath a -> f (ClosedMetaPath b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ClosedMetaPath a -> f (ClosedMetaPath b)
Traversable, forall a. Eq a => a -> ClosedMetaPath a -> Bool
forall a. Num a => ClosedMetaPath a -> a
forall a. Ord a => ClosedMetaPath a -> a
forall m. Monoid m => ClosedMetaPath m -> m
forall a. ClosedMetaPath a -> Bool
forall a. ClosedMetaPath a -> Int
forall a. ClosedMetaPath a -> [a]
forall a. (a -> a -> a) -> ClosedMetaPath a -> a
forall m a. Monoid m => (a -> m) -> ClosedMetaPath a -> m
forall b a. (b -> a -> b) -> b -> ClosedMetaPath a -> b
forall a b. (a -> b -> b) -> b -> ClosedMetaPath 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 :: forall a. Num a => ClosedMetaPath a -> a
$cproduct :: forall a. Num a => ClosedMetaPath a -> a
sum :: forall a. Num a => ClosedMetaPath a -> a
$csum :: forall a. Num a => ClosedMetaPath a -> a
minimum :: forall a. Ord a => ClosedMetaPath a -> a
$cminimum :: forall a. Ord a => ClosedMetaPath a -> a
maximum :: forall a. Ord a => ClosedMetaPath a -> a
$cmaximum :: forall a. Ord a => ClosedMetaPath a -> a
elem :: forall a. Eq a => a -> ClosedMetaPath a -> Bool
$celem :: forall a. Eq a => a -> ClosedMetaPath a -> Bool
length :: forall a. ClosedMetaPath a -> Int
$clength :: forall a. ClosedMetaPath a -> Int
null :: forall a. ClosedMetaPath a -> Bool
$cnull :: forall a. ClosedMetaPath a -> Bool
toList :: forall a. ClosedMetaPath a -> [a]
$ctoList :: forall a. ClosedMetaPath a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ClosedMetaPath a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ClosedMetaPath a -> a
foldr1 :: forall a. (a -> a -> a) -> ClosedMetaPath a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ClosedMetaPath a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ClosedMetaPath a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ClosedMetaPath a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ClosedMetaPath a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ClosedMetaPath a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ClosedMetaPath a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ClosedMetaPath a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ClosedMetaPath a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ClosedMetaPath a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ClosedMetaPath a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ClosedMetaPath a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ClosedMetaPath a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ClosedMetaPath a -> m
fold :: forall m. Monoid m => ClosedMetaPath m -> m
$cfold :: forall m. Monoid m => ClosedMetaPath m -> m
Foldable)

data MetaJoin a = MetaJoin { forall a. MetaJoin a -> MetaNodeType a
metaTypeL :: MetaNodeType a
                           -- ^ The nodetype going out of the
                           -- previous point.  The metafont default is
                           -- @Open@.
                           , forall a. MetaJoin a -> Tension a
tensionL :: Tension a
                             -- ^ The tension going out of the previous point.
                             -- The metafont default is 1.
                           , forall a. MetaJoin a -> Tension a
tensionR :: Tension a
                             -- ^ The tension going into the next point.
                             -- The metafont default is 1.
                           , forall a. MetaJoin a -> MetaNodeType a
metaTypeR :: MetaNodeType a
                             -- ^ The nodetype going into the next point.
                             -- The metafont default is @Open@.
                           }
                | Controls (Point a) (Point a)
                  -- ^ Specify the control points explicitly.
                deriving (Int -> MetaJoin a -> ShowS
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
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, forall a b. a -> MetaJoin b -> MetaJoin a
forall a b. (a -> b) -> MetaJoin a -> MetaJoin b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MetaJoin b -> MetaJoin a
$c<$ :: forall a b. a -> MetaJoin b -> MetaJoin a
fmap :: forall a b. (a -> b) -> MetaJoin a -> MetaJoin b
$cfmap :: forall a b. (a -> b) -> MetaJoin a -> MetaJoin b
Functor, Functor MetaJoin
Foldable MetaJoin
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 => MetaJoin (m a) -> m (MetaJoin a)
forall (f :: * -> *) a.
Applicative f =>
MetaJoin (f a) -> f (MetaJoin a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaJoin a -> m (MetaJoin b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaJoin a -> f (MetaJoin b)
sequence :: forall (m :: * -> *) a. Monad m => MetaJoin (m a) -> m (MetaJoin a)
$csequence :: forall (m :: * -> *) a. Monad m => MetaJoin (m a) -> m (MetaJoin a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaJoin a -> m (MetaJoin b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaJoin a -> m (MetaJoin b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MetaJoin (f a) -> f (MetaJoin a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MetaJoin (f a) -> f (MetaJoin a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaJoin a -> f (MetaJoin b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaJoin a -> f (MetaJoin b)
Traversable, forall a. Eq a => a -> MetaJoin a -> Bool
forall a. Num a => MetaJoin a -> a
forall a. Ord a => MetaJoin a -> a
forall m. Monoid m => MetaJoin m -> m
forall a. MetaJoin a -> Bool
forall a. MetaJoin a -> Int
forall a. MetaJoin a -> [a]
forall a. (a -> a -> a) -> MetaJoin a -> a
forall m a. Monoid m => (a -> m) -> MetaJoin a -> m
forall b a. (b -> a -> b) -> b -> MetaJoin a -> b
forall a b. (a -> b -> b) -> b -> MetaJoin 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 :: forall a. Num a => MetaJoin a -> a
$cproduct :: forall a. Num a => MetaJoin a -> a
sum :: forall a. Num a => MetaJoin a -> a
$csum :: forall a. Num a => MetaJoin a -> a
minimum :: forall a. Ord a => MetaJoin a -> a
$cminimum :: forall a. Ord a => MetaJoin a -> a
maximum :: forall a. Ord a => MetaJoin a -> a
$cmaximum :: forall a. Ord a => MetaJoin a -> a
elem :: forall a. Eq a => a -> MetaJoin a -> Bool
$celem :: forall a. Eq a => a -> MetaJoin a -> Bool
length :: forall a. MetaJoin a -> Int
$clength :: forall a. MetaJoin a -> Int
null :: forall a. MetaJoin a -> Bool
$cnull :: forall a. MetaJoin a -> Bool
toList :: forall a. MetaJoin a -> [a]
$ctoList :: forall a. MetaJoin a -> [a]
foldl1 :: forall a. (a -> a -> a) -> MetaJoin a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MetaJoin a -> a
foldr1 :: forall a. (a -> a -> a) -> MetaJoin a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MetaJoin a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> MetaJoin a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MetaJoin a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MetaJoin a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MetaJoin a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MetaJoin a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MetaJoin a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MetaJoin a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MetaJoin a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> MetaJoin a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MetaJoin a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MetaJoin a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MetaJoin a -> m
fold :: forall m. Monoid m => MetaJoin m -> m
$cfold :: forall m. Monoid m => MetaJoin m -> m
Foldable)
                         
data MetaNodeType a = Open
                    -- ^ An open node has no direction specified.  If
                    -- it is an internal node, the curve will keep the
                    -- same direction going into and going out from
                    -- the node.  If it is an endpoint or corner
                    -- point, it will have curl of 1.
                  | Curl {forall a. MetaNodeType a -> a
curlgamma :: a}
                    -- ^ The node becomes an endpoint or a corner
                    -- point.  The curl specifies how much the segment
                    -- `curves`.  A curl of `gamma` means that the
                    -- curvature is `gamma` times that of the
                    -- following node.
                  | Direction {forall a. MetaNodeType a -> Point a
nodedir :: Point a}
                    -- ^ The node has a given direction.
                  deriving (MetaNodeType a -> MetaNodeType a -> Bool
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, Int -> MetaNodeType a -> ShowS
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, forall a b. a -> MetaNodeType b -> MetaNodeType a
forall a b. (a -> b) -> MetaNodeType a -> MetaNodeType b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MetaNodeType b -> MetaNodeType a
$c<$ :: forall a b. a -> MetaNodeType b -> MetaNodeType a
fmap :: forall a b. (a -> b) -> MetaNodeType a -> MetaNodeType b
$cfmap :: forall a b. (a -> b) -> MetaNodeType a -> MetaNodeType b
Functor, forall a. Eq a => a -> MetaNodeType a -> Bool
forall a. Num a => MetaNodeType a -> a
forall a. Ord a => MetaNodeType a -> a
forall m. Monoid m => MetaNodeType m -> m
forall a. MetaNodeType a -> Bool
forall a. MetaNodeType a -> Int
forall a. MetaNodeType a -> [a]
forall a. (a -> a -> a) -> MetaNodeType a -> a
forall m a. Monoid m => (a -> m) -> MetaNodeType a -> m
forall b a. (b -> a -> b) -> b -> MetaNodeType a -> b
forall a b. (a -> b -> b) -> b -> MetaNodeType 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 :: forall a. Num a => MetaNodeType a -> a
$cproduct :: forall a. Num a => MetaNodeType a -> a
sum :: forall a. Num a => MetaNodeType a -> a
$csum :: forall a. Num a => MetaNodeType a -> a
minimum :: forall a. Ord a => MetaNodeType a -> a
$cminimum :: forall a. Ord a => MetaNodeType a -> a
maximum :: forall a. Ord a => MetaNodeType a -> a
$cmaximum :: forall a. Ord a => MetaNodeType a -> a
elem :: forall a. Eq a => a -> MetaNodeType a -> Bool
$celem :: forall a. Eq a => a -> MetaNodeType a -> Bool
length :: forall a. MetaNodeType a -> Int
$clength :: forall a. MetaNodeType a -> Int
null :: forall a. MetaNodeType a -> Bool
$cnull :: forall a. MetaNodeType a -> Bool
toList :: forall a. MetaNodeType a -> [a]
$ctoList :: forall a. MetaNodeType a -> [a]
foldl1 :: forall a. (a -> a -> a) -> MetaNodeType a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MetaNodeType a -> a
foldr1 :: forall a. (a -> a -> a) -> MetaNodeType a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MetaNodeType a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> MetaNodeType a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MetaNodeType a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MetaNodeType a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MetaNodeType a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MetaNodeType a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MetaNodeType a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MetaNodeType a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MetaNodeType a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> MetaNodeType a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MetaNodeType a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MetaNodeType a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MetaNodeType a -> m
fold :: forall m. Monoid m => MetaNodeType m -> m
$cfold :: forall m. Monoid m => MetaNodeType m -> m
Foldable, Functor MetaNodeType
Foldable MetaNodeType
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 =>
MetaNodeType (m a) -> m (MetaNodeType a)
forall (f :: * -> *) a.
Applicative f =>
MetaNodeType (f a) -> f (MetaNodeType a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaNodeType a -> m (MetaNodeType b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaNodeType a -> f (MetaNodeType b)
sequence :: forall (m :: * -> *) a.
Monad m =>
MetaNodeType (m a) -> m (MetaNodeType a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MetaNodeType (m a) -> m (MetaNodeType a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaNodeType a -> m (MetaNodeType b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaNodeType a -> m (MetaNodeType b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MetaNodeType (f a) -> f (MetaNodeType a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MetaNodeType (f a) -> f (MetaNodeType a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaNodeType a -> f (MetaNodeType b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaNodeType a -> f (MetaNodeType b)
Traversable)

data Tension a = Tension {forall a. Tension a -> a
tensionValue :: a}
               -- ^ 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.
             | TensionAtLeast {tensionValue :: a}
               -- ^ Like @Tension@, but keep the segment inside the
               -- bounding triangle defined by the control points, if
               -- there is one.
             deriving (Tension a -> Tension a -> Bool
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
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, 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
<$ :: forall a b. a -> Tension b -> Tension a
$c<$ :: forall a b. a -> Tension b -> Tension a
fmap :: forall a b. (a -> b) -> Tension a -> Tension b
$cfmap :: forall a b. (a -> b) -> Tension a -> Tension b
Functor, 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 :: forall a. Num a => Tension a -> a
$cproduct :: forall a. Num a => Tension a -> a
sum :: forall a. Num a => Tension a -> a
$csum :: forall a. Num a => Tension a -> a
minimum :: forall a. Ord a => Tension a -> a
$cminimum :: forall a. Ord a => Tension a -> a
maximum :: forall a. Ord a => Tension a -> a
$cmaximum :: forall a. Ord a => Tension a -> a
elem :: forall a. Eq a => a -> Tension a -> Bool
$celem :: forall a. Eq a => a -> Tension a -> Bool
length :: forall a. Tension a -> Int
$clength :: forall a. Tension a -> Int
null :: forall a. Tension a -> Bool
$cnull :: forall a. Tension a -> Bool
toList :: forall a. Tension a -> [a]
$ctoList :: forall a. Tension a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Tension a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Tension a -> a
foldr1 :: forall a. (a -> a -> a) -> Tension a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Tension a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Tension a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Tension a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Tension a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Tension a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Tension a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Tension a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Tension a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Tension a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Tension a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Tension a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Tension a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Tension a -> m
fold :: forall m. Monoid m => Tension m -> m
$cfold :: forall m. Monoid m => Tension m -> m
Foldable, Functor Tension
Foldable Tension
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 :: forall (m :: * -> *) a. Monad m => Tension (m a) -> m (Tension a)
$csequence :: forall (m :: * -> *) a. Monad m => Tension (m a) -> m (Tension a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tension a -> m (Tension b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tension a -> m (Tension b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Tension (f a) -> f (Tension a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Tension (f a) -> f (Tension a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tension a -> f (Tension b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tension a -> f (Tension b)
Traversable)

instance (Show a, Real a) => Show (ClosedMetaPath a) where
  show :: ClosedMetaPath a -> String
show (ClosedMetaPath [(Point a, MetaJoin a)]
nodes) =
    forall a. (Show a, Real a) => [(Point a, MetaJoin a)] -> String
showPath [(Point a, MetaJoin a)]
nodes forall a. [a] -> [a] -> [a]
++ String
"cycle"

instance (Show a, Real a) => Show (OpenMetaPath a) where
  show :: OpenMetaPath a -> String
show (OpenMetaPath [(Point a, MetaJoin a)]
nodes Point a
lastpoint) =
    forall a. (Show a, Real a) => [(Point a, MetaJoin a)] -> String
showPath [(Point a, MetaJoin a)]
nodes forall a. [a] -> [a] -> [a]
++ forall a. Show a => Point a -> String
showPoint Point a
lastpoint

showPath :: (Show a, Real a) => [(Point a, MetaJoin a)] -> String
showPath :: forall a. (Show a, Real a) => [(Point a, MetaJoin a)] -> String
showPath = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {a}.
(Show a, Show a, Real a) =>
(Point a, MetaJoin a) -> String
showNodes
  where
    showNodes :: (Point a, MetaJoin a) -> String
showNodes (Point a
p, Controls Point a
u Point a
v) =
      forall a. Show a => Point a -> String
showPoint Point a
p forall a. [a] -> [a] -> [a]
++ String
"..controls " forall a. [a] -> [a] -> [a]
++ forall a. Show a => Point a -> String
showPoint Point a
u forall a. [a] -> [a] -> [a]
++ String
"and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => Point a -> String
showPoint Point a
v forall a. [a] -> [a] -> [a]
++ String
".."
    showNodes (Point a
p, MetaJoin MetaNodeType a
m1 Tension a
t1 Tension a
t2 MetaNodeType a
m2) =
      forall a. Show a => Point a -> String
showPoint Point a
p forall a. [a] -> [a] -> [a]
++ forall {a}. (Real a, Show a) => MetaNodeType a -> String
typename MetaNodeType a
m1 forall a. [a] -> [a] -> [a]
++ String
".." forall a. [a] -> [a] -> [a]
++ String
tensions forall a. [a] -> [a] -> [a]
++ forall {a}. (Real a, Show a) => MetaNodeType a -> String
typename MetaNodeType a
m2
      where
        tensions :: String
tensions
          | Tension a
t1 forall a. Eq a => a -> a -> Bool
== Tension a
t2 Bool -> Bool -> Bool
&& Tension a
t1 forall a. Eq a => a -> a -> Bool
== forall a. a -> Tension a
Tension a
1 = String
""
          | Tension a
t1 forall a. Eq a => a -> a -> Bool
== Tension a
t2 = forall r. PrintfType r => String -> r
printf String
"tension %s.." (forall {a}. Real a => Tension a -> String
showTension Tension a
t1)
          | Bool
otherwise = forall r. PrintfType r => String -> r
printf String
"tension %s and %s.."
                        (forall {a}. Real a => Tension a -> String
showTension Tension a
t1) (forall {a}. Real a => Tension a -> String
showTension Tension a
t2)
    showTension :: Tension a -> String
showTension (TensionAtLeast a
t) = forall r. PrintfType r => String -> r
printf String
"atleast %.3f" (forall a b. (Real a, Fractional b) => a -> b
realToFrac a
t :: Double) :: String
    showTension (Tension a
t) = forall r. PrintfType r => String -> r
printf String
"%.3f" (forall a b. (Real a, Fractional b) => a -> b
realToFrac a
t :: Double) :: String
    typename :: MetaNodeType a -> String
typename MetaNodeType a
Open = String
""
    typename (Curl a
g) = forall r. PrintfType r => String -> r
printf String
"{curl %.3f}" (forall a b. (Real a, Fractional b) => a -> b
realToFrac a
g :: Double) :: String
    typename (Direction Point a
dir) = forall r. PrintfType r => String -> r
printf String
"{%s}" (forall a. Show a => Point a -> String
showPoint Point a
dir) :: String
    
showPoint :: Show a => Point a -> String
showPoint :: forall a. Show a => Point a -> String
showPoint (Point a
x a
y) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y forall a. [a] -> [a] -> [a]
++ String
")"

-- | Create a normal path from a metapath.
unmetaOpen :: OpenMetaPath Double -> OpenPath Double
unmetaOpen :: OpenMetaPath Double -> OpenPath Double
unmetaOpen (OpenMetaPath [(Point Double, MetaJoin Double)]
nodes Point Double
endpoint) =
  [(Point Double, MetaJoin Double)]
-> Point Double -> OpenPath Double
unmetaOpen' (forall a b c. (a -> b -> c) -> b -> a -> c
flip [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize Point Double
endpoint forall a b. (a -> b) -> a -> b
$
              [(Point Double, MetaJoin Double)]
-> [(Point Double, MetaJoin Double)]
removeEmptyDirs [(Point Double, MetaJoin Double)]
nodes)
  Point Double
endpoint

unmetaOpen' :: [(DPoint, MetaJoin Double)] -> DPoint -> OpenPath Double
unmetaOpen' :: [(Point Double, MetaJoin Double)]
-> Point Double -> OpenPath Double
unmetaOpen' [(Point Double, MetaJoin Double)]
nodes Point Double
endpoint =
  let subsegs :: [OpenMetaPath Double]
subsegs = [(Point Double, MetaJoin Double)]
-> Point Double -> [OpenMetaPath Double]
openSubSegments [(Point Double, MetaJoin Double)]
nodes Point Double
endpoint
      path :: [(Point Double, PathJoin Double)]
path = [OpenPath Double] -> [(Point Double, PathJoin Double)]
joinSegments forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map OpenMetaPath Double -> OpenPath Double
unmetaSubSegment [OpenMetaPath Double]
subsegs
  in forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [(Point Double, PathJoin Double)]
path Point Double
endpoint

unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
unmetaClosed (ClosedMetaPath [(Point Double, MetaJoin Double)]
nodes) =
  case forall a. ([a] -> Bool) -> [a] -> ([a], [a])
spanList [(Point Double, MetaJoin Double)] -> Bool
bothOpen ([(Point Double, MetaJoin Double)]
-> [(Point Double, MetaJoin Double)]
removeEmptyDirs [(Point Double, MetaJoin Double)]
nodes) of
    ([], []) -> forall a. HasCallStack => String -> a
error String
"empty metapath"
    ([(Point Double, MetaJoin Double)]
l, []) -> if forall a b. (a, b) -> a
fst (forall a. [a] -> a
last [(Point Double, MetaJoin Double)]
l) forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (forall a. [a] -> a
head [(Point Double, MetaJoin Double)]
l)
               then [(Point Double, MetaJoin Double)]
-> [(Point Double, MetaJoin Double)] -> ClosedPath Double
unmetaAsOpen [(Point Double, MetaJoin Double)]
l []
               else [(Point Double, MetaJoin Double)] -> ClosedPath Double
unmetaCyclic [(Point Double, MetaJoin Double)]
l
    ([(Point Double, MetaJoin Double)]
l, (Point Double, MetaJoin Double)
m:[(Point Double, MetaJoin Double)]
n) ->
      if [(Point Double, MetaJoin Double)] -> Bool
leftOpen ((Point Double, MetaJoin Double)
mforall a. a -> [a] -> [a]
:[(Point Double, MetaJoin Double)]
n)
      then [(Point Double, MetaJoin Double)]
-> [(Point Double, MetaJoin Double)] -> ClosedPath Double
unmetaAsOpen ([(Point Double, MetaJoin Double)]
lforall a. [a] -> [a] -> [a]
++[(Point Double, MetaJoin Double)
m]) [(Point Double, MetaJoin Double)]
n
      else [(Point Double, MetaJoin Double)]
-> [(Point Double, MetaJoin Double)] -> ClosedPath Double
unmetaAsOpen [(Point Double, MetaJoin Double)]
l ((Point Double, MetaJoin Double)
mforall a. a -> [a] -> [a]
:[(Point Double, MetaJoin Double)]
n)

-- solve a cyclic metapath as an open path if possible.
-- rotate to the defined node, and rotate back after
-- solving the path.
unmetaAsOpen :: [(DPoint, MetaJoin Double)] -> [(DPoint, MetaJoin Double)] -> ClosedPath Double
unmetaAsOpen :: [(Point Double, MetaJoin Double)]
-> [(Point Double, MetaJoin Double)] -> ClosedPath Double
unmetaAsOpen [(Point Double, MetaJoin Double)]
l [(Point Double, MetaJoin Double)]
m = forall a. [(Point a, PathJoin a)] -> ClosedPath a
ClosedPath ([(Point Double, PathJoin Double)]
l'forall a. [a] -> [a] -> [a]
++[(Point Double, PathJoin Double)]
m') 
  where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Point Double, MetaJoin Double)]
m
        OpenPath [(Point Double, PathJoin Double)]
o Point Double
_ =
          [(Point Double, MetaJoin Double)]
-> Point Double -> OpenPath Double
unmetaOpen' ([(Point Double, MetaJoin Double)]
-> [(Point Double, MetaJoin Double)]
sanitizeCycle ([(Point Double, MetaJoin Double)]
mforall a. [a] -> [a] -> [a]
++[(Point Double, MetaJoin Double)]
l)) (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head ([(Point Double, MetaJoin Double)]
m forall a. [a] -> [a] -> [a]
++[(Point Double, MetaJoin Double)]
l))
        ([(Point Double, PathJoin Double)]
m',[(Point Double, PathJoin Double)]
l') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [(Point Double, PathJoin Double)]
o

-- decompose into a list of subsegments that need to be solved.
openSubSegments :: [(DPoint, MetaJoin Double)] -> DPoint -> [OpenMetaPath Double]
openSubSegments :: [(Point Double, MetaJoin Double)]
-> Point Double -> [OpenMetaPath Double]
openSubSegments [] Point Double
_   = []
openSubSegments [(Point Double, MetaJoin Double)]
l Point Double
lastPoint =
  case forall a. ([a] -> Bool) -> [a] -> ([a], [a])
spanList (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Point Double, MetaJoin Double)] -> Bool
breakPoint) [(Point Double, MetaJoin Double)]
l of
    ([(Point Double, MetaJoin Double)]
m, (Point Double, MetaJoin Double)
n:[(Point Double, MetaJoin Double)]
o) ->
      let point :: Point Double
point = case [(Point Double, MetaJoin Double)]
o of
            ((Point Double
p,MetaJoin Double
_):[(Point Double, MetaJoin Double)]
_) -> Point Double
p
            [(Point Double, MetaJoin Double)]
_ -> Point Double
lastPoint
      in forall a. [(Point a, MetaJoin a)] -> Point a -> OpenMetaPath a
OpenMetaPath ([(Point Double, MetaJoin Double)]
m forall a. [a] -> [a] -> [a]
++ [(Point Double, MetaJoin Double)
n]) Point Double
point forall a. a -> [a] -> [a]
:
         [(Point Double, MetaJoin Double)]
-> Point Double -> [OpenMetaPath Double]
openSubSegments [(Point Double, MetaJoin Double)]
o Point Double
lastPoint
    ([(Point Double, MetaJoin Double)],
 [(Point Double, MetaJoin Double)])
_ -> forall a. HasCallStack => String -> a
error String
"openSubSegments': unexpected end of segments"

-- join subsegments into one segment
joinSegments :: [OpenPath Double] -> [(DPoint, PathJoin Double)]
joinSegments :: [OpenPath Double] -> [(Point Double, PathJoin Double)]
joinSegments = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. OpenPath a -> [(Point a, PathJoin a)]
nodes
  where nodes :: OpenPath a -> [(Point a, PathJoin a)]
nodes (OpenPath [(Point a, PathJoin a)]
n Point a
_) = [(Point a, PathJoin a)]
n
        --nodes (ClosedPath n) = n

-- solve a cyclic metapath where all angles depend on the each other.
unmetaCyclic :: [(DPoint, MetaJoin Double)] -> ClosedPath Double
unmetaCyclic :: [(Point Double, MetaJoin Double)] -> ClosedPath Double
unmetaCyclic [(Point Double, MetaJoin Double)]
nodes =
  let points :: [Point Double]
points = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Point Double, MetaJoin Double)]
nodes
      chords :: [Point Double]
chords = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. AdditiveGroup v => v -> v -> v
(^-^) (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Point Double]
points) [Point Double]
points
      tensionsA :: [Tension Double]
tensionsA = forall a b. (a -> b) -> [a] -> [b]
map (forall a. MetaJoin a -> Tension a
tensionL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Point Double, MetaJoin Double)]
nodes
      tensionsB :: [Tension Double]
tensionsB = forall a b. (a -> b) -> [a] -> [b]
map (forall a. MetaJoin a -> Tension a
tensionR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Point Double, MetaJoin Double)]
nodes
      turnAngles :: [Double]
turnAngles = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Point Double -> Point Double -> Double
turnAngle [Point Double]
chords (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Point Double]
chords)
      thetas :: [Double]
thetas = [(Double, Double, Double, Double)] -> [Double]
solveCyclicTriD2 forall a b. (a -> b) -> a -> b
$
               [Tension Double]
-> [Point Double]
-> [Tension Double]
-> [Double]
-> [(Double, Double, Double, Double)]
eqsCycle [Tension Double]
tensionsA
               [Point Double]
points
               [Tension Double]
tensionsB
               [Double]
turnAngles
      phis :: [Double]
phis = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
x Double
y -> -(Double
xforall a. Num a => a -> a -> a
+Double
y)) [Double]
turnAngles (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Double]
thetas)
  in forall a. [(Point a, PathJoin a)] -> ClosedPath a
ClosedPath forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Point Double]
points forall a b. (a -> b) -> a -> b
$
     forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
zipWith6 Point Double
-> Point Double
-> Double
-> Double
-> Tension Double
-> Tension Double
-> PathJoin Double
unmetaJoin [Point Double]
points (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Point Double]
points)
     [Double]
thetas [Double]
phis [Tension Double]
tensionsA [Tension Double]
tensionsB

-- solve a subsegment
unmetaSubSegment :: OpenMetaPath Double -> OpenPath Double

-- the simple case where the control points are already given.
unmetaSubSegment :: OpenMetaPath Double -> OpenPath Double
unmetaSubSegment (OpenMetaPath [(Point Double
p, Controls Point Double
u Point Double
v)] Point Double
q) =
  forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [(Point Double
p, forall a. Point a -> Point a -> PathJoin a
JoinCurve Point Double
u Point Double
v)] Point Double
q

-- otherwise solve the angles, and find the control points
unmetaSubSegment (OpenMetaPath [(Point Double, MetaJoin Double)]
nodes Point Double
lastpoint) =
  let points :: [Point Double]
points = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Point Double, MetaJoin Double)]
nodes forall a. [a] -> [a] -> [a]
++ [Point Double
lastpoint]
      joins :: [MetaJoin Double]
joins = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Point Double, MetaJoin Double)]
nodes
      chords :: [Point Double]
chords = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. AdditiveGroup v => v -> v -> v
(^-^) (forall a. [a] -> [a]
tail [Point Double]
points) [Point Double]
points
      tensionsA :: [Tension Double]
tensionsA = forall a b. (a -> b) -> [a] -> [b]
map forall a. MetaJoin a -> Tension a
tensionL [MetaJoin Double]
joins
      tensionsB :: [Tension Double]
tensionsB = forall a b. (a -> b) -> [a] -> [b]
map forall a. MetaJoin a -> Tension a
tensionR [MetaJoin Double]
joins
      turnAngles :: [Double]
turnAngles = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Point Double -> Point Double -> Double
turnAngle [Point Double]
chords (forall a. [a] -> [a]
tail [Point Double]
chords) forall a. [a] -> [a] -> [a]
++ [Double
0]
      thetas :: [Double]
thetas = [(Double, Double, Double, Double)] -> [Double]
solveTriDiagonal2 forall a b. (a -> b) -> a -> b
$
               [Point Double]
-> [MetaJoin Double]
-> [Point Double]
-> [Double]
-> [Double]
-> [Double]
-> [(Double, Double, Double, Double)]
eqsOpen [Point Double]
points [MetaJoin Double]
joins [Point Double]
chords [Double]
turnAngles
               (forall a b. (a -> b) -> [a] -> [b]
map forall a. Tension a -> a
tensionValue [Tension Double]
tensionsA)
               (forall a b. (a -> b) -> [a] -> [b]
map forall a. Tension a -> a
tensionValue [Tension Double]
tensionsB)
      phis :: [Double]
phis = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
x Double
y -> -(Double
xforall a. Num a => a -> a -> a
+Double
y)) [Double]
turnAngles (forall a. [a] -> [a]
tail [Double]
thetas)
      pathjoins :: [PathJoin Double]
pathjoins =
        forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
zipWith6 Point Double
-> Point Double
-> Double
-> Double
-> Tension Double
-> Tension Double
-> PathJoin Double
unmetaJoin [Point Double]
points (forall a. [a] -> [a]
tail [Point Double]
points) [Double]
thetas [Double]
phis [Tension Double]
tensionsA [Tension Double]
tensionsB
  in forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath (forall a b. [a] -> [b] -> [(a, b)]
zip [Point Double]
points [PathJoin Double]
pathjoins) Point Double
lastpoint

removeEmptyDirs :: [(DPoint, MetaJoin Double)] -> [(DPoint, MetaJoin Double)]
removeEmptyDirs :: [(Point Double, MetaJoin Double)]
-> [(Point Double, MetaJoin Double)]
removeEmptyDirs = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Eq a, Num a) => (a, MetaJoin a) -> (a, MetaJoin a)
remove
  where remove :: (a, MetaJoin a) -> (a, MetaJoin a)
remove (a
p, MetaJoin (Direction (Point a
0 a
0)) Tension a
tl Tension a
tr MetaNodeType a
jr) = (a, MetaJoin a) -> (a, MetaJoin a)
remove (a
p, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin forall a. MetaNodeType a
Open Tension a
tl Tension a
tr MetaNodeType a
jr)
        remove (a
p, MetaJoin MetaNodeType a
jl Tension a
tl Tension a
tr (Direction (Point a
0 a
0))) = (a
p, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin MetaNodeType a
jl Tension a
tl Tension a
tr forall a. MetaNodeType a
Open)
        remove (a, MetaJoin a)
j = (a, MetaJoin a)
j

-- if p == q, it will become a control point
bothOpen :: [(DPoint, MetaJoin Double)] -> Bool
bothOpen :: [(Point Double, MetaJoin Double)] -> Bool
bothOpen ((Point Double
p, MetaJoin MetaNodeType Double
Open Tension Double
_ Tension Double
_ MetaNodeType Double
Open):(Point Double
q, MetaJoin Double
_):[(Point Double, MetaJoin Double)]
_) = Point Double
p forall a. Eq a => a -> a -> Bool
/= Point Double
q  
bothOpen [(Point Double
_, MetaJoin MetaNodeType Double
Open Tension Double
_ Tension Double
_ MetaNodeType Double
Open)] = Bool
True
bothOpen [(Point Double, MetaJoin Double)]
_ = Bool
False

leftOpen :: [(DPoint, MetaJoin Double)] -> Bool
leftOpen :: [(Point Double, MetaJoin Double)] -> Bool
leftOpen ((Point Double
p, MetaJoin MetaNodeType Double
Open Tension Double
_ Tension Double
_ MetaNodeType Double
_):(Point Double
q, MetaJoin Double
_):[(Point Double, MetaJoin Double)]
_) = Point Double
p forall a. Eq a => a -> a -> Bool
/= Point Double
q  
leftOpen [(Point Double
_, MetaJoin MetaNodeType Double
Open Tension Double
_ Tension Double
_ MetaNodeType Double
_)] = Bool
True
leftOpen [(Point Double, MetaJoin Double)]
_ = Bool
False

sanitizeCycle :: [(DPoint, MetaJoin Double)] -> [(DPoint, MetaJoin Double)]
sanitizeCycle :: [(Point Double, MetaJoin Double)]
-> [(Point Double, MetaJoin Double)]
sanitizeCycle [] = []
sanitizeCycle [(Point Double, MetaJoin Double)]
l = forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$
                  [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize (forall a. Int -> [a] -> [a]
drop (Int
nforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [(Point Double, MetaJoin Double)]
l) (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Point Double, MetaJoin Double)]
l)
  where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Point Double, MetaJoin Double)]
l

sanitize :: [(DPoint, MetaJoin Double)] -> DPoint -> [(DPoint, MetaJoin Double)]
sanitize :: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize [] Point Double
_ = []

-- ending open => curl
sanitize [(Point Double
p, MetaJoin MetaNodeType Double
m Tension Double
t1 Tension Double
t2 MetaNodeType Double
Open)] Point Double
r =
  if Point Double
p forall a. Eq a => a -> a -> Bool
== Point Double
r
  then [(Point Double
p, forall a. Point a -> Point a -> MetaJoin a
Controls Point Double
p Point Double
p)]
  else [(Point Double
p, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin MetaNodeType Double
m Tension Double
t1 Tension Double
t2 (forall a. a -> MetaNodeType a
Curl Double
1))]

sanitize ((Point Double
p, MetaJoin MetaNodeType Double
m1 Tension Double
tl Tension Double
tr MetaNodeType Double
Open): rest :: [(Point Double, MetaJoin Double)]
rest@((Point Double, MetaJoin Double)
node2:(Point Double, MetaJoin Double)
node3:[(Point Double, MetaJoin Double)]
_)) Point Double
r
  | (forall a b. (a, b) -> a
fst (Point Double, MetaJoin Double)
node2 forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (Point Double, MetaJoin Double)
node3) Bool -> Bool -> Bool
&& (forall a. MetaJoin a -> MetaNodeType a
metaTypeL (forall a b. (a, b) -> b
snd (Point Double, MetaJoin Double)
node2) forall a. Eq a => a -> a -> Bool
== forall a. MetaNodeType a
Open) =
    (Point Double
p, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin MetaNodeType Double
m1 Tension Double
tl Tension Double
tr (forall a. a -> MetaNodeType a
Curl Double
1)) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize [(Point Double, MetaJoin Double)]
rest Point Double
r
    
sanitize (node1 :: (Point Double, MetaJoin Double)
node1@(Point Double
p, MetaJoin MetaNodeType Double
m1 Tension Double
tl Tension Double
tr MetaNodeType Double
m2): node2 :: (Point Double, MetaJoin Double)
node2@(Point Double
q, MetaJoin MetaNodeType Double
n1 Tension Double
sl Tension Double
sr MetaNodeType Double
n2): [(Point Double, MetaJoin Double)]
rest) Point Double
r
  | Point Double
p forall a. Eq a => a -> a -> Bool
== Point Double
q =
    -- if two consecutive points are the same, just make a curve with all control points the same
    -- we still have to propagate a curl or given direction.
    let newnode :: (Point Double, MetaJoin Double)
newnode = (Point Double
p, forall a. Point a -> Point a -> MetaJoin a
Controls Point Double
p Point Double
p)
    in case (MetaNodeType Double
m2, MetaNodeType Double
n1) of
      (Curl Double
g, MetaNodeType Double
Open) -> -- curl, open => explicit, curl
        (Point Double, MetaJoin Double)
newnode forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin (forall a. a -> MetaNodeType a
Curl Double
g) Tension Double
sl Tension Double
sr MetaNodeType Double
n2)forall a. a -> [a] -> [a]
:[(Point Double, MetaJoin Double)]
rest) Point Double
r
      (Direction Point Double
dir, MetaNodeType Double
Open) ->   -- given, open => explicit, given
        (Point Double, MetaJoin Double)
newnode forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin (forall a. Point a -> MetaNodeType a
Direction Point Double
dir) Tension Double
sl Tension Double
sr MetaNodeType Double
n2) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
rest) Point Double
r
      (MetaNodeType Double
Open, MetaNodeType Double
Open) ->   -- open, open => explicit, curl
        (Point Double, MetaJoin Double)
newnode forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin (forall a. a -> MetaNodeType a
Curl Double
1) Tension Double
sl Tension Double
sr MetaNodeType Double
n2) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
rest) Point Double
r
      (MetaNodeType Double, MetaNodeType Double)
_ -> (Point Double, MetaJoin Double)
newnode forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double, MetaJoin Double)
node2forall a. a -> [a] -> [a]
:[(Point Double, MetaJoin Double)]
rest) Point Double
r
  | Bool
otherwise =
    case (MetaNodeType Double
m2, MetaNodeType Double
n1) of
      (Curl Double
g, MetaNodeType Double
Open) -> -- curl, open => curl, curl
        (Point Double, MetaJoin Double)
node1 forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin (forall a. a -> MetaNodeType a
Curl Double
g) Tension Double
sl Tension Double
sr MetaNodeType Double
n2)forall a. a -> [a] -> [a]
:[(Point Double, MetaJoin Double)]
rest) Point Double
r
      (MetaNodeType Double
Open, Curl Double
g) -> -- open, curl => curl, curl
        (Point Double
p, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin MetaNodeType Double
m1 Tension Double
tl Tension Double
tr (forall a. a -> MetaNodeType a
Curl Double
g)) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double, MetaJoin Double)
node2forall a. a -> [a] -> [a]
:[(Point Double, MetaJoin Double)]
rest) Point Double
r
      (Direction Point Double
dir, MetaNodeType Double
Open) ->   -- given, open => given, given
        (Point Double, MetaJoin Double)
node1 forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin (forall a. Point a -> MetaNodeType a
Direction Point Double
dir) Tension Double
sl Tension Double
sr MetaNodeType Double
n2) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
rest) Point Double
r
      (MetaNodeType Double
Open, Direction Point Double
dir) ->   -- open, given => given, given
        (Point Double
p, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin MetaNodeType Double
m1 Tension Double
tl Tension Double
tr (forall a. Point a -> MetaNodeType a
Direction Point Double
dir)) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double, MetaJoin Double)
node2forall a. a -> [a] -> [a]
:[(Point Double, MetaJoin Double)]
rest) Point Double
r
      (MetaNodeType Double, MetaNodeType Double)
_ -> (Point Double, MetaJoin Double)
node1 forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double, MetaJoin Double)
node2forall a. a -> [a] -> [a]
:[(Point Double, MetaJoin Double)]
rest) Point Double
r

sanitize ((Point Double
p, MetaJoin Double
m): (Point Double
q, MetaJoin Double
n): [(Point Double, MetaJoin Double)]
rest) Point Double
r =
  case (MetaJoin Double
m, MetaJoin Double
n) of
    (Controls Point Double
_u Point Double
v, MetaJoin MetaNodeType Double
Open Tension Double
t1 Tension Double
t2 MetaNodeType Double
mt2) -- explicit, open => explicit, given
      | Point Double
q forall a. Eq a => a -> a -> Bool
== Point Double
v    -> (Point Double
p, MetaJoin Double
m) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin (forall a. a -> MetaNodeType a
Curl Double
1) Tension Double
t1 Tension Double
t2 MetaNodeType Double
mt2)forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
rest) Point Double
r
      | Bool
otherwise -> (Point Double
p, MetaJoin Double
m) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin (forall a. Point a -> MetaNodeType a
Direction (Point Double
qforall v. AdditiveGroup v => v -> v -> v
^-^Point Double
v)) Tension Double
t1 Tension Double
t2 MetaNodeType Double
mt2)forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
rest) Point Double
r
    (MetaJoin MetaNodeType Double
mt1 Tension Double
tl Tension Double
tr MetaNodeType Double
Open, Controls Point Double
u Point Double
_v) -- open, explicit => given, explicit
      | Point Double
u forall a. Eq a => a -> a -> Bool
== Point Double
p    -> (Point Double
p, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin MetaNodeType Double
mt1 Tension Double
tl Tension Double
tr (forall a. a -> MetaNodeType a
Curl Double
1)) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, MetaJoin Double
n)forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
rest) Point Double
r 
      | Bool
otherwise -> (Point Double
p, forall a.
MetaNodeType a
-> Tension a -> Tension a -> MetaNodeType a -> MetaJoin a
MetaJoin MetaNodeType Double
mt1 Tension Double
tl Tension Double
tr (forall a. Point a -> MetaNodeType a
Direction (Point Double
uforall v. AdditiveGroup v => v -> v -> v
^-^Point Double
p))) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, MetaJoin Double
n)forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
rest) Point Double
r
    (MetaJoin Double, MetaJoin Double)
_ -> (Point Double
p, MetaJoin Double
m) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize ((Point Double
q, MetaJoin Double
n) forall a. a -> [a] -> [a]
: [(Point Double, MetaJoin Double)]
rest) Point Double
r

sanitize ((Point Double, MetaJoin Double)
n:[(Point Double, MetaJoin Double)]
l) Point Double
r = (Point Double, MetaJoin Double)
nforall a. a -> [a] -> [a]
:[(Point Double, MetaJoin Double)]
-> Point Double -> [(Point Double, MetaJoin Double)]
sanitize [(Point Double, MetaJoin Double)]
l Point Double
r

spanList :: ([a] -> Bool) -> [a] -> ([a], [a])
spanList :: forall a. ([a] -> Bool) -> [a] -> ([a], [a])
spanList [a] -> Bool
_ xs :: [a]
xs@[] =  ([a]
xs, [a]
xs)
spanList [a] -> Bool
p xs :: [a]
xs@(a
x:[a]
xs')
  | [a] -> Bool
p [a]
xs =  let ([a]
ys,[a]
zs) = forall a. ([a] -> Bool) -> [a] -> ([a], [a])
spanList [a] -> Bool
p [a]
xs' in (a
xforall a. a -> [a] -> [a]
:[a]
ys,[a]
zs)
  | Bool
otherwise    =  ([],[a]
xs)

-- break the subsegment if the angle to the left or the right is defined or a curl.
breakPoint :: [(DPoint, MetaJoin Double)] -> Bool
breakPoint :: [(Point Double, MetaJoin Double)] -> Bool
breakPoint ((Point Double
_,  MetaJoin MetaNodeType Double
_ Tension Double
_ Tension Double
_ MetaNodeType Double
Open):(Point Double
_, MetaJoin MetaNodeType Double
Open Tension Double
_ Tension Double
_ MetaNodeType Double
_):[(Point Double, MetaJoin Double)]
_) = Bool
False
breakPoint [(Point Double, MetaJoin Double)]
_ = Bool
True

-- solve the tridiagonal system for t[i]:
-- a[n] t[i-1] + b[n] t[i] + c[n] t[i+1] = d[i]
-- where a[0] = c[n] = 0
-- by first rewriting it into
-- the system t[i] + u[i] t[i+1] = v[i]
-- where u[n] = 0
-- then solving for t[n]
-- see metafont the program: ¶ 283
solveTriDiagonal2 :: [(Double, Double, Double, Double)] -> [Double]
solveTriDiagonal2 :: [(Double, Double, Double, Double)] -> [Double]
solveTriDiagonal2 [] = forall a. HasCallStack => String -> a
error String
"solveTriDiagonal: not enough equations"
solveTriDiagonal2 ((Double
_, Double
b0, Double
c0, Double
d0): [(Double, Double, Double, Double)]
rows) =
  forall a. Unbox a => Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ forall a.
(Unbox a, Fractional a) =>
(a, a, a) -> Vector (a, a, a, a) -> Vector a
solveTriDiagonal (Double
b0, Double
c0, Double
d0) (forall a. Unbox a => [a] -> Vector a
V.fromList [(Double, Double, Double, Double)]
rows)

-- test = ((80.0,58.0,51.0),[(-432.0,78.0,102.0,503.0),(71.0,-82.0,20.0,2130.0),(52.39,-10.43,4.0,56.0),(34.0,38.0,0.0,257.0)])
-- [-15.726940528143576,22.571642107784243,-78.93751365259996,-297.27313545829384,272.74438435742667]
      
-- solve the cyclic tridiagonal system.
-- see metafont the program: ¶ 286
solveCyclicTriD2 :: [(Double, Double, Double, Double)] -> [Double]
solveCyclicTriD2 :: [(Double, Double, Double, Double)] -> [Double]
solveCyclicTriD2 = forall a. Unbox a => Vector a -> [a]
V.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Unbox a, Fractional a) =>
Vector (a, a, a, a) -> Vector a
solveCyclicTriD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Unbox a => [a] -> Vector a
V.fromList

turnAngle :: DPoint -> DPoint -> Double
turnAngle :: Point Double -> Point Double -> Double
turnAngle (Point Double
0 Double
0) Point Double
_ = Double
0
turnAngle (Point Double
x Double
y) Point Double
q = forall a. RealFloat a => Point a -> a
vectorAngle forall a b. (a -> b) -> a -> b
$ forall a. Floating a => Point a -> Transform a
rotateVec Point Double
p forall a b. AffineTransform a b => Transform b -> a -> a
$* Point Double
q
  where p :: Point Double
p = forall a. a -> a -> Point a
Point Double
x (-Double
y)

zipNext :: [b] -> [(b, b)]
zipNext :: forall b. [b] -> [(b, b)]
zipNext [] = []
zipNext [b]
l = forall a b. [a] -> [b] -> [(a, b)]
zip [b]
l (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [b]
l)

-- find the equations for a cycle containing only open points
eqsCycle :: [Tension Double] -> [DPoint] -> [Tension Double]
         -> [Double] -> [(Double, Double, Double, Double)]
eqsCycle :: [Tension Double]
-> [Point Double]
-> [Tension Double]
-> [Double]
-> [(Double, Double, Double, Double)]
eqsCycle [Tension Double]
tensionsA [Point Double]
points [Tension Double]
tensionsB [Double]
turnAngles = 
  forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> (Double, Double, Double, Double)
eqTension
  (forall b. [b] -> [(b, b)]
zipNext (forall a b. (a -> b) -> [a] -> [b]
map forall a. Tension a -> a
tensionValue [Tension Double]
tensionsA))
  (forall b. [b] -> [(b, b)]
zipNext [Double]
dists)
  (forall b. [b] -> [(b, b)]
zipNext [Double]
turnAngles)
  (forall b. [b] -> [(b, b)]
zipNext (forall a b. (a -> b) -> [a] -> [b]
map forall a. Tension a -> a
tensionValue [Tension Double]
tensionsB))
  where 
    dists :: [Double]
dists = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Floating a => Point a -> Point a -> a
vectorDistance [Point Double]
points (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Point Double]
points)

-- find the equations for an path with open points.
-- The first and last node should be a curl or a given angle

eqsOpen :: [DPoint] -> [MetaJoin Double] -> [DPoint] -> [Double]
        -> [Double] -> [Double] -> [(Double, Double, Double, Double)]
eqsOpen :: [Point Double]
-> [MetaJoin Double]
-> [Point Double]
-> [Double]
-> [Double]
-> [Double]
-> [(Double, Double, Double, Double)]
eqsOpen [Point Double]
_ [MetaJoin MetaNodeType Double
mt1 Tension Double
t1 Tension Double
t2 MetaNodeType Double
mt2] [Point Double
delta] [Double]
_ [Double]
_ [Double]
_ =
  let replaceType :: MetaNodeType a -> MetaNodeType a
replaceType MetaNodeType a
Open = forall a. a -> MetaNodeType a
Curl a
1
      replaceType MetaNodeType a
t = MetaNodeType a
t
  in case (forall {a}. Num a => MetaNodeType a -> MetaNodeType a
replaceType MetaNodeType Double
mt1, forall {a}. Num a => MetaNodeType a -> MetaNodeType a
replaceType MetaNodeType Double
mt2) of
    (Curl Double
g, Direction Point Double
dir) ->
      [Double
-> Double -> Double -> Double -> (Double, Double, Double, Double)
eqCurl0 Double
g (forall a. Tension a -> a
tensionValue Tension Double
t1) (forall a. Tension a -> a
tensionValue Tension Double
t2) Double
0,
       (Double
0, Double
1, Double
0, Point Double -> Point Double -> Double
turnAngle Point Double
delta Point Double
dir)]
    (Direction Point Double
dir, Curl Double
g) ->
      [(Double
0, Double
1, Double
0, Point Double -> Point Double -> Double
turnAngle Point Double
delta Point Double
dir),
       Double -> Double -> Double -> (Double, Double, Double, Double)
eqCurlN Double
g (forall a. Tension a -> a
tensionValue Tension Double
t1) (forall a. Tension a -> a
tensionValue Tension Double
t2)]
    (Direction Point Double
dir, Direction Point Double
dir2) ->
      [(Double
0, Double
1, Double
0, Point Double -> Point Double -> Double
turnAngle Point Double
delta Point Double
dir),
       (Double
0, Double
1, Double
0, Point Double -> Point Double -> Double
turnAngle Point Double
delta Point Double
dir2)]
    (Curl Double
_, Curl Double
_) ->
      [(Double
0, Double
1, Double
0, Double
0), (Double
0, Double
1, Double
0, Double
0)]
    (MetaNodeType Double, MetaNodeType Double)
_ -> forall a. HasCallStack => String -> a
error String
"illegal end of open path"

eqsOpen [Point Double]
points [MetaJoin Double]
joins [Point Double]
chords [Double]
turnAngles [Double]
tensionsA [Double]
tensionsB =
  (Double, Double, Double, Double)
eq0 forall a. a -> [a] -> [a]
: [MetaJoin Double]
-> [Double]
-> [Double]
-> [Double]
-> [Double]
-> [(Double, Double, Double, Double)]
restEquations [MetaJoin Double]
joins [Double]
tensionsA [Double]
dists [Double]
turnAngles [Double]
tensionsB
  where
    dists :: [Double]
dists = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Floating a => Point a -> Point a -> a
vectorDistance [Point Double]
points (forall a. [a] -> [a]
tail [Point Double]
points)      
    eq0 :: (Double, Double, Double, Double)
eq0 = case forall a. [a] -> a
head [MetaJoin Double]
joins of
      (MetaJoin (Curl Double
g) Tension Double
_ Tension Double
_ MetaNodeType Double
_) -> Double
-> Double -> Double -> Double -> (Double, Double, Double, Double)
eqCurl0 Double
g (forall a. [a] -> a
head [Double]
tensionsA) (forall a. [a] -> a
head [Double]
tensionsB) (forall a. [a] -> a
head [Double]
turnAngles)
      (MetaJoin (Direction Point Double
dir) Tension Double
_ Tension Double
_ MetaNodeType Double
_) -> (Double
0, Double
1, Double
0, Point Double -> Point Double -> Double
turnAngle (forall a. [a] -> a
head [Point Double]
chords) Point Double
dir)
      (MetaJoin MetaNodeType Double
Open Tension Double
_ Tension Double
_ MetaNodeType Double
_) -> Double
-> Double -> Double -> Double -> (Double, Double, Double, Double)
eqCurl0 Double
1 (forall a. [a] -> a
head [Double]
tensionsA) (forall a. [a] -> a
head [Double]
tensionsB) (forall a. [a] -> a
head [Double]
turnAngles)
      (Controls Point Double
_ Point Double
_) -> forall a. HasCallStack => String -> a
error String
"eqsOpen: illegal join"

    restEquations :: [MetaJoin Double]
-> [Double]
-> [Double]
-> [Double]
-> [Double]
-> [(Double, Double, Double, Double)]
restEquations [MetaJoin Double
lastnode] (Double
tensionA:[Double]
_) [Double]
_ [Double]
_ (Double
tensionB:[Double]
_) =
      case MetaJoin Double
lastnode of
        MetaJoin MetaNodeType Double
_ Tension Double
_ Tension Double
_ (Curl Double
g) -> [Double -> Double -> Double -> (Double, Double, Double, Double)
eqCurlN Double
g Double
tensionA Double
tensionB]
        MetaJoin MetaNodeType Double
_ Tension Double
_ Tension Double
_ MetaNodeType Double
Open -> [Double -> Double -> Double -> (Double, Double, Double, Double)
eqCurlN Double
1 Double
tensionA Double
tensionB]
        MetaJoin MetaNodeType Double
_ Tension Double
_ Tension Double
_ (Direction Point Double
dir) -> [(Double
0, Double
1, Double
0, Point Double -> Point Double -> Double
turnAngle (forall a. [a] -> a
last [Point Double]
chords) Point Double
dir)]
        (Controls Point Double
_ Point Double
_) -> forall a. HasCallStack => String -> a
error String
"eqsOpen: illegal join"

    restEquations (MetaJoin Double
_:[MetaJoin Double]
othernodes) (Double
tensionA:[Double]
restTA) (Double
d:[Double]
restD) (Double
turn:[Double]
restTurn) (Double
tensionB:[Double]
restTB) =
      (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> (Double, Double, Double, Double)
eqTension (Double
tensionA, forall a. [a] -> a
head [Double]
restTA) (Double
d, forall a. [a] -> a
head [Double]
restD) (Double
turn, forall a. [a] -> a
head [Double]
restTurn) (Double
tensionB, forall a. [a] -> a
head [Double]
restTB) forall a. a -> [a] -> [a]
:
      [MetaJoin Double]
-> [Double]
-> [Double]
-> [Double]
-> [Double]
-> [(Double, Double, Double, Double)]
restEquations [MetaJoin Double]
othernodes [Double]
restTA [Double]
restD [Double]
restTurn [Double]
restTB

    restEquations [MetaJoin Double]
_ [Double]
_ [Double]
_ [Double]
_ [Double]
_ = forall a. HasCallStack => String -> a
error String
"eqsOpen: illegal rest equations"

-- the equation for an open node
eqTension :: (Double, Double) -> (Double, Double)
          -> (Double, Double) -> (Double, Double)
          -> (Double, Double, Double, Double)
eqTension :: (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> (Double, Double, Double, Double)
eqTension (Double
tensionA', Double
tensionA) (Double
dist', Double
dist) (Double
psi', Double
psi) (Double
tensionB', Double
tensionB) =
  (Double
a, Double
bforall a. Num a => a -> a -> a
+Double
c, Double
d, -Double
bforall a. Num a => a -> a -> a
*Double
psi' forall a. Num a => a -> a -> a
- Double
dforall a. Num a => a -> a -> a
*Double
psi)
  where
    a :: Double
a = Double
tensionB' forall a. Num a => a -> a -> a
* Double
tensionB' forall a. Fractional a => a -> a -> a
/ (Double
tensionA' forall a. Num a => a -> a -> a
* Double
dist')
    b :: Double
b = (Double
3 forall a. Num a => a -> a -> a
- Double
1forall a. Fractional a => a -> a -> a
/Double
tensionA') forall a. Num a => a -> a -> a
* Double
tensionB' forall a. Num a => a -> a -> a
* Double
tensionB' forall a. Fractional a => a -> a -> a
/ Double
dist'
    c :: Double
c = (Double
3 forall a. Num a => a -> a -> a
- Double
1forall a. Fractional a => a -> a -> a
/Double
tensionB) forall a. Num a => a -> a -> a
* Double
tensionA forall a. Num a => a -> a -> a
* Double
tensionA forall a. Fractional a => a -> a -> a
/ Double
dist
    d :: Double
d = Double
tensionA forall a. Num a => a -> a -> a
* Double
tensionA forall a. Fractional a => a -> a -> a
/ (Double
tensionB forall a. Num a => a -> a -> a
* Double
dist)

-- the equation for a starting curl
eqCurl0 :: Double -> Double -> Double -> Double
        -> (Double, Double, Double, Double)
eqCurl0 :: Double
-> Double -> Double -> Double -> (Double, Double, Double, Double)
eqCurl0 Double
gamma Double
tensionA Double
tensionB Double
psi = (Double
0, Double
c, Double
d, Double
r)
  where
    c :: Double
c = Double
chiforall a. Fractional a => a -> a -> a
/Double
tensionA forall a. Num a => a -> a -> a
+ Double
3 forall a. Num a => a -> a -> a
- Double
1forall a. Fractional a => a -> a -> a
/Double
tensionB
    d :: Double
d = (Double
3 forall a. Num a => a -> a -> a
- Double
1forall a. Fractional a => a -> a -> a
/Double
tensionA)forall a. Num a => a -> a -> a
*Double
chi forall a. Num a => a -> a -> a
+ Double
1forall a. Fractional a => a -> a -> a
/Double
tensionB
    chi :: Double
chi = Double
gammaforall a. Num a => a -> a -> a
*Double
tensionBforall a. Num a => a -> a -> a
*Double
tensionB forall a. Fractional a => a -> a -> a
/ (Double
tensionAforall a. Num a => a -> a -> a
*Double
tensionA)
    r :: Double
r = -Double
dforall a. Num a => a -> a -> a
*Double
psi

-- the equation for an ending curl
eqCurlN :: Double -> Double -> Double
        -> (Double, Double, Double, Double)
eqCurlN :: Double -> Double -> Double -> (Double, Double, Double, Double)
eqCurlN Double
gamma Double
tensionA Double
tensionB = (Double
a, Double
b, Double
0, Double
0)
  where
    a :: Double
a = (Double
3 forall a. Num a => a -> a -> a
- Double
1forall a. Fractional a => a -> a -> a
/Double
tensionB)forall a. Num a => a -> a -> a
*Double
chi forall a. Num a => a -> a -> a
+ Double
1forall a. Fractional a => a -> a -> a
/Double
tensionA
    b :: Double
b = Double
chiforall a. Fractional a => a -> a -> a
/Double
tensionB forall a. Num a => a -> a -> a
+ Double
3 forall a. Num a => a -> a -> a
- Double
1forall a. Fractional a => a -> a -> a
/Double
tensionA
    chi :: Double
chi = Double
gammaforall a. Num a => a -> a -> a
*Double
tensionAforall a. Num a => a -> a -> a
*Double
tensionA forall a. Fractional a => a -> a -> a
/ (Double
tensionBforall a. Num a => a -> a -> a
*Double
tensionB)

-- getting the control points
unmetaJoin :: DPoint -> DPoint -> Double -> Double -> Tension Double
           -> Tension Double -> PathJoin Double
unmetaJoin :: Point Double
-> Point Double
-> Double
-> Double
-> Tension Double
-> Tension Double
-> PathJoin Double
unmetaJoin !Point Double
z0 !Point Double
z1 !Double
theta !Double
phi !Tension Double
alpha !Tension Double
beta
  | forall a. Num a => a -> a
abs Double
phi forall a. Ord a => a -> a -> Bool
< Double
1e-4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs Double
theta forall a. Ord a => a -> a -> Bool
< Double
1e-4 = forall a. PathJoin a
JoinLine
  | Bool
otherwise = forall a. Point a -> Point a -> PathJoin a
JoinCurve Point Double
u Point Double
v
  where Point Double
dx Double
dy = Point Double
z1forall v. AdditiveGroup v => v -> v -> v
^-^Point Double
z0
        bounded :: Bool
bounded = (Double
sf forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
&& Double
st forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
&& Double
sf forall a. Ord a => a -> a -> Bool
<= Double
0) Bool -> Bool -> Bool
||
                  (Double
sf forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
st forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
sf forall a. Ord a => a -> a -> Bool
>= Double
0)
        rr' :: Double
rr' = Double -> Double -> Double -> Double -> Tension Double -> Double
velocity Double
st Double
sf Double
ct Double
cf Tension Double
alpha
        ss' :: Double
ss' = Double -> Double -> Double -> Double -> Tension Double -> Double
velocity Double
sf Double
st Double
cf Double
ct Tension Double
beta
        stf :: Double
stf = Double
stforall a. Num a => a -> a -> a
*Double
cf forall a. Num a => a -> a -> a
+ Double
sfforall a. Num a => a -> a -> a
*Double
ct -- sin (theta + phi)
        st :: Double
st = forall a. Floating a => a -> a
sin Double
theta
        sf :: Double
sf = forall a. Floating a => a -> a
sin Double
phi
        ct :: Double
ct = forall a. Floating a => a -> a
cos Double
theta
        cf :: Double
cf = forall a. Floating a => a -> a
cos Double
phi
        rr :: Double
rr = case Tension Double
alpha of
          TensionAtLeast Double
_ | Bool
bounded ->
            forall a. Ord a => a -> a -> a
min Double
rr' (Double
sfforall a. Fractional a => a -> a -> a
/Double
stf)
          Tension Double
_ -> Double
rr'
        ss :: Double
ss = case Tension Double
beta of
          TensionAtLeast Double
_ | Bool
bounded ->
            forall a. Ord a => a -> a -> a
min Double
ss' (Double
stforall a. Fractional a => a -> a -> a
/Double
stf)
          Tension Double
_ -> Double
ss'
        -- u = z0 + rr * (rotate theta chord)
        u :: Point Double
u = Point Double
z0 forall v. AdditiveGroup v => v -> v -> v
^+^ Double
rr forall v. VectorSpace v => Scalar v -> v -> v
*^ forall a. a -> a -> Point a
Point (Double
dxforall a. Num a => a -> a -> a
*Double
ct forall a. Num a => a -> a -> a
- Double
dyforall a. Num a => a -> a -> a
*Double
st) (Double
dyforall a. Num a => a -> a -> a
*Double
ct forall a. Num a => a -> a -> a
+ Double
dxforall a. Num a => a -> a -> a
*Double
st)
        -- v = z1 - ss * (rotate (-phi) chord)
        v :: Point Double
v = Point Double
z1 forall v. AdditiveGroup v => v -> v -> v
^-^ Double
ss forall v. VectorSpace v => Scalar v -> v -> v
*^ forall a. a -> a -> Point a
Point (Double
dxforall a. Num a => a -> a -> a
*Double
cf forall a. Num a => a -> a -> a
+ Double
dyforall a. Num a => a -> a -> a
*Double
sf) (Double
dyforall a. Num a => a -> a -> a
*Double
cf forall a. Num a => a -> a -> a
- Double
dxforall a. Num a => a -> a -> a
*Double
sf)

constant1, constant2, sqrt2 :: Double
constant1 :: Double
constant1 = Double
3forall a. Num a => a -> a -> a
*(forall a. Floating a => a -> a
sqrt Double
5 forall a. Num a => a -> a -> a
- Double
1)forall a. Fractional a => a -> a -> a
/Double
2
constant2 :: Double
constant2 = Double
3forall a. Num a => a -> a -> a
*(Double
3 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
sqrt Double
5)forall a. Fractional a => a -> a -> a
/Double
2
sqrt2 :: Double
sqrt2 = forall a. Floating a => a -> a
sqrt Double
2

-- another magic formula by John Hobby.
velocity :: Double -> Double -> Double
         -> Double -> Tension Double -> Double
velocity :: Double -> Double -> Double -> Double -> Tension Double -> Double
velocity Double
st Double
sf Double
ct Double
cf Tension Double
t =
  forall a. Ord a => a -> a -> a
min Double
4 forall a b. (a -> b) -> a -> b
$ 
  (Double
2 forall a. Num a => a -> a -> a
+ Double
sqrt2 forall a. Num a => a -> a -> a
* (Double
st forall a. Num a => a -> a -> a
- Double
sfforall a. Fractional a => a -> a -> a
/Double
16)forall a. Num a => a -> a -> a
*(Double
sf forall a. Num a => a -> a -> a
- Double
stforall a. Fractional a => a -> a -> a
/Double
16)forall a. Num a => a -> a -> a
*(Double
ct forall a. Num a => a -> a -> a
- Double
cf)) forall a. Fractional a => a -> a -> a
/
  ((Double
3 forall a. Num a => a -> a -> a
+ Double
constant1forall a. Num a => a -> a -> a
*Double
ct forall a. Num a => a -> a -> a
+ Double
constant2forall a. Num a => a -> a -> a
*Double
cf) forall a. Num a => a -> a -> a
* forall a. Tension a -> a
tensionValue Tension Double
t)