{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, MultiParamTypeClasses, DeriveTraversable, ViewPatterns, PatternSynonyms, MultiWayIf #-}
module Geom2D.CubicBezier.Basic
       (CubicBezier (..), QuadBezier (..), AnyBezier (..), GenericBezier(..),
        PathJoin (..), ClosedPath(..), OpenPath (..), AffineTransform (..), anyToCubic, anyToQuad,
        openPathCurves, closedPathCurves, curvesToOpen, curvesToClosed,
        consOpenPath, consClosedPath, openClosedPath, closeOpenPath, 
        bezierParam, bezierParamTolerance, reorient, bezierToBernstein,
        evalBezierDerivs, evalBezier, evalBezierDeriv, findBezierTangent, quadToCubic,
        bezierHoriz, bezierVert, findBezierInflection, findBezierCusp,
        bezierArc, arcLength, arcLengthParam, splitBezier, bezierSubsegment,
        splitBezierN, colinear, closest, findX)
       where
import Geom2D
import Geom2D.CubicBezier.Numeric
import Math.BernsteinPoly
import Numeric.Integration.TanhSinh
import Data.Monoid ()
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.List (minimumBy)
import Data.Function (on)
import Data.VectorSpace
import Debug.Trace

import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Unboxed.Mutable as MV

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

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

-- Use a tuple, because it has 0(1) unzip when using unboxed vectors.
-- | A bezier curve of any degree.
data AnyBezier a = AnyBezier (V.Vector (a, a))
                   
class GenericBezier b where
  degree :: (V.Unbox a) => b a -> Int
  toVector :: (V.Unbox a) => b a -> V.Vector (a, a)
  unsafeFromVector :: (V.Unbox a) => V.Vector (a, a) -> b a

instance GenericBezier CubicBezier where
  degree :: forall a. Unbox a => CubicBezier a -> Int
degree CubicBezier a
_ = Int
3
  toVector :: forall a. Unbox a => CubicBezier a -> Vector (a, a)
toVector (CubicBezier (Point a
ax a
ay) (Point a
bx a
by)
            (Point a
cx a
cy) (Point a
dx a
dy)) =
    forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
V.create forall a b. (a -> b) -> a -> b
$ do
      MVector s (a, a)
v <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MV.new Int
4
      forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s (a, a)
v Int
0 (a
ax, a
ay)
      forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s (a, a)
v Int
1 (a
bx, a
by)
      forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s (a, a)
v Int
2 (a
cx, a
cy)
      forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s (a, a)
v Int
3 (a
dx, a
dy)
      forall (m :: * -> *) a. Monad m => a -> m a
return MVector s (a, a)
v
  unsafeFromVector :: forall a. Unbox a => Vector (a, a) -> CubicBezier a
unsafeFromVector Vector (a, a)
v = forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier
                       (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point forall a b. (a -> b) -> a -> b
$ Vector (a, a)
v forall a. Unbox a => Vector a -> Int -> a
`V.unsafeIndex` Int
0)
                       (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point forall a b. (a -> b) -> a -> b
$ Vector (a, a)
v forall a. Unbox a => Vector a -> Int -> a
`V.unsafeIndex` Int
1)
                       (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point forall a b. (a -> b) -> a -> b
$ Vector (a, a)
v forall a. Unbox a => Vector a -> Int -> a
`V.unsafeIndex` Int
2)
                       (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point forall a b. (a -> b) -> a -> b
$ Vector (a, a)
v forall a. Unbox a => Vector a -> Int -> a
`V.unsafeIndex` Int
3)

instance GenericBezier QuadBezier where
  degree :: forall a. Unbox a => QuadBezier a -> Int
degree QuadBezier a
_ = Int
2
  toVector :: forall a. Unbox a => QuadBezier a -> Vector (a, a)
toVector (QuadBezier (Point a
ax a
ay) (Point a
bx a
by)
            (Point a
cx a
cy)) =
    forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
V.create forall a b. (a -> b) -> a -> b
$ do
      MVector s (a, a)
v <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MV.new Int
3
      forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s (a, a)
v Int
0 (a
ax, a
ay)
      forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s (a, a)
v Int
1 (a
bx, a
by)
      forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s (a, a)
v Int
2 (a
cx, a
cy)
      forall (m :: * -> *) a. Monad m => a -> m a
return MVector s (a, a)
v
  unsafeFromVector :: forall a. Unbox a => Vector (a, a) -> QuadBezier a
unsafeFromVector Vector (a, a)
v = forall a. Point a -> Point a -> Point a -> QuadBezier a
QuadBezier
                       (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point forall a b. (a -> b) -> a -> b
$ Vector (a, a)
v forall a. Unbox a => Vector a -> Int -> a
`V.unsafeIndex` Int
0)
                       (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point forall a b. (a -> b) -> a -> b
$ Vector (a, a)
v forall a. Unbox a => Vector a -> Int -> a
`V.unsafeIndex` Int
1)
                       (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point forall a b. (a -> b) -> a -> b
$ Vector (a, a)
v forall a. Unbox a => Vector a -> Int -> a
`V.unsafeIndex` Int
2)

instance GenericBezier AnyBezier where
  degree :: forall a. Unbox a => AnyBezier a -> Int
degree (AnyBezier Vector (a, a)
b) = forall a. Unbox a => Vector a -> Int
V.length Vector (a, a)
b
  toVector :: forall a. Unbox a => AnyBezier a -> Vector (a, a)
toVector (AnyBezier Vector (a, a)
v) = Vector (a, a)
v
  unsafeFromVector :: forall a. Unbox a => Vector (a, a) -> AnyBezier a
unsafeFromVector = forall a. Vector (a, a) -> AnyBezier a
AnyBezier

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

instance Semigroup (OpenPath a) where
  OpenPath a
p1 <> :: OpenPath a -> OpenPath a -> OpenPath a
<> OpenPath [] Point a
_ = OpenPath a
p1
  OpenPath [] Point a
_ <> OpenPath a
p2 = OpenPath a
p2
  OpenPath [(Point a, PathJoin a)]
joins1 Point a
_ <> OpenPath [(Point a, PathJoin a)]
joins2 Point a
p =
    forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath ([(Point a, PathJoin a)]
joins1 forall a. [a] -> [a] -> [a]
++ [(Point a, PathJoin a)]
joins2) Point a
p

instance Monoid (OpenPath a) where
  mempty :: OpenPath a
mempty = forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [] (forall a. HasCallStack => String -> a
error String
"empty path")
#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

instance (Num a) => AffineTransform (PathJoin a) a where
  transform :: Transform a -> PathJoin a -> PathJoin a
transform Transform a
_ PathJoin a
JoinLine = forall a. PathJoin a
JoinLine
  transform Transform a
t (JoinCurve Point a
p Point a
q) = forall a. Point a -> Point a -> PathJoin a
JoinCurve (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
p) (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
q)

instance (Num a) => AffineTransform (OpenPath a) a where
  transform :: Transform a -> OpenPath a -> OpenPath a
transform Transform a
t (OpenPath [(Point a, PathJoin a)]
s Point a
p) = forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath (forall a b. (a -> b) -> [a] -> [b]
map (forall a.
Num a =>
Transform a -> (Point a, PathJoin a) -> (Point a, PathJoin a)
transformSeg Transform a
t) [(Point a, PathJoin a)]
s) (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
p)

transformSeg :: (Num a) => Transform a -> (Point a, PathJoin a) -> (Point a, PathJoin a)
transformSeg :: forall a.
Num a =>
Transform a -> (Point a, PathJoin a) -> (Point a, PathJoin a)
transformSeg Transform a
t (Point a
p, PathJoin a
jn) = (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
p, forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t PathJoin a
jn)

instance (Num a) => AffineTransform (ClosedPath a) a where
  transform :: Transform a -> ClosedPath a -> ClosedPath a
transform Transform a
t (ClosedPath [(Point a, PathJoin a)]
s) = forall a. [(Point a, PathJoin a)] -> ClosedPath a
ClosedPath (forall a b. (a -> b) -> [a] -> [b]
map (forall a.
Num a =>
Transform a -> (Point a, PathJoin a) -> (Point a, PathJoin a)
transformSeg Transform a
t) [(Point a, PathJoin a)]
s)

instance (Num a) => AffineTransform (CubicBezier a) a where
  {-# SPECIALIZE transform :: Transform Double -> CubicBezier Double -> CubicBezier Double #-}
  transform :: Transform a -> CubicBezier a -> CubicBezier a
transform Transform a
t (CubicBezier Point a
c0 Point a
c1 Point a
c2 Point a
c3) =
    forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
c0) (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
c1) (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
c2) (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
c3)

instance (Num a) => AffineTransform (QuadBezier a) a where
  {-# SPECIALIZE transform :: Transform Double -> QuadBezier Double -> QuadBezier Double #-}
  transform :: Transform a -> QuadBezier a -> QuadBezier a
transform Transform a
t (QuadBezier Point a
c0 Point a
c1 Point a
c2) =
    forall a. Point a -> Point a -> Point a -> QuadBezier a
QuadBezier (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
c0) (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
c1) (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Point a
c2)

-- | construct an open path
consOpenPath :: Point a -> PathJoin a -> OpenPath a -> OpenPath a
consOpenPath :: forall a. Point a -> PathJoin a -> OpenPath a -> OpenPath a
consOpenPath Point a
p PathJoin a
join (OpenPath [(Point a, PathJoin a)]
joins Point a
q) =
  forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath ((Point a
p, PathJoin a
join)forall a. a -> [a] -> [a]
:[(Point a, PathJoin a)]
joins) Point a
q

-- | construct a closed path
consClosedPath :: Point a -> PathJoin a -> ClosedPath a -> ClosedPath a
consClosedPath :: forall a. Point a -> PathJoin a -> ClosedPath a -> ClosedPath a
consClosedPath Point a
p PathJoin a
join (ClosedPath [(Point a, PathJoin a)]
joins) =
  forall a. [(Point a, PathJoin a)] -> ClosedPath a
ClosedPath ((Point a
p, PathJoin a
join)forall a. a -> [a] -> [a]
:[(Point a, PathJoin a)]
joins)

-- | Return the open path as a list of curves.
openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
openPathCurves :: forall a. Fractional a => OpenPath a -> [CubicBezier a]
openPathCurves (OpenPath [(Point a, PathJoin a)]
curves Point a
p) = forall {a}.
Fractional a =>
[(Point a, PathJoin a)] -> Point a -> [CubicBezier a]
go [(Point a, PathJoin a)]
curves Point a
p
  where
    go :: [(Point a, PathJoin a)] -> Point a -> [CubicBezier a]
go [] Point a
_ = []
    go [(Point a
p0, PathJoin a
jn)] Point a
q = [forall {a}.
Fractional a =>
Point a -> PathJoin a -> Point a -> CubicBezier a
makeCB Point a
p0 PathJoin a
jn Point a
q]
    go ((Point a
p0, PathJoin a
jn):rest :: [(Point a, PathJoin a)]
rest@((Point a
p1,PathJoin a
_):[(Point a, PathJoin a)]
_)) Point a
q =
      forall {a}.
Fractional a =>
Point a -> PathJoin a -> Point a -> CubicBezier a
makeCB Point a
p0 PathJoin a
jn Point a
p1 forall a. a -> [a] -> [a]
: [(Point a, PathJoin a)] -> Point a -> [CubicBezier a]
go [(Point a, PathJoin a)]
rest Point a
q
    makeCB :: Point a -> PathJoin a -> Point a -> CubicBezier a
makeCB Point a
p0 PathJoin a
JoinLine Point a
p1 =
      forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point a
p0 (forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
p0 Point a
p1 (a
1forall a. Fractional a => a -> a -> a
/a
3))
      (forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
p0 Point a
p1 (a
2forall a. Fractional a => a -> a -> a
/a
3)) Point a
p1
    makeCB Point a
p0 (JoinCurve Point a
p1 Point a
p2) Point a
p3 =
      forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point a
p0 Point a
p1 Point a
p2 Point a
p3

-- | Return the closed path as a list of curves
closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
closedPathCurves :: forall a. Fractional a => ClosedPath a -> [CubicBezier a]
closedPathCurves (ClosedPath []) = []
closedPathCurves (ClosedPath (cs :: [(Point a, PathJoin a)]
cs@((Point a
p1, PathJoin a
_):[(Point a, PathJoin a)]
_))) =
  forall a. Fractional a => OpenPath a -> [CubicBezier a]
openPathCurves (forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [(Point a, PathJoin a)]
cs Point a
p1)

-- | Make an open path from a list of curves.  The last control point
-- of each curve except the last is ignored.
curvesToOpen :: [CubicBezier a] -> OpenPath a
curvesToOpen :: forall a. [CubicBezier a] -> OpenPath a
curvesToOpen [] = forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [] forall a. HasCallStack => a
undefined
curvesToOpen [CubicBezier Point a
p0 Point a
p1 Point a
p2 Point a
p3] =
  forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [(Point a
p0, forall a. Point a -> Point a -> PathJoin a
JoinCurve Point a
p1 Point a
p2)] Point a
p3
curvesToOpen (CubicBezier Point a
p0 Point a
p1 Point a
p2 Point a
_:[CubicBezier a]
cs) =
  forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath ((Point a
p0, forall a. Point a -> Point a -> PathJoin a
JoinCurve Point a
p1 Point a
p2)forall a. a -> [a] -> [a]
:[(Point a, PathJoin a)]
rest) Point a
lastP
  where
    OpenPath [(Point a, PathJoin a)]
rest Point a
lastP = forall a. [CubicBezier a] -> OpenPath a
curvesToOpen [CubicBezier a]
cs

-- | Make an open path from a list of curves.  The last control point
-- of each curve is ignored.
curvesToClosed :: [CubicBezier a] -> ClosedPath a
curvesToClosed :: forall a. [CubicBezier a] -> ClosedPath a
curvesToClosed [CubicBezier a]
cs = forall a. [(Point a, PathJoin a)] -> ClosedPath a
ClosedPath [(Point a, PathJoin a)]
cs2
  where
    OpenPath [(Point a, PathJoin a)]
cs2 Point a
_ = forall a. [CubicBezier a] -> OpenPath a
curvesToOpen [CubicBezier a]
cs

-- | close an open path, discarding the last point
closeOpenPath :: OpenPath a -> ClosedPath a
closeOpenPath :: forall a. OpenPath a -> ClosedPath a
closeOpenPath (OpenPath [(Point a, PathJoin a)]
j Point a
p) = forall a. [(Point a, PathJoin a)] -> ClosedPath a
ClosedPath [(Point a, PathJoin a)]
j

-- | open a closed path
openClosedPath :: ClosedPath a -> OpenPath a
openClosedPath :: forall a. ClosedPath a -> OpenPath a
openClosedPath (ClosedPath []) = forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [] (forall a. HasCallStack => String -> a
error String
"empty path")
openClosedPath (ClosedPath j :: [(Point a, PathJoin a)]
j@((Point a
p,PathJoin a
_):[(Point a, PathJoin a)]
_)) = forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [(Point a, PathJoin a)]
j Point a
p



-- | safely convert from `AnyBezier' to `CubicBezier`
anyToCubic :: (V.Unbox a) => AnyBezier a -> Maybe (CubicBezier a)
anyToCubic :: forall a. Unbox a => AnyBezier a -> Maybe (CubicBezier a)
anyToCubic b :: AnyBezier a
b@(AnyBezier Vector (a, a)
v)
  | forall (b :: * -> *) a. (GenericBezier b, Unbox a) => b a -> Int
degree AnyBezier a
b forall a. Eq a => a -> a -> Bool
== Int
3 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
Vector (a, a) -> b a
unsafeFromVector Vector (a, a)
v
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | safely convert from `AnyBezier' to `QuadBezier`
anyToQuad :: (V.Unbox a) => AnyBezier a -> Maybe (QuadBezier a)
anyToQuad :: forall a. Unbox a => AnyBezier a -> Maybe (QuadBezier a)
anyToQuad b :: AnyBezier a
b@(AnyBezier Vector (a, a)
v)
  | forall (b :: * -> *) a. (GenericBezier b, Unbox a) => b a -> Int
degree AnyBezier a
b forall a. Eq a => a -> a -> Bool
== Int
2 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
Vector (a, a) -> b a
unsafeFromVector Vector (a, a)
v
  | Bool
otherwise = forall a. Maybe a
Nothing

evalBezierDerivsCubic :: Num a =>
                         CubicBezier a -> a -> [Point a]
evalBezierDerivsCubic :: forall a. Num a => CubicBezier a -> a -> [Point a]
evalBezierDerivsCubic (CubicBezier Point a
a Point a
b Point a
c Point a
d) a
t =
  Point a
p seq :: forall a b. a -> b -> b
`seq` Point a
p' seq :: forall a b. a -> b -> b
`seq` Point a
p'' seq :: forall a b. a -> b -> b
`seq` Point a
p''' seq :: forall a b. a -> b -> b
`seq`
  [Point a
p, Point a
p', Point a
p'', Point a
p''', forall a. a -> a -> Point a
Point a
0 a
0]
  where
    u :: a
u = a
1forall a. Num a => a -> a -> a
-a
t
    t2 :: a
t2 = a
tforall a. Num a => a -> a -> a
*a
t
    t3 :: a
t3 = a
t2forall a. Num a => a -> a -> a
*a
t
    da :: Point a
da = a
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
bforall v. AdditiveGroup v => v -> v -> v
^-^Point a
a)
    db :: Point a
