{-# 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
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)
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)
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)
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
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)
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
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)
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
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
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
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
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
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) #-}
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 #-}
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
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 :: (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 #-}
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
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 #-}
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 :: 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)
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)
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)
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
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 :: 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 :: 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 :: 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
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)
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
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) #-}
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) #-}
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 #-}
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 #-}
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 #-}
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)
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 =
- (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
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''
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)
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)
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
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
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
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
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
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])