{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Geom2D.CubicBezier.Stroke
(penCircle, pathToPen, penStrokeOpen, penStrokeClosed, Pen,
bezierOffset)
where
import Geom2D
import Geom2D.CubicBezier
import Data.Monoid
data Pen a = PenEllipse (Transform a) (Transform a) (Transform a)
| PenPath [PenSegment a]
data PenSegment a = PenCorner !(Point a) !(Point a)
| PenCurve !(Point a) !(CubicBezier a)
penCircle :: (Floating a) => Pen a
penCircle :: forall a. Floating a => Pen a
penCircle = forall a. Transform a -> Transform a -> Transform a -> Pen a
PenEllipse forall a. Num a => Transform a
idTrans forall s. Floating s => Transform s
rotate90L forall s. Floating s => Transform s
rotate90R
{-# SPECIALIZE penCircle :: Pen Double #-}
pathToPen :: (Floating a) => ClosedPath a -> Pen a
pathToPen :: forall a. Floating a => ClosedPath a -> Pen a
pathToPen (ClosedPath []) = forall a. [PenSegment a] -> Pen a
PenPath []
pathToPen (ClosedPath [(Point a, PathJoin a)]
nodes) =
forall a. [PenSegment a] -> Pen a
PenPath forall a b. (a -> b) -> a -> b
$ forall a. Num a => [(Point a, PathJoin a)] -> [PenSegment a]
pathToPen' forall a b. (a -> b) -> a -> b
$ [(Point a, PathJoin a)]
nodes forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
2 [(Point a, PathJoin a)]
nodes
pathToPen' :: Num a => [(Point a, PathJoin a)] -> [PenSegment a]
pathToPen' :: forall a. Num a => [(Point a, PathJoin a)] -> [PenSegment a]
pathToPen' [] = []
pathToPen' [(Point a, PathJoin a)
_] = []
pathToPen' [(Point a, PathJoin a)
_, (Point a, PathJoin a)
_] = []
pathToPen' ((Point a
p, PathJoin a
JoinLine):tl :: [(Point a, PathJoin a)]
tl@((Point a
q, PathJoin a
JoinLine):[(Point a, PathJoin a)]
_)) =
forall a. Point a -> Point a -> PenSegment a
PenCorner (Point a
q forall v. AdditiveGroup v => v -> v -> v
^-^ Point a
p) Point a
q forall a. a -> [a] -> [a]
: forall a. Num a => [(Point a, PathJoin a)] -> [PenSegment a]
pathToPen' [(Point a, PathJoin a)]
tl
pathToPen' ((Point a
_, JoinCurve Point a
_ Point a
_):tl :: [(Point a, PathJoin a)]
tl@((Point a
_, PathJoin a
JoinLine):[(Point a, PathJoin a)]
_)) =
forall a. Num a => [(Point a, PathJoin a)] -> [PenSegment a]
pathToPen' [(Point a, PathJoin a)]
tl
pathToPen' ((Point a
p, PathJoin a
JoinLine):tl :: [(Point a, PathJoin a)]
tl@((Point a
q1, JoinCurve Point a
q2 Point a
q3):(Point a
q4, PathJoin a
_):[(Point a, PathJoin a)]
_)) =
forall a. Point a -> CubicBezier a -> PenSegment a
PenCurve (Point a
q1 forall v. AdditiveGroup v => v -> v -> v
^-^ Point a
p) (forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point a
q1 Point a
q2 Point a
q3 Point a
q4) forall a. a -> [a] -> [a]
:
forall a. Num a => [(Point a, PathJoin a)] -> [PenSegment a]
pathToPen' [(Point a, PathJoin a)]
tl
pathToPen' ((Point a
_, JoinCurve Point a
_ Point a
p3):tl :: [(Point a, PathJoin a)]
tl@((Point a
q1, JoinCurve Point a
q2 Point a
q3):(Point a
q4, PathJoin a
_):[(Point a, PathJoin a)]
_)) =
forall a. Point a -> CubicBezier a -> PenSegment a
PenCurve (Point a
q1 forall v. AdditiveGroup v => v -> v -> v
^-^ Point a
p3) (forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point a
q1 Point a
q2 Point a
q3 Point a
q4) forall a. a -> [a] -> [a]
:
forall a. Num a => [(Point a, PathJoin a)] -> [PenSegment a]
pathToPen' [(Point a, PathJoin a)]
tl
noTranslate :: Num a => Transform a -> Transform a
noTranslate :: forall a. Num a => Transform a -> Transform a
noTranslate (Transform a
a a
b a
_ a
c a
d a
_) =
forall a. a -> a -> a -> a -> a -> a -> Transform a
Transform a
a a
b a
0 a
c a
d a
0
instance (Floating a, Eq a) => AffineTransform (Pen a) a where
{-# SPECIALIZE transform :: Transform Double -> Pen Double -> Pen Double #-}
transform :: Transform a -> Pen a -> Pen a
transform Transform a
t (PenEllipse Transform a
trans Transform a
_ Transform a
_) =
let t2 :: Transform a
t2@(Transform a
a a
b a
c a
d a
e a
f) = forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform a
t Transform a
trans
in case forall a.
(Eq a, Fractional a) =>
Transform a -> Maybe (Transform a)
inverse forall a b. (a -> b) -> a -> b
$ forall a. Num a => Transform a -> Transform a
noTranslate Transform a
t2 of
Maybe (Transform a)
Nothing -> forall a. Floating a => ClosedPath a -> Pen a
pathToPen forall a b. (a -> b) -> a -> b
$
forall a. [(Point a, PathJoin a)] -> ClosedPath a
ClosedPath [
(forall a. a -> a -> Point a
Point a
c a
f forall v. AdditiveGroup v => v -> v -> v
^+^ Point a
p, forall a. PathJoin a
JoinLine),
(forall a. a -> a -> Point a
Point a
c a
f forall v. AdditiveGroup v => v -> v -> v
^-^ Point a
p, forall a. PathJoin a
JoinLine)]
where
p :: Point a
p | a
a forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
&& a
b forall a. Eq a => a -> a -> Bool
/= a
0 =
forall a. Floating a => a -> a
sqrt(a
1 forall a. Num a => a -> a -> a
+ a
aforall a. Num a => a -> a -> a
*a
aforall a. Fractional a => a -> a -> a
/(a
bforall a. Num a => a -> a -> a
*a
b)) forall v. VectorSpace v => Scalar v -> v -> v
*^ forall a. a -> a -> Point a
Point a
a a
d
| a
d forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
&& a
e forall a. Eq a => a -> a -> Bool
/= a
0 =
forall a. Floating a => a -> a
sqrt(a
1 forall a. Num a => a -> a -> a
+ a
dforall a. Num a => a -> a -> a
*a
dforall a. Fractional a => a -> a -> a
/(a
eforall a. Num a => a -> a -> a
*a
e)) forall v. VectorSpace v => Scalar v -> v -> v
*^ forall a. a -> a -> Point a
Point a
a a
d
| a
a forall a. Eq a => a -> a -> Bool
/= a
0 = forall a. a -> a -> Point a
Point (a
aforall a. Num a => a -> a -> a
+a
d) a
0
| a
b forall a. Eq a => a -> a -> Bool
/= a
0 = forall a. a -> a -> Point a
Point a
0 (a
bforall a. Num a => a -> a -> a
+a
e)
| Bool
otherwise = forall a. a -> a -> Point a
Point a
1e-5 a
1e-5
Just Transform a
inv ->
forall a. Transform a -> Transform a -> Transform a -> Pen a
PenEllipse Transform a
t2 (forall a b. AffineTransform a b => Transform b -> a -> a
transform forall s. Floating s => Transform s
rotate90L Transform a
inv) (forall a b. AffineTransform a b => Transform b -> a -> a
transform forall s. Floating s => Transform s
rotate90R Transform a
inv)
transform Transform a
t (PenPath [PenSegment a]
segments) =
forall a. [PenSegment a] -> Pen a
PenPath forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall b. Num b => Transform b -> PenSegment b -> PenSegment b
transformSegment Transform a
t) [PenSegment a]
segments
transformSegment :: Num b => Transform b -> PenSegment b -> PenSegment b
transformSegment :: forall b. Num b => Transform b -> PenSegment b -> PenSegment b
transformSegment Transform b
t (PenCorner Point b
p Point b
q) =
forall a. Point a -> Point a -> PenSegment a
PenCorner (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform b
t (Point b
qforall v. AdditiveGroup v => v -> v -> v
^+^Point b
p) forall v. AdditiveGroup v => v -> v -> v
^-^ Point b
q') Point b
q'
where q' :: Point b
q' = forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform b
t Point b
q
transformSegment Transform b
t (PenCurve Point b
p CubicBezier b
c) =
forall a. Point a -> CubicBezier a -> PenSegment a
PenCurve (forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform b
t (forall a. CubicBezier a -> Point a
cubicC0 CubicBezier b
cforall v. AdditiveGroup v => v -> v -> v
^+^Point b
p) forall v. AdditiveGroup v => v -> v -> v
^-^ forall a. CubicBezier a -> Point a
cubicC0 CubicBezier b
c') CubicBezier b
c'
where c' :: CubicBezier b
c' = forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform b
t CubicBezier b
c
offsetPoint :: (Floating a) => a -> Point a -> Point a -> Point a
offsetPoint :: forall a. Floating a => a -> Point a -> Point a -> Point a
offsetPoint a
dist Point a
start Point a
tangent =
Point a
start forall v. AdditiveGroup v => v -> v -> v
^+^ (forall s. Floating s => Transform s
rotate90L forall a b. AffineTransform a b => Transform b -> a -> a
$* a
dist forall v. VectorSpace v => Scalar v -> v -> v
*^ forall a. Floating a => Point a -> Point a
normVector Point a
tangent)
bezierOffsetPoint :: CubicBezier Double -> Double -> Double -> (DPoint, DPoint)
bezierOffsetPoint :: CubicBezier Double
-> Double -> Double -> (Point Double, Point Double)
bezierOffsetPoint CubicBezier Double
cb Double
dist Double
t = (forall a. Floating a => a -> Point a -> Point a -> Point a
offsetPoint Double
dist Point Double
p Point Double
p', Point Double
p')
where (Point Double
p, Point Double
p') = forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv CubicBezier Double
cb Double
t
bezierOffset :: CubicBezier Double
-> Double
-> Maybe Int
-> Double
-> Bool
-> [CubicBezier Double]
bezierOffset :: CubicBezier Double
-> Double -> Maybe Int -> Double -> Bool -> [CubicBezier Double]
bezierOffset CubicBezier Double
cb Double
dist (Just Int
m) Double
tol Bool
faster =
forall a.
(Unbox a, Floating a, Ord a) =>
Int
-> (a -> (Point a, Point a))
-> Int
-> a
-> a
-> a
-> Bool
-> [CubicBezier a]
approximatePathMax Int
m (CubicBezier Double
-> Double -> Double -> (Point Double, Point Double)
bezierOffsetPoint CubicBezier Double
cb Double
dist) Int
15 Double
tol Double
0 Double
1 Bool
faster
bezierOffset CubicBezier Double
cb Double
dist Maybe Int
Nothing Double
tol Bool
faster =
forall a.
(Unbox a, Ord a, Floating a) =>
(a -> (Point a, Point a))
-> Int -> a -> a -> a -> Bool -> [CubicBezier a]
approximatePath (CubicBezier Double
-> Double -> Double -> (Point Double, Point Double)
bezierOffsetPoint CubicBezier Double
cb Double
dist) Int
15 Double
tol Double
0 Double
1 Bool
faster
penOffset :: Pen Double -> Point Double -> Point Double
penOffset :: Pen Double -> Point Double -> Point Double
penOffset (PenEllipse Transform Double
trans Transform Double
leftInv Transform Double
_) Point Double
dir =
forall a b. AffineTransform a b => Transform b -> a -> a
transform Transform Double
trans forall a b. (a -> b) -> a -> b
$ forall a. Floating a => Point a -> Point a
normVector forall a b. (a -> b) -> a -> b
$ Transform Double
leftInv forall a b. AffineTransform a b => Transform b -> a -> a
$* Point Double
dir
penOffset (PenPath [PenSegment Double]
segments) Point Double
dir =
[PenSegment Double] -> Point Double -> Point Double
pathOffsetPoint (forall a. [a] -> [a]
cycle [PenSegment Double]
segments) Point Double
dir
penOffsetFun :: Pen Double -> (Double -> (DPoint, DPoint)) -> Double -> (Point Double, Point Double)
penOffsetFun :: Pen Double
-> (Double -> (Point Double, Point Double))
-> Double
-> (Point Double, Point Double)
penOffsetFun Pen Double
pen Double -> (Point Double, Point Double)
f Double
t =
(Point Double
px forall v. AdditiveGroup v => v -> v -> v
^+^ Pen Double -> Point Double -> Point Double
penOffset Pen Double
pen Point Double
px', Point Double
px')
where
(Point Double
px, Point Double
px') = Double -> (Point Double, Point Double)
f Double
t
firstPoint :: PenSegment a -> Point a
firstPoint :: forall a. PenSegment a -> Point a
firstPoint (PenCorner Point a
_ Point a
p) = Point a
p
firstPoint (PenCurve Point a
_ CubicBezier a
c) = forall a. CubicBezier a -> Point a
cubicC0 CubicBezier a
c
pathOffsetPoint :: [PenSegment Double] -> Point Double -> Point Double
pathOffsetPoint :: [PenSegment Double] -> Point Double -> Point Double
pathOffsetPoint (PenCorner Point Double
c Point Double
p:PenSegment Double
b:[PenSegment Double]
rest) Point Double
dir
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
dir Point Double
c forall a. Ord a => a -> a -> Bool
> Double
0 = [PenSegment Double] -> Point Double -> Point Double
pathOffsetPoint (PenSegment Double
bforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
dir
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
dir (forall a. PenSegment a -> Point a
firstPoint PenSegment Double
b forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p) forall a. Ord a => a -> a -> Bool
> Double
0 = Point Double
p
| Bool
otherwise = [PenSegment Double] -> Point Double -> Point Double
pathOffsetPoint (PenSegment Double
bforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
dir
pathOffsetPoint (PenCurve Point Double
c curve :: CubicBezier Double
curve@(CubicBezier Point Double
p1 Point Double
p2 Point Double
p3 Point Double
p4):PenSegment Double
b:[PenSegment Double]
rest) Point Double
dir
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
dir Point Double
c forall a. Ord a => a -> a -> Bool
> Double
0 = [PenSegment Double] -> Point Double -> Point Double
pathOffsetPoint (PenSegment Double
bforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
dir
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
dir (Point Double
p2 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p1) forall a. Ord a => a -> a -> Bool
> Double
0 = Point Double
p1
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
dir (Point Double
p3 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p4) forall a. Ord a => a -> a -> Bool
> Double
0 =
case Point Double -> CubicBezier Double -> [Double]
findBezierTangent Point Double
dir CubicBezier Double
curve of
(Double
t:[Double]
_) -> forall (b :: * -> *) a.
(GenericBezier b, Unbox a, Fractional a) =>
b a -> a -> Point a
evalBezier CubicBezier Double
curve Double
t
[] -> Point Double
p4
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
dir (forall a. PenSegment a -> Point a
firstPoint PenSegment Double
b forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p4) forall a. Ord a => a -> a -> Bool
> Double
0 = Point Double
p4
| Bool
otherwise = [PenSegment Double] -> Point Double -> Point Double
pathOffsetPoint (PenSegment Double
bforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
dir
pathOffsetPoint [PenSegment Double]
_ Point Double
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"unexpected end of list"
segDirs :: [(DPoint, PathJoin Double)] -> Point Double -> [(DPoint, DPoint)]
segDirs :: [(Point Double, PathJoin Double)]
-> Point Double -> [(Point Double, Point Double)]
segDirs [] Point Double
_ = []
segDirs [(Point Double
p, PathJoin Double
JoinLine)] Point Double
q = [(Point Double
dp, Point Double
dp)]
where dp :: Point Double
dp = Point Double
q forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p
segDirs [(Point Double
p1, JoinCurve Point Double
p2 Point Double
p3 )] Point Double
p4 = [(Point Double
p2 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p1, Point Double
p4 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p3)]
segDirs ((Point Double
p, PathJoin Double
JoinLine):r :: [(Point Double, PathJoin Double)]
r@((Point Double
q, PathJoin Double
_):[(Point Double, PathJoin Double)]
_)) Point Double
s = (Point Double
dp, Point Double
dp)forall a. a -> [a] -> [a]
: [(Point Double, PathJoin Double)]
-> Point Double -> [(Point Double, Point Double)]
segDirs [(Point Double, PathJoin Double)]
r Point Double
s
where dp :: Point Double
dp = Point Double
q forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p
segDirs ((Point Double
p1, JoinCurve Point Double
p2 Point Double
p3 ):r :: [(Point Double, PathJoin Double)]
r@((Point Double
p4,PathJoin Double
_):[(Point Double, PathJoin Double)]
_)) Point Double
q = (Point Double
p2 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p1, Point Double
p4 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p3)forall a. a -> [a] -> [a]
:[(Point Double, PathJoin Double)]
-> Point Double -> [(Point Double, Point Double)]
segDirs [(Point Double, PathJoin Double)]
r Point Double
q
penStrokeOpen :: Int -> Double -> Bool -> Pen Double -> OpenPath Double -> [ClosedPath Double]
penStrokeOpen :: Int
-> Double
-> Bool
-> Pen Double
-> OpenPath Double
-> [ClosedPath Double]
penStrokeOpen Int
samples Double
tol Bool
fast Pen Double
pen (OpenPath [(Point Double, PathJoin Double)]
segments Point Double
p) =
[ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
union [forall a. OpenPath a -> ClosedPath a
closeOpenPath OpenPath Double
path] FillRule
NonZero Double
tol
where
dirs :: [(Point Double, Point Double)]
dirs = [(Point Double, PathJoin Double)]
-> Point Double -> [(Point Double, Point Double)]
segDirs [(Point Double, PathJoin Double)]
segments (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Point Double, PathJoin Double)]
segments)
fdirs :: [Point Double]
fdirs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. [a] -> [a]
tail [(Point Double, Point Double)]
dirs)
fd :: Point Double
fd = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Point Double, Point Double)]
dirs
ld :: Point Double
ld = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [(Point Double, Point Double)]
dirs
ldirs :: [Point Double]
ldirs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Point Double, Point Double)]
dirs
pts :: [Point Double]
pts = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. [a] -> [a]
tail [(Point Double, PathJoin Double)]
segments) forall a. [a] -> [a] -> [a]
++ [Point Double
p]
leftJoins :: [OpenPath Double]
leftJoins = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoinLeft Pen Double
pen) [Point Double]
ldirs [Point Double]
fdirs
leftStrokes :: [OpenPath Double]
leftStrokes = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int
-> Double
-> Bool
-> Pen Double
-> (Point Double, PathJoin Double)
-> Point Double
-> OpenPath Double
strokeLeft Int
samples Double
tol Bool
fast Pen Double
pen) [(Point Double, PathJoin Double)]
segments [Point Double]
pts
rightJoins :: [OpenPath Double]
rightJoins = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoinRight Pen Double
pen) [Point Double]
ldirs [Point Double]
fdirs
rightStrokes :: [OpenPath Double]
rightStrokes = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int
-> Double
-> Bool
-> Pen Double
-> (Point Double, PathJoin Double)
-> Point Double
-> OpenPath Double
strokeRight Int
samples Double
tol Bool
fast Pen Double
pen) [(Point Double, PathJoin Double)]
segments [Point Double]
pts
path :: OpenPath Double
path =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoinLeft Pen Double
pen (forall a. Num a => Point a -> Point a
turnAround Point Double
fd) Point Double
fd forall a. a -> [a] -> [a]
:
forall a. [a] -> [a] -> [a]
interleave [OpenPath Double]
leftStrokes [OpenPath Double]
leftJoins forall a. [a] -> [a] -> [a]
++
Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoinLeft Pen Double
pen Point Double
ld (forall a. Num a => Point a -> Point a
turnAround Point Double
ld) forall a. a -> [a] -> [a]
:
forall a. [a] -> [a]
reverse (forall a. [a] -> [a] -> [a]
interleave [OpenPath Double]
rightStrokes [OpenPath Double]
rightJoins)
interleave :: [a] -> [a] -> [a]
interleave :: forall a. [a] -> [a] -> [a]
interleave [] [a]
xs = [a]
xs
interleave [a]
xs [] = [a]
xs
interleave (a
x:[a]
xs) (a
y:[a]
ys) = a
xforall a. a -> [a] -> [a]
:a
yforall a. a -> [a] -> [a]
:forall a. [a] -> [a] -> [a]
interleave [a]
xs [a]
ys
penStrokeClosed :: Int -> Double -> Bool -> Pen Double -> ClosedPath Double
-> [ClosedPath Double]
penStrokeClosed :: Int
-> Double
-> Bool
-> Pen Double
-> ClosedPath Double
-> [ClosedPath Double]
penStrokeClosed Int
_ Double
_ Bool
_ Pen Double
_ (ClosedPath []) = [forall a. [(Point a, PathJoin a)] -> ClosedPath a
ClosedPath []]
penStrokeClosed Int
samples Double
tol Bool
fast Pen Double
pen (ClosedPath [(Point Double, PathJoin Double)]
segments) =
[ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
union [forall a. OpenPath a -> ClosedPath a
closeOpenPath OpenPath Double
leftPath, forall a. OpenPath a -> ClosedPath a
closeOpenPath OpenPath Double
rightPath] FillRule
NonZero Double
tol
where
dirs :: [(Point Double, Point Double)]
dirs = [(Point Double, PathJoin Double)]
-> Point Double -> [(Point Double, Point Double)]
segDirs [(Point Double, PathJoin Double)]
segments (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Point Double, PathJoin Double)]
segments)
fdirs :: [Point Double]
fdirs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. [a] -> [a]
tail [(Point Double, Point Double)]
dirs) forall a. [a] -> [a] -> [a]
++ [forall a b. (a, b) -> a
fst (forall a. [a] -> a
head [(Point Double, Point Double)]
dirs)]
ldirs :: [Point Double]
ldirs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Point Double, Point Double)]
dirs
pts :: [Point Double]
pts = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. [a] -> [a]
tail [(Point Double, PathJoin Double)]
segments) forall a. [a] -> [a] -> [a]
++ [forall a b. (a, b) -> a
fst (forall a. [a] -> a
head [(Point Double, PathJoin Double)]
segments)]
leftJoins :: [OpenPath Double]
leftJoins = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoinLeft Pen Double
pen) [Point Double]
ldirs [Point Double]
fdirs
leftStrokes :: [OpenPath Double]
leftStrokes = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int
-> Double
-> Bool
-> Pen Double
-> (Point Double, PathJoin Double)
-> Point Double
-> OpenPath Double
strokeLeft Int
samples Double
tol Bool
fast Pen Double
pen) [(Point Double, PathJoin Double)]
segments [Point Double]
pts
rightJoins :: [OpenPath Double]
rightJoins = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoinRight Pen Double
pen) [Point Double]
ldirs [Point Double]
fdirs
rightStrokes :: [OpenPath Double]
rightStrokes = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int
-> Double
-> Bool
-> Pen Double
-> (Point Double, PathJoin Double)
-> Point Double
-> OpenPath Double
strokeRight Int
samples Double
tol Bool
fast Pen Double
pen) [(Point Double, PathJoin Double)]
segments [Point Double]
pts
leftPath :: OpenPath Double
leftPath =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a] -> [a]
interleave [OpenPath Double]
leftStrokes [OpenPath Double]
leftJoins
rightPath :: OpenPath Double
rightPath =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a] -> [a]
interleave [OpenPath Double]
rightStrokes [OpenPath Double]
rightJoins
strokeLeft :: Int -> Double -> Bool -> Pen Double -> (DPoint, PathJoin Double) -> DPoint -> OpenPath Double
strokeLeft :: Int
-> Double
-> Bool
-> Pen Double
-> (Point Double, PathJoin Double)
-> Point Double
-> OpenPath Double
strokeLeft Int
_ Double
_ Bool
_ Pen Double
pen (Point Double
p, PathJoin Double
JoinLine) Point Double
q =
forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [(Point Double
p forall v. AdditiveGroup v => v -> v -> v
^+^ Point Double
offset, forall a. PathJoin a
JoinLine)] (Point Double
q forall v. AdditiveGroup v => v -> v -> v
^+^ Point Double
offset)
where offset :: Point Double
offset = Pen Double -> Point Double -> Point Double
penOffset Pen Double
pen (Point Double
q forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p)
strokeLeft Int
samples Double
tol Bool
fast Pen Double
pen (Point Double
p1, JoinCurve Point Double
p2 Point Double
p3) Point Double
p4 =
forall a. [CubicBezier a] -> OpenPath a
curvesToOpen forall a b. (a -> b) -> a -> b
$ forall a.
(Unbox a, Ord a, Floating a) =>
(a -> (Point a, Point a))
-> Int -> a -> a -> a -> Bool -> [CubicBezier a]
approximatePath
(Pen Double
-> (Double -> (Point Double, Point Double))
-> Double
-> (Point Double, Point Double)
penOffsetFun Pen Double
pen (forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv (forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point Double
p1 Point Double
p2 Point Double
p3 Point Double
p4)))
Int
samples Double
tol Double
0 Double
1 Bool
fast
strokeRight :: Int -> Double -> Bool -> Pen Double -> (DPoint, PathJoin Double) -> DPoint -> OpenPath Double
strokeRight :: Int
-> Double
-> Bool
-> Pen Double
-> (Point Double, PathJoin Double)
-> Point Double
-> OpenPath Double
strokeRight Int
_ Double
_ Bool
_ Pen Double
pen (Point Double
p, PathJoin Double
JoinLine) Point Double
q =
forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [(Point Double
q forall v. AdditiveGroup v => v -> v -> v
^+^ Point Double
offset, forall a. PathJoin a
JoinLine)] (Point Double
p forall v. AdditiveGroup v => v -> v -> v
^+^ Point Double
offset)
where offset :: Point Double
offset = Pen Double -> Point Double -> Point Double
penOffset Pen Double
pen (Point Double
p forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
q)
strokeRight Int
samples Double
tol Bool
fast Pen Double
pen (Point Double
p1, JoinCurve Point Double
p2 Point Double
p3) Point Double
p4 =
forall a. [CubicBezier a] -> OpenPath a
curvesToOpen forall a b. (a -> b) -> a -> b
$ forall a.
(Unbox a, Ord a, Floating a) =>
(a -> (Point a, Point a))
-> Int -> a -> a -> a -> Bool -> [CubicBezier a]
approximatePath
(Pen Double
-> (Double -> (Point Double, Point Double))
-> Double
-> (Point Double, Point Double)
penOffsetFun Pen Double
pen (forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv (forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
CubicBezier Point Double
p4 Point Double
p3 Point Double
p2 Point Double
p1)))
Int
samples Double
tol Double
0 Double
1 Bool
fast
penJoinLeft :: Pen Double -> DPoint -> DPoint -> OpenPath Double
penJoinLeft :: Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoinLeft = Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoin
penJoinRight :: Pen Double -> DPoint -> DPoint -> OpenPath Double
penJoinRight :: Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoinRight Pen Double
pen Point Double
from Point Double
to = Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoin Pen Double
pen (forall a. Num a => Point a -> Point a
turnAround Point Double
to) (forall a. Num a => Point a -> Point a
turnAround Point Double
from)
ellipticArc :: Transform Double -> Transform Double
-> Point Double -> Point Double -> CubicBezier Double
ellipticArc :: Transform Double
-> Transform Double
-> Point Double
-> Point Double
-> CubicBezier Double
ellipticArc Transform Double
trans Transform Double
leftInv Point Double
from Point Double
to =
Transform Double
trans forall a b. AffineTransform a b => Transform b -> a -> a
$* Double -> Double -> CubicBezier Double
bezierArc
(forall a. RealFloat a => Point a -> a
vectorAngle forall a b. (a -> b) -> a -> b
$ Transform Double
leftInv forall a b. AffineTransform a b => Transform b -> a -> a
$* Point Double
from)
(forall a. RealFloat a => Point a -> a
vectorAngle forall a b. (a -> b) -> a -> b
$ Transform Double
leftInv forall a b. AffineTransform a b => Transform b -> a -> a
$* Point Double
to)
segmentsToPath :: (Eq a) => [PenSegment a] -> OpenPath a
segmentsToPath :: forall a. Eq a => [PenSegment a] -> OpenPath a
segmentsToPath [PenCorner Point a
_ Point a
q] =
forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [] Point a
q
segmentsToPath [PenCurve Point a
_ (CubicBezier Point a
p1 Point a
p2 Point a
p3 Point a
p4)] =
forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [(Point a
p1, forall a. Point a -> Point a -> PathJoin a
JoinCurve Point a
p2 Point a
p3)] Point a
p4
segmentsToPath (PenCorner Point a
_ Point a
p:[PenSegment a]
r) =
forall a. Point a -> PathJoin a -> OpenPath a -> OpenPath a
consOpenPath Point a
p forall a. PathJoin a
JoinLine (forall a. Eq a => [PenSegment a] -> OpenPath a
segmentsToPath [PenSegment a]
r)
segmentsToPath (PenCurve Point a
_ (CubicBezier Point a
p1 Point a
p2 Point a
p3 Point a
p4):[PenSegment a]
r) =
forall a. Point a -> PathJoin a -> OpenPath a -> OpenPath a
consOpenPath Point a
p1 (forall a. Point a -> Point a -> PathJoin a
JoinCurve Point a
p2 Point a
p3) forall a b. (a -> b) -> a -> b
$
case [PenSegment a]
r of
(PenCurve Point a
_ (CubicBezier Point a
q1 Point a
_ Point a
_ Point a
_):[PenSegment a]
_)
| Point a
p4 forall a. Eq a => a -> a -> Bool
/= Point a
q1 -> forall a. Point a -> PathJoin a -> OpenPath a -> OpenPath a
consOpenPath Point a
p4 forall a. PathJoin a
JoinLine forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [PenSegment a] -> OpenPath a
segmentsToPath [PenSegment a]
r
[PenSegment a]
_ -> forall a. Eq a => [PenSegment a] -> OpenPath a
segmentsToPath [PenSegment a]
r
segmentsToPath [] = forall a. OpenPath a
emptyOpenPath
emptyOpenPath :: OpenPath a
emptyOpenPath :: forall a. OpenPath a
emptyOpenPath = forall a. [(Point a, PathJoin a)] -> Point a -> OpenPath a
OpenPath [] (forall a. HasCallStack => [Char] -> a
error [Char]
"empty path")
penJoin :: Pen Double -> Point Double
-> Point Double -> OpenPath Double
penJoin :: Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoin pen :: Pen Double
pen@(PenEllipse Transform Double
trans Transform Double
leftInv Transform Double
_) Point Double
from Point Double
to
| Double
dir forall a. Eq a => a -> a -> Bool
== Double
0 = forall a. OpenPath a
emptyOpenPath
| Double
dir forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&&
forall a. (Num a, Eq a) => Point a -> Point a -> Bool
sameQuadrant Point Double
from Point Double
to =
forall a. [CubicBezier a] -> OpenPath a
curvesToOpen [Transform Double
-> Transform Double
-> Point Double
-> Point Double
-> CubicBezier Double
ellipticArc Transform Double
trans Transform Double
leftInv Point Double
from Point Double
to]
| Bool
otherwise =
forall a. [CubicBezier a] -> OpenPath a
curvesToOpen [Transform Double
-> Transform Double
-> Point Double
-> Point Double
-> CubicBezier Double
ellipticArc Transform Double
trans Transform Double
leftInv Point Double
from Point Double
next] forall a. Semigroup a => a -> a -> a
<>
Pen Double -> Point Double -> Point Double -> OpenPath Double
penJoin Pen Double
pen Point Double
next Point Double
to
where next :: Point Double
next = forall a1 a. (Ord a1, Num a1, Num a) => Point a1 -> Point a
nextVector Point Double
from
dir :: Double
dir = forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
from Point Double
to
penJoin (PenPath [PenSegment Double]
segments) Point Double
from Point Double
to =
forall a. Eq a => [PenSegment a] -> OpenPath a
segmentsToPath forall a b. (a -> b) -> a -> b
$
[PenSegment Double] -> Point Double -> [PenSegment Double]
nextSegments ([PenSegment Double] -> Point Double -> [PenSegment Double]
firstSegment (forall a. [a] -> [a]
cycle [PenSegment Double]
segments) Point Double
from) Point Double
to
firstSegment :: [PenSegment Double] -> Point Double -> [PenSegment Double]
firstSegment :: [PenSegment Double] -> Point Double -> [PenSegment Double]
firstSegment segments :: [PenSegment Double]
segments@(PenCorner Point Double
c Point Double
_:PenSegment Double
q:[PenSegment Double]
rest) Point Double
from
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
from Point Double
c forall a. Ord a => a -> a -> Bool
> Double
0 =
[PenSegment Double] -> Point Double -> [PenSegment Double]
firstSegment (PenSegment Double
qforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
from
| Bool
otherwise = [PenSegment Double]
segments
firstSegment segments :: [PenSegment Double]
segments@(PenCurve Point Double
c curve :: CubicBezier Double
curve@(CubicBezier Point Double
p1 Point Double
p2 Point Double
p3 Point Double
p4):PenSegment Double
q:[PenSegment Double]
rest) Point Double
from
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
from Point Double
c forall a. Ord a => a -> a -> Bool
> Double
0 = [PenSegment Double] -> Point Double -> [PenSegment Double]
firstSegment (PenSegment Double
qforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
from
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
from (Point Double
p2 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p1) forall a. Ord a => a -> a -> Bool
> Double
0 = [PenSegment Double]
segments
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
from (Point Double
p4 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p3) forall a. Ord a => a -> a -> Bool
> Double
0 =
case Point Double -> CubicBezier Double -> [Double]
findBezierTangent Point Double
from CubicBezier Double
curve of
(Double
t:[Double]
_) -> forall a. Point a -> CubicBezier a -> PenSegment a
PenCurve Point Double
from (forall a b. (a, b) -> b
snd (forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (b a, b a)
splitBezier CubicBezier Double
curve Double
t))forall a. a -> [a] -> [a]
:PenSegment Double
qforall a. a -> [a] -> [a]
:[PenSegment Double]
rest
[Double]
_ -> PenSegment Double
qforall a. a -> [a] -> [a]
:[PenSegment Double]
rest
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
from (forall a. PenSegment a -> Point a
firstPoint PenSegment Double
q forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p4) forall a. Ord a => a -> a -> Bool
> Double
0 =
forall a. Point a -> Point a -> PenSegment a
PenCorner (forall a. PenSegment a -> Point a
firstPoint PenSegment Double
q forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p4) Point Double
p4forall a. a -> [a] -> [a]
:PenSegment Double
qforall a. a -> [a] -> [a]
:[PenSegment Double]
rest
| Bool
otherwise = [PenSegment Double] -> Point Double -> [PenSegment Double]
firstSegment (PenSegment Double
qforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
from
firstSegment [PenSegment Double]
_ Point Double
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"firstsegment: finite list"
nextSegments :: [PenSegment Double] -> Point Double -> [PenSegment Double]
nextSegments :: [PenSegment Double] -> Point Double -> [PenSegment Double]
nextSegments (PenCorner Point Double
c Point Double
p:PenSegment Double
q:[PenSegment Double]
rest) Point Double
to
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
to Point Double
c forall a. Ord a => a -> a -> Bool
> Double
0 =
forall a. Point a -> Point a -> PenSegment a
PenCorner Point Double
c Point Double
pforall a. a -> [a] -> [a]
: [PenSegment Double] -> Point Double -> [PenSegment Double]
nextSegments (PenSegment Double
qforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
to
| Bool
otherwise = []
nextSegments (pc :: PenSegment Double
pc@(PenCurve Point Double
c curve :: CubicBezier Double
curve@(CubicBezier Point Double
p1 Point Double
p2 Point Double
p3 Point Double
p4)):PenSegment Double
q:[PenSegment Double]
rest) Point Double
to
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
to Point Double
c forall a. Ord a => a -> a -> Bool
> Double
0 = PenSegment Double
pcforall a. a -> [a] -> [a]
: [PenSegment Double] -> Point Double -> [PenSegment Double]
nextSegments (PenSegment Double
qforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
to
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
to (Point Double
p2 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p1) forall a. Ord a => a -> a -> Bool
> Double
0 = []
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
to (Point Double
p4 forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p3) forall a. Ord a => a -> a -> Bool
> Double
0 =
case Point Double -> CubicBezier Double -> [Double]
findBezierTangent Point Double
to CubicBezier Double
curve of
(Double
t:[Double]
_) -> [forall a. Point a -> CubicBezier a -> PenSegment a
PenCurve Point Double
c (forall a b. (a, b) -> a
fst (forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (b a, b a)
splitBezier CubicBezier Double
curve Double
t))]
[Double]
_ -> []
| forall a. Num a => Point a -> Point a -> a
vectorCross Point Double
to (forall a. PenSegment a -> Point a
firstPoint PenSegment Double
q forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p4) forall a. Ord a => a -> a -> Bool
> Double
0 =
[forall a. Point a -> Point a -> PenSegment a
PenCorner (forall a. PenSegment a -> Point a
firstPoint PenSegment Double
q forall v. AdditiveGroup v => v -> v -> v
^-^ Point Double
p4) Point Double
p4]
| Bool
otherwise = PenSegment Double
pcforall a. a -> [a] -> [a]
:[PenSegment Double] -> Point Double -> [PenSegment Double]
firstSegment (PenSegment Double
qforall a. a -> [a] -> [a]
:[PenSegment Double]
rest) Point Double
to
nextSegments [PenSegment Double]
_ Point Double
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"nextSegments: finite list"
sameQuadrant :: (Num a, Eq a) => Point a -> Point a -> Bool
sameQuadrant :: forall a. (Num a, Eq a) => Point a -> Point a -> Bool
sameQuadrant Point a
v Point a
w =
forall a. Num a => a -> a
signum (forall a. Point a -> a
pointX Point a
v) forall a. Eq a => a -> a -> Bool
/= -forall a. Num a => a -> a
signum (forall a. Point a -> a
pointX Point a
w) Bool -> Bool -> Bool
&&
forall a. Num a => a -> a
signum (forall a. Point a -> a
pointY Point a
v) forall a. Eq a => a -> a -> Bool
/= -forall a. Num a => a -> a
signum (forall a. Point a -> a
pointY Point a
w)
nextVector :: (Ord a1, Num a1, Num a) => Point a1 -> Point a
nextVector :: forall a1 a. (Ord a1, Num a1, Num a) => Point a1 -> Point a
nextVector Point a1
v
| forall a. Point a -> a
pointX Point a1
v forall a. Ord a => a -> a -> Bool
>= a1
0 Bool -> Bool -> Bool
&&
forall a. Point a -> a
pointY Point a1
v forall a. Ord a => a -> a -> Bool
> a1
0 = forall a. a -> a -> Point a
Point a
1 a
0
| forall a. Point a -> a
pointX Point a1
v forall a. Ord a => a -> a -> Bool
> a1
0 Bool -> Bool -> Bool
&&
forall a. Point a -> a
pointY Point a1
v forall a. Ord a => a -> a -> Bool
<= a1
0 = forall a. a -> a -> Point a
Point a
0 (-a
1)
| forall a. Point a -> a
pointX Point a1
v forall a. Ord a => a -> a -> Bool
<= a1
0 Bool -> Bool -> Bool
&&
forall a. Point a -> a
pointY Point a1
v forall a. Ord a => a -> a -> Bool
< a1
0 = forall a. a -> a -> Point a
Point (-a
1) a
0
| Bool
otherwise = forall a. a -> a -> Point a
Point a
0 a
1