db = a
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
cforall v. AdditiveGroup v => v -> v -> v
^-^Point a
b)
    dc :: Point a
dc = a
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
dforall v. AdditiveGroup v => v -> v -> v
^-^Point a
c)
    p :: Point a
p = a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point a
a forall v. AdditiveGroup v => v -> v -> v
^+^ (a
3forall a. Num a => a -> a -> a
*a
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
b) forall v. AdditiveGroup v => v -> v -> v
^+^ (a
3forall a. Num a => a -> a -> a
*a
t2)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
c) forall v. AdditiveGroup v => v -> v -> v
^+^ a
t3forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
d
    p' :: Point a
p' = a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point a
da forall v. AdditiveGroup v => v -> v -> v
^+^ (a
2forall a. Num a => a -> a -> a
*a
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
db) forall v. AdditiveGroup v => v -> v -> v
^+^ a
t2forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
dc
    p'' :: Point a
p'' = (a
2forall a. Num a => a -> a -> a
*a
u)forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
dbforall v. AdditiveGroup v => v -> v -> v
^-^Point a
da) forall v. AdditiveGroup v => v -> v -> v
^+^ (a
2forall a. Num a => a -> a -> a
*a
t)forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
dcforall v. AdditiveGroup v => v -> v -> v
^-^Point a
db)
    p''' :: Point a
p''' = a
2forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
dcforall v. AdditiveGroup v => v -> v -> v
^-^a
2forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
dbforall v. AdditiveGroup v => v -> v -> v
^+^Point a
da)
{-# SPECIALIZE evalBezierDerivsCubic :: CubicBezier Double -> Double -> [DPoint] #-}    

evalBezierDerivCubic :: Num a =>
                         CubicBezier a -> a -> (Point a, Point a)
evalBezierDerivCubic :: forall a. Num a => CubicBezier a -> a -> (Point a, Point a)
evalBezierDerivCubic (CubicBezier Point a
a Point a
b Point a
c Point a
d) a
t = Point a
p seq :: forall a b. a -> b -> b
`seq` Point a
p' seq :: forall a b. a -> b -> b
`seq` (Point a
p, Point a
p')
  where
    u :: a
u = a
1forall a. Num a => a -> a -> a
-a
t
    t2 :: a
t2 = a
tforall a. Num a => a -> a -> a
*a
t
    t3 :: a
t3 = a
t2forall a. Num a => a -> a -> a
*a
t
    da :: Point a
da = a
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
bforall v. AdditiveGroup v => v -> v -> v
^-^Point a
a)
    db :: Point a
db = a
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
cforall v. AdditiveGroup v => v -> v -> v
^-^Point a
b)
    dc :: Point a
