module Graphics.Rasterific.StrokeInternal
( flatten
, dashize
, strokize
, dashedStrokize
, splitPrimitiveUntil
, approximatePathLength
, isPrimitivePoint
, sanitize
, sanitizeFilling
) where
import Graphics.Rasterific.Linear
( V2( .. )
, (^-^)
, (^+^)
, (^*)
, dot
, nearZero
)
import Graphics.Rasterific.Operators
import Graphics.Rasterific.Types
import Graphics.Rasterific.QuadraticBezier
import Graphics.Rasterific.CubicBezier
import Graphics.Rasterific.Line
lastPoint :: Primitive -> Point
lastPoint :: Primitive -> Point
lastPoint (LinePrim (Line Point
_ Point
x1)) = Point
x1
lastPoint (BezierPrim (Bezier Point
_ Point
_ Point
x2)) = Point
x2
lastPoint (CubicBezierPrim (CubicBezier Point
_ Point
_ Point
_ Point
x3)) = Point
x3
lastPointAndNormal :: Primitive -> (Point, Vector)
lastPointAndNormal :: Primitive -> (Point, Point)
lastPointAndNormal (LinePrim (Line Point
a Point
b)) = (Point
b, Point
a Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
b)
lastPointAndNormal (BezierPrim (Bezier Point
_ Point
b Point
c)) = (Point
c, Point
b Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
c)
lastPointAndNormal (CubicBezierPrim (CubicBezier Point
_ Point
_ Point
c Point
d)) = (Point
d, Point
c Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
d)
firstPointAndNormal :: Primitive -> (Point, Vector)
firstPointAndNormal :: Primitive -> (Point, Point)
firstPointAndNormal (LinePrim (Line Point
a Point
b)) = (Point
a, Point
a Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
b)
firstPointAndNormal (BezierPrim (Bezier Point
a Point
b Point
_)) = (Point
a, Point
a Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
b)
firstPointAndNormal (CubicBezierPrim (CubicBezier Point
a Point
b Point
_ Point
_)) = (Point
a, Point
a Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
b)
isPrimitivePoint :: Primitive -> Bool
isPrimitivePoint :: Primitive -> Bool
isPrimitivePoint Primitive
p = case Primitive
p of
LinePrim Line
l -> Line -> Bool
isLinePoint Line
l
BezierPrim Bezier
b -> Bezier -> Bool
isBezierPoint Bezier
b
CubicBezierPrim CubicBezier
c -> CubicBezier -> Bool
isCubicBezierPoint CubicBezier
c
reversePrimitive :: Primitive -> Primitive
reversePrimitive :: Primitive -> Primitive
reversePrimitive (LinePrim (Line Point
a Point
b)) = Line -> Primitive
LinePrim (Point -> Point -> Line
Line Point
b Point
a)
reversePrimitive (BezierPrim (Bezier Point
a Point
b Point
c)) =
Bezier -> Primitive
BezierPrim (Point -> Point -> Point -> Bezier
Bezier Point
c Point
b Point
a)
reversePrimitive (CubicBezierPrim (CubicBezier Point
a Point
b Point
c Point
d)) =
CubicBezier -> Primitive
CubicBezierPrim (Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
d Point
c Point
b Point
a)
roundJoin :: Float -> Point -> Vector -> Vector -> Container Primitive
roundJoin :: Float -> Point -> Point -> Point -> Container Primitive
roundJoin Float
offset Point
p = Point -> Point -> Container Primitive
forall (f :: * -> *).
(Applicative f, Semigroup (f Primitive)) =>
Point -> Point -> f Primitive
go
where go :: Point -> Point -> f Primitive
go Point
u Point
v
| Point
u Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Point
w Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0.9 = Primitive -> f Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> f Primitive)
-> (Bezier -> Primitive) -> Bezier -> f Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bezier -> Primitive
BezierPrim (Bezier -> f Primitive) -> Bezier -> f Primitive
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point -> Bezier
Bezier Point
a Point
b Point
c
| Bool
otherwise = Point -> Point -> f Primitive
go Point
u Point
w f Primitive -> f Primitive -> f Primitive
forall a. Semigroup a => a -> a -> a
<> Point -> Point -> f Primitive
go Point
w Point
v
where
a :: Point
a = Point
p Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
u Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
offset
c :: Point
c = Point
p Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
v Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
offset
w :: Point
w = (Point
a Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
c) Point -> Point -> Point
forall v. Epsilon v => v -> v -> v
`ifZero` Point
u
n :: Point
n = Point
p Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
w Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
offset
b :: Point
b = Point
n Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
2 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ (Point
a Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
c)
cap :: Float -> Cap -> Primitive -> Container Primitive
cap :: Float -> Cap -> Primitive -> Container Primitive
cap Float
offset Cap
CapRound Primitive
prim
| Point -> Bool
forall a. Epsilon a => a -> Bool
nearZero Point
u = Float -> Cap -> Primitive -> Container Primitive
cap Float
offset (Float -> Cap
CapStraight Float
0) Primitive
prim
| Bool
otherwise = Float -> Point -> Point -> Point -> Container Primitive
roundJoin Float
offset Point
p Point
u (- Point
u)
where (Point
p, Point
u) = Primitive -> (Point, Point)
lastPointAndNormal Primitive
prim
cap Float
offset (CapStraight Float
cVal) Primitive
prim =
Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point
d Point -> Point -> Primitive
`lineFromTo` Point
e) Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<> Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point
e Point -> Point -> Primitive
`lineFromTo` Point
f)
Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<> Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point
f Point -> Point -> Primitive
`lineFromTo` Point
g)
where
(Point
p, u :: Point
u@(V2 Float
ux Float
uy)) = Primitive -> (Point, Point)
lastPointAndNormal Primitive
prim
v :: Point
v = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
uy (Float -> Point) -> Float -> Point
forall a b. (a -> b) -> a -> b
$ Float -> Float
forall a. Num a => a -> a
negate Float
ux
d :: Point
d = Point
p Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
u Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
offset
g :: Point
g = Point
p Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
u Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
offset
e :: Point
e = Point
d Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
v Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (Float
offset Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cVal)
f :: Point
f = Point
g Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
v Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (Float
offset Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cVal)
lineFromTo :: Point -> Point -> Primitive
lineFromTo :: Point -> Point -> Primitive
lineFromTo Point
a Point
b = Line -> Primitive
LinePrim (Point -> Point -> Line
Line Point
a Point
b)
miterJoin :: Float -> Float -> Point -> Vector -> Vector
-> Container Primitive
miterJoin :: Float -> Float -> Point -> Point -> Point -> Container Primitive
miterJoin Float
offset Float
l Point
point Point
u Point
v
| Float
uDotW Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
l Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 Float
l Bool -> Bool -> Bool
&& Float
uDotW Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.01 =
Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point
a Point -> Point -> Primitive
`lineFromTo` Point
m) Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<> Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point
m Point -> Point -> Primitive
`lineFromTo` Point
c)
| Bool
otherwise = Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> Container Primitive)
-> Primitive -> Container Primitive
forall a b. (a -> b) -> a -> b
$ Point
a Point -> Point -> Primitive
`lineFromTo` Point
c
where
a :: Point
a = Point
point Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
u Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
offset
c :: Point
c = Point
point Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
v Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
offset
w :: Point
w = (Point
a Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
c) Point -> Point -> Point
forall v. Epsilon v => v -> v -> v
`ifZero` Point
u
uDotW :: Float
uDotW = Point
u Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Point
w
p :: Float
p = Float
offset Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
uDotW
m :: Point
m = Point
point Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Point
w Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
p
joinPrimitives :: StrokeWidth -> Join -> Primitive -> Primitive
-> Container Primitive
joinPrimitives :: Float -> Join -> Primitive -> Primitive -> Container Primitive
joinPrimitives Float
offset Join
join Primitive
prim1 Primitive
prim2 =
case Join
join of
Join
JoinRound | Point -> Bool
forall a. Epsilon a => a -> Bool
nearZero Point
u Bool -> Bool -> Bool
|| Point -> Bool
forall a. Epsilon a => a -> Bool
nearZero Point
v -> Float -> Float -> Point -> Point -> Point -> Container Primitive
miterJoin Float
offset Float
0 Point
p Point
u Point
v
Join
JoinRound -> Float -> Point -> Point -> Point -> Container Primitive
roundJoin Float
offset Point
p Point
u Point
v
JoinMiter Float
l -> Float -> Float -> Point -> Point -> Point -> Container Primitive
miterJoin Float
offset Float
l Point
p Point
u Point
v
where (Point
p, Point
u) = Primitive -> (Point, Point)
lastPointAndNormal Primitive
prim1
(Point
_, Point
v) = Primitive -> (Point, Point)
firstPointAndNormal Primitive
prim2
offsetPrimitives :: Float -> Primitive -> Container Primitive
offsetPrimitives :: Float -> Primitive -> Container Primitive
offsetPrimitives Float
offset (LinePrim Line
l) = Float -> Line -> Container Primitive
offsetLine Float
offset Line
l
offsetPrimitives Float
offset (BezierPrim Bezier
b) = Float -> Bezier -> Container Primitive
offsetBezier Float
offset Bezier
b
offsetPrimitives Float
offset (CubicBezierPrim CubicBezier
c) = Float -> CubicBezier -> Container Primitive
offsetCubicBezier Float
offset CubicBezier
c
offsetAndJoin :: Float -> Join -> Cap -> [Primitive]
-> Container Primitive
offsetAndJoin :: Float -> Join -> Cap -> [Primitive] -> Container Primitive
offsetAndJoin Float
_ Join
_ Cap
_ [] = Container Primitive
forall a. Monoid a => a
mempty
offsetAndJoin Float
offset Join
join Cap
caping (Primitive
firstShape:[Primitive]
rest) = Primitive -> [Primitive] -> Container Primitive
go Primitive
firstShape [Primitive]
rest
where joiner :: Primitive -> Primitive -> Container Primitive
joiner = Float -> Join -> Primitive -> Primitive -> Container Primitive
joinPrimitives Float
offset Join
join
offseter :: Primitive -> Container Primitive
offseter = Float -> Primitive -> Container Primitive
offsetPrimitives Float
offset
(Point
firstPoint, Point
_) = Primitive -> (Point, Point)
firstPointAndNormal Primitive
firstShape
go :: Primitive -> [Primitive] -> Container Primitive
go Primitive
prev []
| Point
firstPoint Point -> Point -> Bool
`isNearby` Primitive -> Point
lastPoint Primitive
prev = Primitive -> Container Primitive
offseter Primitive
prev Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<> Primitive -> Primitive -> Container Primitive
joiner Primitive
prev Primitive
firstShape
| Bool
otherwise = Primitive -> Container Primitive
offseter Primitive
prev Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<> Float -> Cap -> Primitive -> Container Primitive
cap Float
offset Cap
caping Primitive
prev
go Primitive
prev (Primitive
x:[Primitive]
xs) =
Primitive -> Container Primitive
offseter Primitive
prev Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<> Primitive -> Primitive -> Container Primitive
joiner Primitive
prev Primitive
x Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<> Primitive -> [Primitive] -> Container Primitive
go Primitive
x [Primitive]
xs
approximateLength :: Primitive -> Float
approximateLength :: Primitive -> Float
approximateLength (LinePrim Line
l) = Line -> Float
lineLength Line
l
approximateLength (BezierPrim Bezier
b) = Bezier -> Float
bezierLengthApproximation Bezier
b
approximateLength (CubicBezierPrim CubicBezier
c) = CubicBezier -> Float
cubicBezierLengthApproximation CubicBezier
c
sanitize :: Primitive -> Container Primitive
sanitize :: Primitive -> Container Primitive
sanitize (LinePrim Line
l) = Line -> Container Primitive
sanitizeLine Line
l
sanitize (BezierPrim Bezier
b) = Bezier -> Container Primitive
sanitizeBezier Bezier
b
sanitize (CubicBezierPrim CubicBezier
c) = CubicBezier -> Container Primitive
sanitizeCubicBezier CubicBezier
c
sanitizeFilling :: Primitive -> Container Primitive
sanitizeFilling :: Primitive -> Container Primitive
sanitizeFilling (LinePrim Line
l) = Line -> Container Primitive
sanitizeLineFilling Line
l
sanitizeFilling (BezierPrim Bezier
b) = Bezier -> Container Primitive
sanitizeBezierFilling Bezier
b
sanitizeFilling (CubicBezierPrim CubicBezier
c) = CubicBezier -> Container Primitive
sanitizeCubicBezierFilling CubicBezier
c
strokize :: Geometry geom
=> StrokeWidth -> Join -> (Cap, Cap) -> geom
-> Container Primitive
strokize :: Float -> Join -> (Cap, Cap) -> geom -> Container Primitive
strokize Float
width Join
join (Cap
capStart, Cap
capEnd) geom
geom = ([Primitive] -> Container Primitive)
-> [[Primitive]] -> Container Primitive
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Primitive] -> Container Primitive
pathOffseter [[Primitive]]
sanitized
where
sanitized :: [[Primitive]]
sanitized = (Primitive -> [Primitive]) -> [Primitive] -> [Primitive]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Container Primitive -> [Primitive]
forall a. Container a -> [a]
listOfContainer (Container Primitive -> [Primitive])
-> (Primitive -> Container Primitive) -> Primitive -> [Primitive]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Primitive -> Container Primitive
sanitize) ([Primitive] -> [Primitive]) -> [[Primitive]] -> [[Primitive]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Primitive] -> [[Primitive]]
resplit (geom -> [Primitive]
forall a. Geometry a => a -> [Primitive]
toPrimitives geom
geom)
offseter :: Cap -> [Primitive] -> Container Primitive
offseter = Float -> Join -> Cap -> [Primitive] -> Container Primitive
offsetAndJoin (Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2) Join
join
pathOffseter :: [Primitive] -> Container Primitive
pathOffseter [Primitive]
v =
Cap -> [Primitive] -> Container Primitive
offseter Cap
capEnd [Primitive]
v Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<> Cap -> [Primitive] -> Container Primitive
offseter Cap
capStart ([Primitive] -> [Primitive]
forall a. [a] -> [a]
reverse ([Primitive] -> [Primitive]) -> [Primitive] -> [Primitive]
forall a b. (a -> b) -> a -> b
$ Primitive -> Primitive
reversePrimitive (Primitive -> Primitive) -> [Primitive] -> [Primitive]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Primitive]
v)
flattenPrimitive :: Primitive -> Container Primitive
flattenPrimitive :: Primitive -> Container Primitive
flattenPrimitive (BezierPrim Bezier
bezier) = Bezier -> Container Primitive
flattenBezier Bezier
bezier
flattenPrimitive (CubicBezierPrim CubicBezier
bezier) = CubicBezier -> Container Primitive
flattenCubicBezier CubicBezier
bezier
flattenPrimitive (LinePrim Line
line) = Line -> Container Primitive
flattenLine Line
line
breakPrimitiveAt :: Primitive -> Float -> (Primitive, Primitive)
breakPrimitiveAt :: Primitive -> Float -> (Primitive, Primitive)
breakPrimitiveAt (BezierPrim Bezier
bezier) Float
at = (Bezier -> Primitive
BezierPrim Bezier
a, Bezier -> Primitive
BezierPrim Bezier
b)
where (Bezier
a, Bezier
b) = Bezier -> Float -> (Bezier, Bezier)
bezierBreakAt Bezier
bezier Float
at
breakPrimitiveAt (CubicBezierPrim CubicBezier
bezier) Float
at = (CubicBezier -> Primitive
CubicBezierPrim CubicBezier
a, CubicBezier -> Primitive
CubicBezierPrim CubicBezier
b)
where (CubicBezier
a, CubicBezier
b) = CubicBezier -> Float -> (CubicBezier, CubicBezier)
cubicBezierBreakAt CubicBezier
bezier Float
at
breakPrimitiveAt (LinePrim Line
line) Float
at = (Line -> Primitive
LinePrim Line
a, Line -> Primitive
LinePrim Line
b)
where (Line
a, Line
b) = Line -> Float -> (Line, Line)
lineBreakAt Line
line Float
at
flatten :: Container Primitive -> Container Primitive
flatten :: Container Primitive -> Container Primitive
flatten = (Primitive -> Container Primitive)
-> Container Primitive -> Container Primitive
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Primitive -> Container Primitive
flattenPrimitive
splitPrimitiveUntil :: Float -> [Primitive] -> ([Primitive], [Primitive])
splitPrimitiveUntil :: Float -> [Primitive] -> ([Primitive], [Primitive])
splitPrimitiveUntil = Float -> [Primitive] -> ([Primitive], [Primitive])
go
where
go :: Float -> [Primitive] -> ([Primitive], [Primitive])
go Float
_ [] = ([], [])
go Float
left [Primitive]
lst
| Float
left Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = ([], [Primitive]
lst)
go Float
left (Primitive
x : [Primitive]
xs)
| Float
left Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
primLength = (Primitive
x Primitive -> [Primitive] -> [Primitive]
forall a. a -> [a] -> [a]
: [Primitive]
inInterval, [Primitive]
afterInterval)
| Bool
otherwise = ([Primitive
beforeStop], Primitive
afterStop Primitive -> [Primitive] -> [Primitive]
forall a. a -> [a] -> [a]
: [Primitive]
xs)
where
primLength :: Float
primLength = Primitive -> Float
approximateLength Primitive
x
([Primitive]
inInterval, [Primitive]
afterInterval) = Float -> [Primitive] -> ([Primitive], [Primitive])
go (Float
left Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
primLength) [Primitive]
xs
(Primitive
beforeStop, Primitive
afterStop) =
Primitive -> Float -> (Primitive, Primitive)
breakPrimitiveAt Primitive
x (Float -> (Primitive, Primitive))
-> Float -> (Primitive, Primitive)
forall a b. (a -> b) -> a -> b
$ Float
left Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
primLength
dropPattern :: Float -> DashPattern -> DashPattern
dropPattern :: Float -> DashPattern -> DashPattern
dropPattern = Float -> DashPattern -> DashPattern
forall t. (Ord t, Num t) => t -> [t] -> [t]
go
where
go :: t -> [t] -> [t]
go t
_ [] = []
go t
offset (t
x:[t]
xs)
| t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0 = t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
xs
| t
offset t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
x = t
x t -> t -> t
forall a. Num a => a -> a -> a
- t
offset t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
xs
| Bool
otherwise = t -> [t] -> [t]
go (t
offset t -> t -> t
forall a. Num a => a -> a -> a
- t
x) [t]
xs
linearizePrimitives :: [Primitive] -> [Primitive]
linearizePrimitives :: [Primitive] -> [Primitive]
linearizePrimitives =
Container Primitive -> [Primitive]
forall a. Container a -> [a]
listOfContainer (Container Primitive -> [Primitive])
-> ([Primitive] -> Container Primitive)
-> [Primitive]
-> [Primitive]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Primitive -> Container Primitive)
-> Container Primitive -> Container Primitive
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Primitive -> Container Primitive
flattenPrimitive (Container Primitive -> Container Primitive)
-> ([Primitive] -> Container Primitive)
-> [Primitive]
-> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Primitive -> Container Primitive)
-> [Primitive] -> Container Primitive
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Primitive -> Container Primitive
sanitize
approximatePathLength :: Path -> Float
approximatePathLength :: Path -> Float
approximatePathLength = [Primitive] -> Float
approximatePrimitivesLength ([Primitive] -> Float) -> (Path -> [Primitive]) -> Path -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> [Primitive]
pathToPrimitives
approximatePrimitivesLength :: [Primitive] -> Float
approximatePrimitivesLength :: [Primitive] -> Float
approximatePrimitivesLength [Primitive]
prims =
DashPattern -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (DashPattern -> Float) -> DashPattern -> Float
forall a b. (a -> b) -> a -> b
$ Primitive -> Float
approximateLength (Primitive -> Float) -> [Primitive] -> DashPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Primitive] -> [Primitive]
linearizePrimitives [Primitive]
prims
dashize :: Float -> DashPattern -> [Primitive] -> [[Primitive]]
dashize :: Float -> DashPattern -> [Primitive] -> [[Primitive]]
dashize Float
offset DashPattern
pattern = DashPattern -> [Primitive] -> [[Primitive]]
taker DashPattern
infinitePattern ([Primitive] -> [[Primitive]])
-> ([Primitive] -> [Primitive]) -> [Primitive] -> [[Primitive]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> [Primitive]
linearizePrimitives
where
realOffset :: Float
realOffset | Float
offset Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 = Float
offset
| Bool
otherwise = Float
offset Float -> Float -> Float
forall a. Num a => a -> a -> a
+ DashPattern -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum DashPattern
pattern
infinitePattern :: DashPattern
infinitePattern =
Float -> DashPattern -> DashPattern
dropPattern Float
realOffset (DashPattern -> DashPattern)
-> (DashPattern -> DashPattern) -> DashPattern -> DashPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DashPattern -> DashPattern
forall a. [a] -> [a]
cycle (DashPattern -> DashPattern) -> DashPattern -> DashPattern
forall a b. (a -> b) -> a -> b
$ (Float -> Bool) -> DashPattern -> DashPattern
forall a. (a -> Bool) -> [a] -> [a]
filter (Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0) DashPattern
pattern
taker :: DashPattern -> [Primitive] -> [[Primitive]]
taker DashPattern
_ [] = []
taker [] [Primitive]
_ = []
taker (Float
atValue:DashPattern
atRest) [Primitive]
stream = [Primitive]
toKeep [Primitive] -> [[Primitive]] -> [[Primitive]]
forall a. a -> [a] -> [a]
: DashPattern -> [Primitive] -> [[Primitive]]
droper DashPattern
atRest [Primitive]
next
where ([Primitive]
toKeep, [Primitive]
next) = Float -> [Primitive] -> ([Primitive], [Primitive])
splitPrimitiveUntil Float
atValue [Primitive]
stream
droper :: DashPattern -> [Primitive] -> [[Primitive]]
droper DashPattern
_ [] = []
droper [] [Primitive]
_ = []
droper (Float
atValue:DashPattern
atRest) [Primitive]
stream = DashPattern -> [Primitive] -> [[Primitive]]
taker DashPattern
atRest [Primitive]
next
where ([Primitive]
_toKeep, [Primitive]
next) = Float -> [Primitive] -> ([Primitive], [Primitive])
splitPrimitiveUntil Float
atValue [Primitive]
stream
dashedStrokize :: Geometry geom
=> Float
-> DashPattern
-> StrokeWidth
-> Join
-> (Cap, Cap)
-> geom
-> [[Primitive]]
dashedStrokize :: Float
-> DashPattern
-> Float
-> Join
-> (Cap, Cap)
-> geom
-> [[Primitive]]
dashedStrokize Float
offset DashPattern
dashPattern Float
width Join
join (Cap, Cap)
capping geom
geom =
Container Primitive -> [Primitive]
forall a. Container a -> [a]
listOfContainer (Container Primitive -> [Primitive])
-> ([Primitive] -> Container Primitive)
-> [Primitive]
-> [Primitive]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Join -> (Cap, Cap) -> [Primitive] -> Container Primitive
forall geom.
Geometry geom =>
Float -> Join -> (Cap, Cap) -> geom -> Container Primitive
strokize Float
width Join
join (Cap, Cap)
capping
([Primitive] -> [Primitive]) -> [[Primitive]] -> [[Primitive]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> DashPattern -> [Primitive] -> [[Primitive]]
dashize Float
offset DashPattern
dashPattern (geom -> [Primitive]
forall a. Geometry a => a -> [Primitive]
toPrimitives geom
geom)