dc = a
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
dforall v. AdditiveGroup v => v -> v -> v
^-^Point a
c)
    p :: Point a
p = a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point a
a forall v. AdditiveGroup v => v -> v -> v
^+^ (a
3forall a. Num a => a -> a -> a
*a
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
b) forall v. AdditiveGroup v => v -> v -> v
^+^ (a
3forall a. Num a => a -> a -> a
*a
t2)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
c) forall v. AdditiveGroup v => v -> v -> v
^+^ a
t3forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
d
    p' :: Point a
p' = a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point a
da forall v. AdditiveGroup v => v -> v -> v
^+^ (a
2forall a. Num a => a -> a -> a
*a
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
db) forall v. AdditiveGroup v => v -> v -> v
^+^ a
t2forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
dc
{-# SPECIALIZE evalBezierDerivCubic :: CubicBezier Double -> Double -> (DPoint, DPoint) #-}    

evalBezierDerivsQuad :: Num a =>
                        QuadBezier a -> a -> [Point a]
evalBezierDerivsQuad :: forall a. Num a => QuadBezier a -> a -> [Point a]
evalBezierDerivsQuad (QuadBezier Point a
a Point a
b Point a
c) a
t = [Point a
p, Point a
p', Point a
p'', forall a. a -> a -> Point a
Point a
0 a
0]
  where
    u :: a
u = a
1forall a. Num a => a -> a -> a
-a
t
    t2 :: a
t2 = a
tforall a. Num a => a -> a -> a
*a
t
    p :: Point a
p = a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point a
a forall v. AdditiveGroup v => v -> v -> v
^+^ (a
2forall a. Num a => a -> a -> a
*a
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
b) forall v. AdditiveGroup v => v -> v -> v
^+^ a
t2forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
c
    p' :: Point a
p' = a
2forall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
bforall v. AdditiveGroup v => v -> v -> v
^-^Point a
a) forall v. AdditiveGroup v => v -> v -> v
^+^ a
tforall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
cforall v. AdditiveGroup v => v -> v -> v
^-^Point a
b))
    p'' :: Point a
p'' = a
2forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
cforall v. AdditiveGroup v => v -> v -> v
^-^ a
2forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
b forall v. AdditiveGroup v => v -> v -> v
^+^ Point a
a)
{-# SPECIALIZE evalBezierDerivsQuad :: QuadBezier Double -> Double -> [DPoint] #-}        

evalBezierDerivQuad :: Num a =>
                        QuadBezier a -> a -> (Point a, Point a)
evalBezierDerivQuad :: forall a. Num a => QuadBezier a -> a -> (Point a, Point a)
evalBezierDerivQuad (QuadBezier Point a
a Point a
b Point a
c) a
t = Point a
p seq :: forall a b. a -> b -> b
`seq` Point a
p' seq :: forall a b. a -> b -> b
`seq` (Point a
p, Point a
p')
  where
    u :: a
u = a
1forall a. Num a => a -> a -> a
-a
t
    t2 :: a
t2 = a
tforall a. Num a => a -> a -> a
*a
t
    p :: Point a
p = a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point a
a forall v. AdditiveGroup v => v -> v -> v
^+^ (a
2forall a. Num a => a -> a -> a
*a
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
b) forall v. AdditiveGroup v => v -> v -> v
^+^ a
t2forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
c
    p' :: Point a
p' = a
2forall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
bforall v. AdditiveGroup v => v -> v -> v
^-^Point a
a) forall v. AdditiveGroup v => v -> v -> v
^+^ a
tforall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
cforall v. AdditiveGroup v => v -> v -> v
^-^Point a
b))
{-# SPECIALIZE evalBezierDerivQuad :: QuadBezier Double -> Double -> (DPoint, DPoint) #-}        

-- | Evaluate the bezier and all its derivatives using the modified horner algorithm.
evalBezierDerivs :: (GenericBezier b, V.Unbox a, Fractional a) =>
                    b a -> a -> [Point a]
evalBezierDerivs :: forall (b :: * -> *) a.
(GenericBezier b, Unbox a, Fractional a) =>
b a -> a -> [Point a]
evalBezierDerivs b a
b a
t =
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. a -> a -> Point a
Point (forall t. (Unbox t, Fractional t) => BernsteinPoly t -> t -> [t]
bernsteinEvalDerivs (forall a. Vector a -> BernsteinPoly a
BernsteinPoly Vector a
x) a
t)
  (forall t. (Unbox t, Fractional t) => BernsteinPoly t -> t -> [t]
bernsteinEvalDerivs (forall a. Vector a -> BernsteinPoly a
BernsteinPoly Vector a
y) a
t)
  where (Vector a
x, Vector a
y) = forall a b.
(Unbox a, Unbox b) =>
Vector (a, b) -> (Vector a, Vector b)
V.unzip forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
b a -> Vector (a, a)
toVector b a
b
{-# SPECIALIZE evalBezierDerivs :: AnyBezier Double -> Double -> [DPoint] #-}
{-# NOINLINE [2] evalBezierDerivs #-}
{-# RULES "evalBezierDerivs/cubic" evalBezierDerivs = evalBezierDerivsCubic #-}
{-# RULES "evalBezierDerivs/quad"  evalBezierDerivs = evalBezierDerivsQuad #-}

-- | Return True if the param lies on the curve, iff it's in the interval @[0, 1]@.
bezierParam :: (Ord a, Num a) => a -> Bool
bezierParam :: forall a. (Ord a, Num a) => a -> Bool
bezierParam a
t = a
t forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
t forall a. Ord a => a -> a -> Bool
<= a
1

-- | Convert a tolerance from the codomain to the domain of the bezier
-- curve, by dividing by the maximum velocity on the curve.  The
-- estimate is conservative, but holds for any value on the curve.
bezierParamTolerance :: (GenericBezier b) => b Double -> Double -> Double
bezierParamTolerance :: forall (b :: * -> *).
GenericBezier b =>
b Double -> Double -> Double
bezierParamTolerance (forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
b a -> Vector (a, a)
toVector -> Vector (Double, Double)
v) Double
eps = Double
eps forall a. Fractional a => a -> a -> a
/ Double
maxVel
  where 
    maxVel :: Double
maxVel = Double
3 forall a. Num a => a -> a -> a
* forall a. (Unbox a, Ord a) => Vector a -> a
V.maximum (forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith forall a. Floating a => Point a -> Point a -> a
vectorDistance (forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
V.map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point) Vector (Double, Double)
v)
                            (forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
V.map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point) forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => Vector a -> Vector a
V.tail Vector (Double, Double)
v))
{-# NOINLINE [2] bezierParamTolerance #-}             

bezierParamToleranceCubic :: (Ord a, Floating a) => CubicBezier a -> a -> a
bezierParamToleranceCubic :: forall a. (Ord a, Floating a) => CubicBezier a -> a -> a
bezierParamToleranceCubic (CubicBezier Point a
p0 Point a
p1 Point a
p2 Point a
p3) a
eps = a
eps forall a. Fractional a => a -> a -> a
/ a
maxVel
  where maxVel :: a
maxVel = (a
3 forall a. Num a => a -> a -> a
*) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max (forall a. Floating a => Point a -> Point a -> a
vectorDistance Point a
p0 Point a
p1) forall a b. (a -> b) -> a -> b
$
                 forall a. Ord a => a -> a -> a
max (forall a. Floating a => Point a -> Point a -> a
vectorDistance Point a
p1 Point a
p2)
                 (forall a. Floating a => Point a -> Point a -> a
vectorDistance Point a
p2 Point a
p3)
{-# SPECIALIZE bezierParamToleranceCubic :: CubicBezier Double -> Double -> Double #-}
{-# RULES "bezierParamTolerance/cubic" bezierParamTolerance = bezierParamToleranceCubic #-}

bezierParamToleranceQuad :: (Ord a, Floating a) => QuadBezier a -> a -> a
bezierParamToleranceQuad :: forall a. (Ord a, Floating a) => QuadBezier a -> a -> a
bezierParamToleranceQuad (QuadBezier Point a
p0 Point a
p1 Point a
p2) a
eps = a
eps forall a. Fractional a => a -> a -> a
/ a
maxVel
  where maxVel :: a
maxVel = (a
3 forall a. Num a => a -> a -> a
*) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max (forall a. Floating a => Point a -> Point a -> a
vectorDistance Point a
p0 Point a
p1) (forall a. Floating a => Point a -> Point a -> a
vectorDistance Point a
p1 Point a
p2)

{-# SPECIALIZE bezierParamToleranceQuad :: QuadBezier Double -> Double -> Double #-}
{-# RULES "bezierParamTolerance/quad" bezierParamTolerance = bezierParamToleranceQuad #-}

-- | Reorient to the curve B(1-t).
reorient :: (GenericBezier b, V.Unbox a) => b a -> b a
reorient :: forall (b :: * -> *) a. (GenericBezier b, Unbox a) => b a -> b a
reorient = forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
Vector (a, a) -> b a
unsafeFromVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Unbox a => Vector a -> Vector a
V.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
b a -> Vector (a, a)
toVector
{-# SPECIALIZE reorient :: (V.Unbox a) => AnyBezier a -> AnyBezier a #-}
{-# NOINLINE [2] reorient #-}

reorientCubic :: CubicBezier a -> CubicBezier a
reorientCubic :: forall a. CubicBezier a -> CubicBezier a
reorientCubic (CubicBezier Point a
a Point a
b Point a
c Point a
d) = forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point a
d Point a
c Point a
b Point a
a

reorientQuad :: QuadBezier a -> QuadBezier a
reorientQuad :: forall a. QuadBezier a -> QuadBezier a
reorientQuad (QuadBezier Point a
a Point a
b Point a
c) = forall a. Point a -> Point a -> Point a -> QuadBezier a
QuadBezier Point a
c Point a
b Point a
a
{-# RULES "reorient/cubic" reorient = reorientCubic #-}
{-# RULES "reorient/quad"  reorient = reorientQuad #-}

-- | Give the bernstein polynomial for each coordinate.
bezierToBernstein :: (GenericBezier b, MV.Unbox a) =>
                     b a -> (BernsteinPoly a, BernsteinPoly a)
bezierToBernstein :: forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
b a -> (BernsteinPoly a, BernsteinPoly a)
bezierToBernstein b a
b = (forall a. Vector a -> BernsteinPoly a
BernsteinPoly Vector a
x, forall a. Vector a -> BernsteinPoly a
BernsteinPoly Vector a
y)
  where (Vector a
x, Vector a
y) = forall a b.
(Unbox a, Unbox b) =>
Vector (a, b) -> (Vector a, Vector b)
V.unzip forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
b a -> Vector (a, a)
toVector b a
b

-- | Calculate a value on the bezier curve.
evalBezier :: (GenericBezier b, MV.Unbox a, Fractional a) =>
              b a -> a -> Point a
evalBezier :: forall (b :: * -> *) a.
(GenericBezier b, Unbox a, Fractional a) =>
b a -> a -> Point a
evalBezier b a
bc a
t = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) a.
(GenericBezier b, Unbox a, Fractional a) =>
b a -> a -> [Point a]
evalBezierDerivs b a
bc a
t
{-# SPECIALIZE evalBezier :: AnyBezier Double -> Double -> DPoint #-}
{-# NOINLINE [2] evalBezier #-}

evalBezierCubic :: Fractional a =>
                   CubicBezier a -> a -> Point a
evalBezierCubic :: forall a. Fractional a => CubicBezier a -> a -> Point a
evalBezierCubic (CubicBezier Point a
a Point a
b Point a
c Point a
d) a
t =
  a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point a
a forall v. AdditiveGroup v => v -> v -> v
^+^ (a
3forall a. Num a => a -> a -> a
*a
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
b) forall v. AdditiveGroup v => v -> v -> v
^+^ (a
3forall a. Num a => a -> a -> a
*a
t2)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
c) forall v. AdditiveGroup v => v -> v -> v
^+^ a
t3forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
d
  where
    u :: a
u = a
1forall a. Num a => a -> a -> a
-a
t
    t2 :: a
t2 = a
tforall a. Num a => a -> a -> a
*a
t
    t3 :: a
t3 = a
t2forall a. Num a => a -> a -> a
*a
t
{-# SPECIALIZE evalBezierCubic :: CubicBezier Double -> Double -> DPoint #-}
    
evalBezierQuad :: Fractional a =>
                  QuadBezier a -> a -> Point a
evalBezierQuad :: forall a. Fractional a => QuadBezier a -> a -> Point a
evalBezierQuad (QuadBezier Point a
a Point a
b Point a
c) a
t = 
  a
uforall v. VectorSpace v => Scalar v -> v -> v
*^(a
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point a
a forall v. AdditiveGroup v => v -> v -> v
^+^ (a
2forall a. Num a => a -> a -> a
*a
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
b) forall v. AdditiveGroup v => v -> v -> v
^+^ a
t2forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
c
  where
    u :: a
u = a
1forall a. Num a => a -> a -> a
-a
t
    t2 :: a
t2 = a
tforall a. Num a => a -> a -> a
*a
t
{-# SPECIALIZE evalBezierQuad :: QuadBezier Double -> Double -> DPoint #-}

{-# RULES "evalBezier/cubic" evalBezier = evalBezierCubic #-}
{-# RULES "evalBezier/quad"  evalBezier = evalBezierQuad #-}

-- | Calculate a value and the first derivative on the curve.
evalBezierDeriv :: (V.Unbox a, Fractional a) =>
                   GenericBezier b => b a -> a -> (Point a, Point a)
evalBezierDeriv :: forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv b a
bc a
t = (Point a
b,Point a
b')
  where
    (Point a
b:Point a
b':[Point a]
_) = forall (b :: * -> *) a.
(GenericBezier b, Unbox a, Fractional a) =>
b a -> a -> [Point a]
evalBezierDerivs b a
bc a
t
{-# NOINLINE evalBezierDeriv #-}    
{-# RULES "evalBezierDeriv/cubic" evalBezierDeriv = evalBezierDerivCubic #-}
{-# RULES "evalBezierDeriv/quad" evalBezierDeriv = evalBezierDerivQuad #-}

-- | @findBezierTangent p b@ finds the parameters where
-- the tangent of the bezier curve @b@ has the same direction as vector p.

-- Use the formula tx * B'y(t) - ty * B'x(t) = 0 where
-- B'x is the x value of the derivative of the Bezier curve.
findBezierTangent :: DPoint -> CubicBezier Double -> [Double]
findBezierTangent :: Point Double -> CubicBezier Double -> [Double]
findBezierTangent (Point Double
tx Double
ty) (CubicBezier (Point Double
x0 Double
y0) (Point Double
x1 Double
y1) (Point Double
x2 Double
y2) (Point Double
x3 Double
y3)) = 
  forall a. (a -> Bool) -> [a] -> [a]
filter forall a. (Ord a, Num a) => a -> Bool
bezierParam forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> [Double]
quadraticRoot Double
a Double
b Double
c
    where
      a :: Double
a = Double
txforall a. Num a => a -> a -> a
*((Double
y3 forall a. Num a => a -> a -> a
- Double
y0) forall a. Num a => a -> a -> a
+ Double
3forall a. Num a => a -> a -> a
*(Double
y1 forall a. Num a => a -> a -> a
- Double
y2)) forall a. Num a => a -> a -> a
- Double
tyforall a. Num a => a -> a -> a
*((Double
x3 forall a. Num a => a -> a -> a
- Double
x0) forall a. Num a => a -> a -> a
+ Double
3forall a. Num a => a -> a -> a
*(Double
x1 forall a. Num a => a -> a -> a
- Double
x2))
      b :: Double
b = Double
2forall a. Num a => a -> a -> a
*(Double
txforall a. Num a => a -> a -> a
*((Double
y2 forall a. Num a => a -> a -> a
+ Double
y0) forall a. Num a => a -> a -> a
- Double
2forall a. Num a => a -> a -> a
*Double
y1) forall a. Num a => a -> a -> a
- Double
tyforall a. Num a => a -> a -> a
*((Double
x2 forall a. Num a => a -> a -> a
+ Double
x0) forall a. Num a => a -> a -> a
- Double
2forall a. Num a => a -> a -> a
*Double
x1))
      c :: Double
c = Double
txforall a. Num a => a -> a -> a
*(Double
y1 forall a. Num a => a -> a -> a
- Double
y0) forall a. Num a => a -> a -> a
- Double
tyforall a. Num a => a -> a -> a
*(Double
x1 forall a. Num a => a -> a -> a
- Double
x0)

-- | Find the parameter where the bezier curve is horizontal.
bezierHoriz :: CubicBezier Double -> [Double]
bezierHoriz :: CubicBezier Double -> [Double]
bezierHoriz = Point Double -> CubicBezier Double -> [Double]
findBezierTangent (forall a. a -> a -> Point a
Point Double
1 Double
0)

-- | Find the parameter where the bezier curve is vertical.
bezierVert :: CubicBezier Double -> [Double]
bezierVert :: CubicBezier Double -> [Double]
bezierVert = Point Double -> CubicBezier Double -> [Double]
findBezierTangent (forall a. a -> a -> Point a
Point Double
0 Double
1)

-- | Find inflection points on the curve.
-- Use the formula B_x''(t) * B_y'(t) - B_y''(t) * B_x'(t) = 0 with
-- B_x'(t) the x value of the first derivative at t, B_y''(t) the y
-- value of the second derivative at t
findBezierInflection :: CubicBezier Double -> [Double]
findBezierInflection :: CubicBezier Double -> [Double]
findBezierInflection (CubicBezier (Point Double
x0 Double
y0) (Point Double
x1 Double
y1) (Point Double
x2 Double
y2) (Point Double
x3 Double
y3)) =
  forall a. (a -> Bool) -> [a] -> [a]
filter forall a. (Ord a, Num a) => a -> Bool
bezierParam forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> [Double]
quadraticRoot Double
a Double
b Double
c
    where
      ax :: Double
ax = Double
x1 forall a. Num a => a -> a -> a
- Double
x0
      bx :: Double
bx = Double
x3 forall a. Num a => a -> a -> a
- Double
x1 forall a. Num a => a -> a -> a
- Double
ax
      cx :: Double
cx = Double
x3 forall a. Num a => a -> a -> a
- Double
x2 forall a. Num a => a -> a -> a
- Double
ax forall a. Num a => a -> a -> a
- Double
2forall a. Num a => a -> a -> a
*Double
bx
      ay :: Double
ay = Double
y1 forall a. Num a => a -> a -> a
- Double
y0
      by :: Double
by = Double
y2 forall a. Num a => a -> a -> a
- Double
y1 forall a. Num a => a -> a -> a
- Double
ay
      cy :: Double
cy = Double
y3 forall a. Num a => a -> a -> a
- Double
y2 forall a. Num a => a -> a -> a
- Double
ay forall a. Num a => a -> a -> a
- Double
2forall a. Num a => a -> a -> a
*Double
by
      a :: Double
a = Double
bxforall a. Num a => a -> a -> a
*Double
cy forall a. Num a => a -> a -> a
- Double
byforall a. Num a => a -> a -> a
*Double
cx
      b :: Double
b = Double
axforall a. Num a => a -> a -> a
*Double
cy forall a. Num a => a -> a -> a
- Double
ayforall a. Num a => a -> a -> a
*Double
cx
      c :: Double
c = Double
axforall a. Num a => a -> a -> a
*Double
by forall a. Num a => a -> a -> a
- Double
ayforall a. Num a => a -> a -> a
*Double
bx

-- | Find the cusps of a bezier.

-- find a cusp.  We look for points where the tangent is both horizontal
-- and vertical, which is only true for the zero vector.
findBezierCusp :: CubicBezier Double -> [Double]
findBezierCusp :: CubicBezier Double -> [Double]
findBezierCusp CubicBezier Double
b = forall a. (a -> Bool) -> [a] -> [a]
filter Double -> Bool
vertical forall a b. (a -> b) -> a -> b
$ CubicBezier Double -> [Double]
bezierHoriz CubicBezier Double
b
  where vertical :: Double -> Bool
vertical = (forall a. Eq a => a -> a -> Bool
== Double
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Point a -> a
pointY forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv CubicBezier Double
b

-- | @bezierArc startAngle endAngle@ approximates an arc on the unit circle with
-- a single cubic béziér curve.  Maximum deviation is <0.03% for arcs
-- 90° degrees or less.
bezierArc :: Double -> Double -> CubicBezier Double
bezierArc :: Double -> Double -> CubicBezier Double
bezierArc Double
start Double
end = forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point Double
p0 Point Double
p1 Point Double
p2 Point Double
p3
  where
    p0 :: Point Double
p0 = forall a. Floating a => a -> Point a
dirVector Double
start
    p3 :: Point Double
p3 = forall a. Floating a => a -> Point a
dirVector Double
end
    p1 :: Point Double
p1 = Point Double
p0 forall v. AdditiveGroup v => v -> v -> v
^+^ Double
k forall v. VectorSpace v => Scalar v -> v -> v
*^ (forall s. Floating s => Transform s
rotate90L forall a b. AffineTransform a b => Transform b -> a -> a
$* Point Double
p0)
    p2 :: Point Double
p2 = Point Double
p1 forall v. AdditiveGroup v => v -> v -> v
^+^ Double
k forall v. VectorSpace v => Scalar v -> v -> v
*^ (forall s. Floating s => Transform s
rotate90R forall a b. AffineTransform a b => Transform b -> a -> a
$* Point Double
p3)
    k :: Double
k = Double
4forall a. Fractional a => a -> a -> a
/Double
3 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
tan((Double
endforall a. Num a => a -> a -> a
-Double
start)forall a. Fractional a => a -> a -> a
/Double
4)

-- | @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 b :: CubicBezier Double
b@(CubicBezier Point Double
c0 Point Double
c1 Point Double
c2 Point Double
c3) Double
t Double
eps =
  if Double
eps forall a. Fractional a => a -> a -> a
/ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [forall a. Floating a => Point a -> Point a -> a
vectorDistance Point Double
c0 Point Double
c1,
                    forall a. Floating a => Point a -> Point a -> a
vectorDistance Point Double
c1 Point Double
c2,
                    forall a. Floating a => Point a -> Point a -> a
vectorDistance Point Double
c2 Point Double
c3] forall a. Ord a => a -> a -> Bool
> Double
1e-10
  then (forall a. Num a => a -> a
signum Double
t forall a. Num a => a -> a -> a
*) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
       CubicBezier Double -> Double -> (Double, (Double, Double))
arcLengthEstimate (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (b a, b a)
splitBezier CubicBezier Double
b Double
t) Double
eps
  else CubicBezier Double -> Double -> Double -> Double
arcLengthQuad CubicBezier Double
b Double
t Double
eps

arcLengthQuad :: CubicBezier Double -> Double -> Double -> Double
arcLengthQuad :: CubicBezier Double -> Double -> Double -> Double
arcLengthQuad CubicBezier Double
b Double
t Double
eps = Result -> Double
result forall a b. (a -> b) -> a -> b
$ Double -> [Result] -> Result
absolute Double
eps forall a b. (a -> b) -> a -> b
$
                        (Double -> Double) -> Double -> Double -> [Result]
trap Double -> Double
distDeriv Double
0 Double
t
  where distDeriv :: Double -> Double
distDeriv Double
t' = forall a. Floating a => Point a -> a
vectorMag forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Double -> (Point Double, Point Double)
evalD Double
t'
        evalD :: Double -> (Point Double, Point Double)
evalD = forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv CubicBezier Double
b

outline :: CubicBezier Double -> Double
outline :: CubicBezier Double -> Double
outline (CubicBezier Point Double
c0 Point Double
c1 Point Double
c2 Point Double
c3) =
  forall a. Floating a => Point a -> Point a -> a
vectorDistance Point Double
c0 Point Double
c1 forall a. Num a => a -> a -> a
+
  forall a. Floating a => Point a -> Point a -> a
vectorDistance Point Double
c1 Point Double
c2 forall a. Num a => a -> a -> a
+
  forall a. Floating a => Point a -> Point a -> a
vectorDistance Point Double
c2 Point Double
c3

arcLengthEstimate :: CubicBezier Double -> Double -> (Double, (Double, Double))
arcLengthEstimate :: CubicBezier Double -> Double -> (Double, (Double, Double))
arcLengthEstimate CubicBezier Double
b Double
eps = (Double
arclen, (Double
estimate, Double
ol))
  where
    estimate :: Double
estimate = (Double
4forall a. Num a => a -> a -> a
*(Double
olLforall a. Num a => a -> a -> a
+Double
olR) forall a. Num a => a -> a -> a
- Double
ol) forall a. Fractional a => a -> a -> a
/ Double
3
    (CubicBezier Double
bl, CubicBezier Double
br) = forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (b a, b a)
splitBezier CubicBezier Double
b Double
0.5
    ol :: Double
ol = CubicBezier Double -> Double
outline CubicBezier Double
b
    (Double
arcL, (Double
estL, Double
olL)) = CubicBezier Double -> Double -> (Double, (Double, Double))
arcLengthEstimate CubicBezier Double
bl Double
eps
    (Double
arcR, (Double
estR, Double
olR)) = CubicBezier Double -> Double -> (Double, (Double, Double))
arcLengthEstimate CubicBezier Double
br Double
eps
    arclen :: Double
arclen | forall a. Num a => a -> a
abs(Double
estL forall a. Num a => a -> a -> a
+ Double
estR forall a. Num a => a -> a -> a
- Double
estimate) forall a. Ord a => a -> a -> Bool
< Double
eps = Double
estL forall a. Num a => a -> a -> a
+ Double
estR
           | Bool
otherwise = Double
arcL forall a. Num a => a -> a -> a
+ Double
arcR

-- | 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
b Double
len Double
eps =
  CubicBezier Double
-> Double -> Double -> Double -> Double -> Double -> Double
arcLengthP CubicBezier Double
b Double
len Double
ol (Double
lenforall a. Fractional a => a -> a -> a
/Double
ol) Double
1 Double
eps
  where ol :: Double
ol = CubicBezier Double -> Double
outline CubicBezier Double
b

-- Use the Newton rootfinding method.  Start with large tolerance
-- values, and decrease tolerance as we go closer to the root.
arcLengthP :: CubicBezier Double -> Double -> Double ->
              Double -> Double -> Double -> Double
arcLengthP :: CubicBezier Double
-> Double -> Double -> Double -> Double -> Double -> Double
arcLengthP !CubicBezier Double
b !Double
len !Double
tot !Double
t !Double
dt !Double
eps
  | forall a. Num a => a -> a
abs Double
diff forall a. Ord a => a -> a -> Bool
< Double
eps = Double
t forall a. Num a => a -> a -> a
- Double
newDt
  | Bool
otherwise = CubicBezier Double
-> Double -> Double -> Double -> Double -> Double -> Double
arcLengthP CubicBezier Double
b Double
len Double
tot (Double
t forall a. Num a => a -> a -> a
- Double
newDt) Double
newDt Double
eps
  where diff :: Double
diff = CubicBezier Double -> Double -> Double -> Double
arcLength CubicBezier Double
b Double
t (forall a. Ord a => a -> a -> a
max (forall a. Num a => a -> a
abs (Double
dtforall a. Num a => a -> a -> a
*Double
totforall a. Fractional a => a -> a -> a
/Double
50)) (Double
epsforall a. Fractional a => a -> a -> a
/Double
2)) forall a. Num a => a -> a -> a
- Double
len
        newDt :: Double
newDt = Double
diff forall a. Fractional a => a -> a -> a
/ forall a. Floating a => Point a -> a
vectorMag (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv CubicBezier Double
b Double
t)

-- | Convert a quadratic bezier to a cubic bezier.
quadToCubic :: (Fractional a) =>
               QuadBezier a -> CubicBezier a
quadToCubic :: forall a. Fractional a => QuadBezier a -> CubicBezier a
quadToCubic (QuadBezier Point a
a Point a
b Point a
c) =
  forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point a
a ((a
1forall a. Fractional a => a -> a -> a
/a
3)forall v. VectorSpace v => Scalar v -> v -> v
*^(Point a
a forall v. AdditiveGroup v => v -> v -> v
^+^ a
2forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
b)) ((a
1forall a. Fractional a => a -> a -> a
/a
3)forall v. VectorSpace v => Scalar v -> v -> v
*^(a
2forall v. VectorSpace v => Scalar v -> v -> v
*^Point a
b forall v. AdditiveGroup v => v -> v -> v
^+^ Point a
c)) Point a
c

-- | Split a bezier curve into two curves.
splitBezier :: (V.Unbox a, Fractional a) =>
               GenericBezier b => b a -> a -> (b a, b a)
splitBezier :: forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (b a, b a)
splitBezier b a
b a
t =
  (forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
Vector (a, a) -> b a
unsafeFromVector forall a b. (a -> b) -> a -> b
$ forall a b.
(Unbox a, Unbox b) =>
Vector a -> Vector b -> Vector (a, b)
V.zip (forall a. BernsteinPoly a -> Vector a
bernsteinCoeffs BernsteinPoly a
x1) (forall a. BernsteinPoly a -> Vector a
bernsteinCoeffs BernsteinPoly a
y1),
   forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
Vector (a, a) -> b a
unsafeFromVector forall a b. (a -> b) -> a -> b
$ forall a b.
(Unbox a, Unbox b) =>
Vector a -> Vector b -> Vector (a, b)
V.zip (forall a. BernsteinPoly a -> Vector a
bernsteinCoeffs BernsteinPoly a
x2) (forall a. BernsteinPoly a -> Vector a
bernsteinCoeffs BernsteinPoly a
y2))
  where
    (BernsteinPoly a
x, BernsteinPoly a
y) = forall (b :: * -> *) a.
(GenericBezier b, Unbox a) =>
b a -> (BernsteinPoly a, BernsteinPoly a)
bezierToBernstein b a
b
    (BernsteinPoly a
x1, BernsteinPoly a
x2) = forall a.
(Unbox a, Num a) =>
BernsteinPoly a -> a -> (BernsteinPoly a, BernsteinPoly a)
bernsteinSplit BernsteinPoly a
x a
t
    (BernsteinPoly a
y1, BernsteinPoly a
y2) = forall a.
(Unbox a, Num a) =>
BernsteinPoly a -> a -> (BernsteinPoly a, BernsteinPoly a)
bernsteinSplit BernsteinPoly a
y a
t
{-# NOINLINE [2] splitBezier #-}
{-# SPECIALIZE splitBezier :: AnyBezier Double -> Double -> (AnyBezier Double, AnyBezier Double) #-}

-- | Split a bezier curve into two curves.
splitBezierCubic :: (Fractional a) =>  CubicBezier a -> a -> (CubicBezier a, CubicBezier a)
splitBezierCubic :: forall a.
Fractional a =>
CubicBezier a -> a -> (CubicBezier a, CubicBezier a)
splitBezierCubic (CubicBezier Point a
a Point a
b Point a
c Point a
d) a
t =
  let ab :: Point a
ab = forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
a Point a
b a
t
      bc :: Point a
bc = forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
b Point a
c a
t
      cd :: Point a
cd = forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
c Point a
d a
t
      abbc :: Point a
abbc = forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
ab Point a
bc a
t
      bccd :: Point a
bccd = forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
bc Point a
cd a
t
      mid :: Point a
mid = forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
abbc Point a
bccd a
t
  in Point a
mid seq :: forall a b. a -> b -> b
`seq` (forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point a
a Point a
ab Point a
abbc Point a
mid, forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point a
mid Point a
bccd Point a
cd Point a
d)
{-# SPECIALIZE splitBezierCubic :: CubicBezier Double -> Double -> (CubicBezier Double, CubicBezier Double) #-}     

-- | Split a bezier curve into two curves.
splitBezierQuad :: (Fractional a) =>  QuadBezier a -> a -> (QuadBezier a, QuadBezier a)
splitBezierQuad :: forall a.
Fractional a =>
QuadBezier a -> a -> (QuadBezier a, QuadBezier a)
splitBezierQuad (QuadBezier Point a
a Point a
b Point a
c) a
t =
  let ab :: Point a
ab = forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
a Point a
b a
t
      bc :: Point a
bc = forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
b Point a
c a
t
      mid :: Point a
mid = forall a. Num a => Point a -> Point a -> a -> Point a
interpolateVector Point a
ab Point a
bc a
t
  in (forall a. Point a -> Point a -> Point a -> QuadBezier a
QuadBezier Point a
a Point a
ab Point a
mid, forall a. Point a -> Point a -> Point a -> QuadBezier a
QuadBezier Point a
mid Point a
bc Point a
c)
{-# SPECIALIZE splitBezierQuad :: QuadBezier Double -> Double -> (QuadBezier Double, QuadBezier Double) #-}
{-# RULES "splitBezier/cubic" splitBezier = splitBezierCubic #-}
{-# RULES "splitBezier/quad"  splitBezier = splitBezierQuad #-}

-- | Return the subsegment between the two parameters.
bezierSubsegment :: (Ord a, V.Unbox a, Fractional a) => GenericBezier b =>
                    b a -> a -> a -> b a
bezierSubsegment :: forall a (b :: * -> *).
(Ord a, Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> a -> b a
bezierSubsegment b a
b a
t1 a
t2 
  | a
t1 forall a. Ord a => a -> a -> Bool
> a
t2   = forall a (b :: * -> *).
(Ord a, Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> a -> b a
bezierSubsegment b a
b a
t2 a
t1
  | a
t2 forall a. Eq a => a -> a -> Bool
== a
0   = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (b a, b a)
splitBezier b a
b a
t1
  | Bool
otherwise = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (b a, b a)
splitBezier (a
t1forall a. Fractional a => a -> a -> a
/a
t2) forall a b. (a -> b) -> a -> b
$
                forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (b a, b a)
splitBezier b a
b a
t2
{-# SPECIALIZE bezierSubsegment :: QuadBezier Double -> Double -> Double -> QuadBezier Double #-}
{-# NOINLINE[2] bezierSubsegment #-}

-- | Return the subsegment between the two parameters.
bezierSubsegmentCubic :: (V.Unbox a, Fractional a) => CubicBezier a -> a -> a -> CubicBezier a
bezierSubsegmentCubic :: forall a.
(Unbox a, Fractional a) =>
CubicBezier a -> a -> a -> CubicBezier a
bezierSubsegmentCubic CubicBezier a
b a
t1 a
t2 =
  forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point a
b1 (Point a
b1 forall v. AdditiveGroup v => v -> v -> v
^+^ Point a
b1' forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* ((a
t2forall a. Num a => a -> a -> a
-a
t1)forall a. Fractional a => a -> a -> a
/a
3))
  (Point a
b2 forall v. AdditiveGroup v => v -> v -> v
^-^ (Point a
b2' forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* ((a
t2forall a. Num a => a -> a -> a
-a
t1)forall a. Fractional a => a -> a -> a
/a
3))) Point a
b2
  where (Point a
b1, Point a
b1') = forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv CubicBezier a
b a
t1
        (Point a
b2, Point a
b2') = forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv CubicBezier a
b a
t2
{-# SPECIALIZE bezierSubsegmentCubic :: CubicBezier Double -> Double -> Double -> CubicBezier Double #-}
{-# RULES "bezierSubsegment/cubic" bezierSubsegment = bezierSubsegmentCubic #-}


-- | Split a bezier curve into a list of beziers
-- The parameters should be in ascending order or
-- the result is unpredictable.
splitBezierN :: (Ord a, V.Unbox a, Fractional a) =>
                GenericBezier b => b a -> [a] -> [b a]
splitBezierN :: forall a (b :: * -> *).
(Ord a, Unbox a, Fractional a, GenericBezier b) =>
b a -> [a] -> [b a]
splitBezierN b a
c [] = [b a
c]
splitBezierN b a
c [a
t] = [b a
a, b a
b] where
  (b a
a, b a
b) = forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (b a, b a)
splitBezier b a
c a
t
splitBezierN b a
c (a
t:a
u:[a]
rest) =
  forall a (b :: * -> *).
(Ord a, Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> a -> b a
bezierSubsegment b a
c a
0 a
t forall a. a -> [a] -> [a]
:
  forall a (b :: * -> *).
(Ord a, Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> a -> b a
bezierSubsegment b a
c a
t a
u forall a. a -> [a] -> [a]
:
  forall a. [a] -> [a]
tail (forall a (b :: * -> *).
(Ord a, Unbox a, Fractional a, GenericBezier b) =>
b a -> [a] -> [b a]
splitBezierN b a
c forall a b. (a -> b) -> a -> b
$ a
uforall a. a -> [a] -> [a]
:[a]
rest)
{-# SPECIALIZE splitBezierN :: CubicBezier Double -> [Double] -> [CubicBezier Double] #-}
{-# SPECIALIZE splitBezierN :: QuadBezier Double -> [Double] -> [QuadBezier Double] #-}

evalBezierDerivs2Cubic :: CubicBezier Double -> Double -> (DPoint, DPoint, DPoint)
evalBezierDerivs2Cubic :: CubicBezier Double
-> Double -> (Point Double, Point Double, Point Double)
evalBezierDerivs2Cubic (CubicBezier Point Double
a Point Double
b Point Double
c Point Double
d) Double
t =
  Point Double
p seq :: forall a b. a -> b -> b
`seq` Point Double
p' seq :: forall a b. a -> b -> b
`seq` Point Double
p'' seq :: forall a b. a -> b -> b
`seq`(Point Double
p, Point Double
p', Point Double
p'')
  where
    u :: Double
u = Double
1forall a. Num a => a -> a -> a
-Double
t
    t2 :: Double
t2 = Double
tforall a. Num a => a -> a -> a
*Double
t
    t3 :: Double
t3 = Double
t2forall a. Num a => a -> a -> a
*Double
t
    da :: Point Double
da = Double
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Point Double
bforall v. AdditiveGroup v => v -> v -> v
^-^Point Double
a)
    db :: Point Double
db = Double
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Point Double
cforall v. AdditiveGroup v => v -> v -> v
^-^Point Double
b)
    dc :: Point Double
dc = Double
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Point Double
dforall v. AdditiveGroup v => v -> v -> v
^-^Point Double
c)
    p :: Point Double
p = Double
uforall v. VectorSpace v => Scalar v -> v -> v
*^(Double
uforall v. VectorSpace v => Scalar v -> v -> v
*^(Double
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point Double
a forall v. AdditiveGroup v => v -> v -> v
^+^ (Double
3forall a. Num a => a -> a -> a
*Double
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point Double
b) forall v. AdditiveGroup v => v -> v -> v
^+^ (Double
3forall a. Num a => a -> a -> a
*Double
t2)forall v. VectorSpace v => Scalar v -> v -> v
*^Point Double
c) forall v. AdditiveGroup v => v -> v -> v
^+^ Double
t3forall v. VectorSpace v => Scalar v -> v -> v
*^Point Double
d
    p' :: Point Double
p' = Double
uforall v. VectorSpace v => Scalar v -> v -> v
*^(Double
uforall v. VectorSpace v => Scalar v -> v -> v
*^Point Double
da forall v. AdditiveGroup v => v -> v -> v
^+^ (Double
2forall a. Num a => a -> a -> a
*Double
t)forall v. VectorSpace v => Scalar v -> v -> v
*^Point Double
db) forall v. AdditiveGroup v => v -> v -> v
^+^ Double
t2forall v. VectorSpace v => Scalar v -> v -> v
*^Point Double
dc
    p'' :: Point Double
p'' = (Double
2forall a. Num a => a -> a -> a
*Double
u)forall v. VectorSpace v => Scalar v -> v -> v
*^(Point Double
dbforall v. AdditiveGroup v => v -> v -> v
^-^Point Double
da) forall v. AdditiveGroup v => v -> v -> v
^+^ (Double
2forall a. Num a => a -> a -> a
*Double
t)forall v. VectorSpace v => Scalar v -> v -> v
*^(Point Double
dcforall v. AdditiveGroup v => v -> v -> v
^-^Point Double
db)

-- estimate the next approximation for the point closest to p by
-- dividing the approximate arclength on the osculating circle at t by the
-- speed at t.
closestBezierCurve :: CubicBezier Double -> DPoint -> Double -> Double
closestBezierCurve :: CubicBezier Double -> Point Double -> Double -> Double
closestBezierCurve CubicBezier Double
cb p :: Point Double
p@(Point Double
px Double
py) Double
t
 | Double
vSqr forall a. Eq a => a -> a -> Bool
== Double
0 =
     let (Point Double
dx Double
dy) = forall a. CubicBezier a -> Point a
cubicC3 CubicBezier Double
cb forall v. AdditiveGroup v => v -> v -> v
^-^ forall a. CubicBezier a -> Point a
cubicC0 CubicBezier Double
cb
     in forall a. Num a => a -> a
signum ((Double
px forall a. Num a => a -> a -> a
- Double
bx)forall a. Num a => a -> a -> a
*Double
dx forall a. Num a => a -> a -> a
+ (Double
py forall a. Num a => a -> a -> a
- Double
by)forall a. Num a => a -> a -> a
*Double
dy)
 | forall a. Floating a => Point a -> a
vectorMagSquare (Point Double
p forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
b) forall a. Num a => a -> a -> a
* Double
100 forall a. Ord a => a -> a -> Bool
< Double
vSqrforall a. Num a => a -> a -> a
*Double
r_vforall a. Num a => a -> a -> a
*Double
r_v =
     Double
closestLinePt 
 | Bool
otherwise =
   -- circular arc divided by velocity
   - (Point Double -> Double
fastVectorAngle (forall a. Num a => Point a -> Transform a
rotateScaleVec (Point Double
c forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p) forall a b. AffineTransform a b => Transform b -> a -> a
$* ((forall a. a -> a -> Point a
Point Double
by' Double
bx') forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* forall a. Num a => a -> a
signum Double
r_v))) forall a. Num a => a -> a -> a
* Double
r_v
  where
    closestLinePt :: Double
    closestLinePt :: Double
closestLinePt = ((Double
px forall a. Num a => a -> a -> a
- Double
bx)forall a. Num a => a -> a -> a
*Double
bx' forall a. Num a => a -> a -> a
+ (Double
py forall a. Num a => a -> a -> a
- Double
by)forall a. Num a => a -> a -> a
*Double
by')forall a. Fractional a => a -> a -> a
/Double
vSqr
    (b :: Point Double
b@(Point Double
bx Double
by), b' :: Point Double
b'@(Point Double
bx' Double
by'), Point Double
bx'' Double
by'') = CubicBezier Double
-> Double -> (Point Double, Point Double, Point Double)
evalBezierDerivs2Cubic CubicBezier Double
cb Double
t
    -- radius of curvature / velocity
    r_v :: Double
r_v = Double
vSqrforall a. Fractional a => a -> a -> a
/Double
denom
    vSqr :: Double
vSqr = Double
bx'forall a. Num a => a -> a -> a
*Double
bx' forall a. Num a => a -> a -> a
+ Double
by'forall a. Num a => a -> a -> a
*Double
by'
    denom :: Double
denom = Double
bx''forall a. Num a => a -> a -> a
*Double
by' forall a. Num a => a -> a -> a
- Double
bx'forall a. Num a => a -> a -> a
*Double
by''
    -- center of osculating circle
    c :: Point Double
c = Point Double
b forall v. AdditiveGroup v => v -> v -> v
^+^ ((forall s. Floating s => Transform s
rotate90R forall a b. AffineTransform a b => Transform b -> a -> a
$* Point Double
b') forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* Double
r_v)

-- approximation of vectorAngle, fastVectorAngle θ ≊ vectorAngle θ for
-- small |θ|. This avoids a costly atan2 instruction, and I measured a
-- performance increase upto 33%.
fastVectorAngle :: DPoint -> Double
fastVectorAngle :: Point Double -> Double
fastVectorAngle (Point Double
x Double
y)
  | forall a. Num a => a -> a
abs Double
y forall a. Ord a => a -> a -> Bool
< forall a. Num a => a -> a
abs Double
x = Double
yforall a. Fractional a => a -> a -> a
/Double
x forall a. Num a => a -> a -> a
+ if Double
x forall a. Ord a => a -> a -> Bool
< Double
0 then forall a. Num a => a -> a
signum Double
yforall a. Num a => a -> a -> a
*forall a. Floating a => a
pi else Double
0
  | Bool
otherwise = forall a. Num a => a -> a
signum Double
yforall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Double
2forall a. Num a => a -> a -> a
-(Double
xforall a. Fractional a => a -> a -> a
/Double
y)
    
-- | Find the closest value on the bezier to the given point, within tolerance.  Return the first value found.
closest :: CubicBezier Double -> DPoint -> Double -> Double
closest :: CubicBezier Double -> Point Double -> Double -> Double
closest CubicBezier Double
cb Point Double
p Double
eps =
  (Double -> Double)
-> Double -> Double -> Double -> Double -> Double
iter (CubicBezier Double -> Point Double -> Double -> Double
closestBezierCurve CubicBezier Double
cb Point Double
p) (forall (b :: * -> *).
GenericBezier b =>
b Double -> Double -> Double
bezierParamTolerance CubicBezier Double
cb Double
eps) Double
0 Double
1 Double
0.5
  

-- iterate, fallback to bisection if the approximation doesn't converge.  
iter :: (Double -> Double) -> Double -> Double -> Double -> Double -> Double  
iter :: (Double -> Double)
-> Double -> Double -> Double -> Double -> Double
iter Double -> Double
f Double
eps Double
mint Double
maxt Double
curt
  | forall a. Num a => a -> a
abs Double
dt forall a. Ord a => a -> a -> Bool
<= Double
eps = Double
curt forall a. Num a => a -> a -> a
+ Double
dt
  | Double
dt forall a. Ord a => a -> a -> Bool
< Double
0 =
      if | Double
curt forall a. Num a => a -> a -> a
+ Double
dt forall a. Ord a => a -> a -> Bool
<= Double
mint ->
           if Double
mint forall a. Eq a => a -> a -> Bool
== Double
0 Bool -> Bool -> Bool
&& Double -> Double
f Double
0 forall a. Ord a => a -> a -> Bool
<= Double
0
           then Double
0
           -- bisect
           else
             let dT :: Double
dT = (Double
curt forall a. Num a => a -> a -> a
- Double
mint)forall a. Fractional a => a -> a -> a
/Double
2
             in if Double
dT forall a. Ord a => a -> a -> Bool
< Double
eps then Double
mintforall a. Num a => a -> a -> a
+Double
dT
             else (Double -> Double)
-> Double -> Double -> Double -> Double -> Double
iter Double -> Double
f Double
eps Double
mint Double
curt (Double
mintforall a. Num a => a -> a -> a
+Double
dT)
         | Bool
otherwise ->
             (Double -> Double)
-> Double -> Double -> Double -> Double -> Double
iter Double -> Double
f Double
eps Double
mint Double
curt (Double
curtforall a. Num a => a -> a -> a
+Double
dt)
  | Bool
otherwise =
      if | Double
curt forall a. Num a => a -> a -> a
+ Double
dt forall a. Ord a => a -> a -> Bool
>= Double
maxt ->
           if Double
maxt forall a. Eq a => a -> a -> Bool
== Double
1 Bool -> Bool -> Bool
&& Double -> Double
f Double
1 forall a. Ord a => a -> a -> Bool
>= Double
0
           then Double
1
           --bisect
           else
             let dT :: Double
dT = (Double
maxt forall a. Num a => a -> a -> a
- Double
curt)forall a. Fractional a => a -> a -> a
/Double
2
             in if Double
dT forall a. Ord a => a -> a -> Bool
< Double
eps then Double
curt forall a. Num a => a -> a -> a
+Double
dT
             else (Double -> Double)
-> Double -> Double -> Double -> Double -> Double
iter Double -> Double
f Double
eps Double
curt Double
maxt (Double
curtforall a. Num a => a -> a -> a
+Double
dT)
         | Bool
otherwise ->
             (Double -> Double)
-> Double -> Double -> Double -> Double -> Double
iter Double -> Double
f Double
eps Double
curt Double
maxt (Double
curtforall a. Num a => a -> a -> a
+Double
dt)
  where
    dt :: Double
dt = Double -> Double
f Double
curt

-- | Find the x value of the cubic bezier.  The bezier must be
-- monotonically increasing in the X coordinate.
findX :: CubicBezier Double -> Double -> Double -> Double
findX :: CubicBezier Double -> Double -> Double -> Double
findX (CubicBezier (Point Double
p0 Double
_) (Point Double
p1 Double
_) (Point Double
p2 Double
_) (Point Double
p3 Double
_)) Double
x =
  Double -> Double -> Double -> Double -> Double -> Double
find0 (Double
p0forall a. Num a => a -> a -> a
-Double
x) (Double
p1forall a. Num a => a -> a -> a
-Double
x) (Double
p2forall a. Num a => a -> a -> a
-Double
x) (Double
p3forall a. Num a => a -> a -> a
-Double
x)

find0 :: Double -> Double -> Double -> Double -> Double -> Double
find0 :: Double -> Double -> Double -> Double -> Double -> Double
find0 Double
a Double
b Double
c Double
d Double
eps =
  (Double -> Double)
-> Double -> Double -> Double -> Double -> Double
iter Double -> Double
bezierZero Double
eps Double
0 Double
1 Double
0.5
  where
    bezierZero :: Double -> Double
bezierZero Double
t
      | Double
bx forall a. Eq a => a -> a -> Bool
== Double
0 = Double
t
      | Bool
otherwise = -Double
bxforall a. Fractional a => a -> a -> a
/Double
bx'
      where 
        u :: Double
u = Double
1forall a. Num a => a -> a -> a
-Double
t
        t2 :: Double
t2 = Double
tforall a. Num a => a -> a -> a
*Double
t
        t3 :: Double
t3 = Double
t2forall a. Num a => a -> a -> a
*Double
t
        da :: Double
da = Double
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Double
bforall a. Num a => a -> a -> a
-Double
a)
        db :: Double
db = Double
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Double
cforall a. Num a => a -> a -> a
-Double
b)
        dc :: Double
dc = Double
3forall v. VectorSpace v => Scalar v -> v -> v
*^(Double
dforall a. Num a => a -> a -> a
-Double
c)
        bx :: Double
bx = Double
uforall a. Num a => a -> a -> a
*(Double
uforall a. Num a => a -> a -> a
*(Double
uforall a. Num a => a -> a -> a
*Double
a forall a. Num a => a -> a -> a
+ (Double
3forall a. Num a => a -> a -> a
*Double
t)forall a. Num a => a -> a -> a
*Double
b) forall a. Num a => a -> a -> a
+ (Double
3forall a. Num a => a -> a -> a
*Double
t2)forall a. Num a => a -> a -> a
*Double
c) forall a. Num a => a -> a -> a
+ Double
t3forall a. Num a => a -> a -> a
*Double
d
        bx' :: Double
bx' = Double
uforall a. Num a => a -> a -> a
*(Double
uforall a. Num a => a -> a -> a
*Double
da forall a. Num a => a -> a -> a
+ (Double
2forall a. Num a => a -> a -> a
*Double
t)forall a. Num a => a -> a -> a
*Double
db) forall a. Num a => a -> a -> a
+ Double
t2forall a. Num a => a -> a -> a
*Double
dc
        
-- | Return False if some points fall outside a line with a thickness of the given tolerance.

-- fat line calculation taken from the bezier-clipping algorithm (Sederberg)
colinear :: CubicBezier Double -> Double -> Bool
colinear :: CubicBezier Double -> Double -> Bool
colinear (CubicBezier !Point Double
a !Point Double
b !Point Double
c !Point Double
d) Double
eps = Double
dmax forall a. Num a => a -> a -> a
- Double
dmin forall a. Ord a => a -> a -> Bool
< Double
eps
  where ld :: Point Double -> Double
ld = forall a. Floating a => Line a -> Point a -> a
lineDistance (forall a. Point a -> Point a -> Line a
Line Point Double
a Point Double
d)
        d1 :: Double
d1 = Point Double -> Double
ld Point Double
b
        d2 :: Double
d2 = Point Double -> Double
ld Point Double
c
        (Double
dmin, Double
dmax) | Double
d1forall a. Num a => a -> a -> a
*Double
d2 forall a. Ord a => a -> a -> Bool
> Double
0 = (Double
3forall a. Fractional a => a -> a -> a
/Double
4 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double
0, Double
d1, Double
d2],
                                    Double
3forall a. Fractional a => a -> a -> a
/Double
4 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double
0, Double
d1, Double
d2])
                     | Bool
otherwise = (Double
4forall a. Fractional a => a -> a -> a
/Double
9 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double
0, Double
d1, Double
d2],
                                    Double
4forall a. Fractional a => a -> a -> a
/Double
9 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double
0, Double
d1, Double
d2])