{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.Rasterific.CubicBezier
( cubicBezierCircle
, cubicBezierFromPath
, cubicBezierBreakAt
, divideCubicBezier
, clipCubicBezier
, decomposeCubicBeziers
, sanitizeCubicBezier
, sanitizeCubicBezierFilling
, offsetCubicBezier
, flattenCubicBezier
, cubicBezierLengthApproximation
, cubicBezierBounds
, cubicFromQuadraticBezier
, isCubicBezierPoint
) where
import Prelude hiding( or )
import Control.Applicative( liftA2 )
import Graphics.Rasterific.Linear
( V2( .. )
, (^-^)
, (^+^)
, (^*)
, norm
, lerp
)
import Data.List( nub )
import Graphics.Rasterific.Operators
import Graphics.Rasterific.Types
import Graphics.Rasterific.QuadraticFormula
cubicBezierFromPath :: [Point] -> [CubicBezier]
cubicBezierFromPath :: [Point] -> [CubicBezier]
cubicBezierFromPath (Point
a:Point
b:Point
c:rest :: [Point]
rest@(Point
d:[Point]
_)) =
Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
b Point
c Point
d CubicBezier -> [CubicBezier] -> [CubicBezier]
forall a. a -> [a] -> [a]
: [Point] -> [CubicBezier]
cubicBezierFromPath [Point]
rest
cubicBezierFromPath [Point]
_ = []
cubicBezierLengthApproximation :: CubicBezier -> Float
cubicBezierLengthApproximation :: CubicBezier -> Float
cubicBezierLengthApproximation (CubicBezier Point
a Point
_ Point
_ Point
d) =
Point -> Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (Point -> Float) -> Point -> Float
forall a b. (a -> b) -> a -> b
$ Point
d Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
a
cubicBezierCircle :: [CubicBezier]
cubicBezierCircle :: [CubicBezier]
cubicBezierCircle =
[ Point -> Point -> Point -> Point -> CubicBezier
CubicBezier (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
1) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
c Float
1) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
1 Float
c) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
1 Float
0)
, Point -> Point -> Point -> Point -> CubicBezier
CubicBezier (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
1 Float
0) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
1 (-Float
c)) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
c (-Float
1)) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 (-Float
1))
, Point -> Point -> Point -> Point -> CubicBezier
CubicBezier (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 (-Float
1)) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (-Float
c) (-Float
1)) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (-Float
1) (-Float
c)) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (-Float
1) Float
0)
, Point -> Point -> Point -> Point -> CubicBezier
CubicBezier (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (-Float
1) Float
0) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (-Float
1) Float
c) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (-Float
c) Float
1) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
1)
]
where c :: Float
c = Float
0.551915024494
straightLine :: Point -> Point -> CubicBezier
straightLine :: Point -> Point -> CubicBezier
straightLine Point
a Point
b = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
p Point
p Point
b
where p :: Point
p = Point
a Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
b
isSufficientlyFlat :: Float
-> CubicBezier
-> Bool
isSufficientlyFlat :: Float -> CubicBezier -> Bool
isSufficientlyFlat Float
tol (CubicBezier Point
a Point
b Point
c Point
d) =
Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
tolerance
where u :: Point
u = (Point
b Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3) Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ (Point
a 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
d
v :: Point
v = (Point
c Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3) Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ (Point
d 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
(^*^) = (Float -> Float -> Float) -> Point -> Point -> Point
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Float -> Float -> Float
forall a. Num a => a -> a -> a
(*)
V2 Float
x Float
y = Point -> Point -> Point
forall n (a :: * -> *). (Ord n, Applicative a) => a n -> a n -> a n
vmax (Point
u Point -> Point -> Point
^*^ Point
u) (Point
v Point -> Point -> Point
^*^ Point
v)
tolerance :: Float
tolerance = Float
16 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
tol Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
tol
splitCubicBezier :: CubicBezier -> (Point, Point, Point, Point, Point, Point)
{-# INLINE splitCubicBezier #-}
splitCubicBezier :: CubicBezier -> (Point, Point, Point, Point, Point, Point)
splitCubicBezier (CubicBezier Point
a Point
b Point
c Point
d) = (Point
ab, Point
bc, Point
cd, Point
abbc, Point
bccd, Point
abbcbccd)
where
ab :: Point
ab = Point
a Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
b
bc :: Point
bc = Point
b Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
c
cd :: Point
cd = Point
c Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
d
abbc :: Point
abbc = Point
ab Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
bc
bccd :: Point
bccd = Point
bc Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
cd
abbcbccd :: Point
abbcbccd = Point
abbc Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
bccd
flattenCubicBezier :: CubicBezier -> Container Primitive
flattenCubicBezier :: CubicBezier -> Container Primitive
flattenCubicBezier bezier :: CubicBezier
bezier@(CubicBezier Point
a Point
_ Point
_ Point
d)
| Float -> CubicBezier -> Bool
isSufficientlyFlat Float
1 CubicBezier
bezier = 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
$ CubicBezier -> Primitive
CubicBezierPrim CubicBezier
bezier
| Bool
otherwise =
CubicBezier -> Container Primitive
flattenCubicBezier (Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
ab Point
abbc Point
abbcbccd) Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<>
CubicBezier -> Container Primitive
flattenCubicBezier (Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
abbcbccd Point
bccd Point
cd Point
d)
where
(Point
ab, Point
_bc, Point
cd, Point
abbc, Point
bccd, Point
abbcbccd) = CubicBezier -> (Point, Point, Point, Point, Point, Point)
splitCubicBezier CubicBezier
bezier
data CachedBezier = CachedBezier
{ CachedBezier -> Float
_cachedA :: {-# UNPACK #-} !Float
, CachedBezier -> Float
_cachedB :: {-# UNPACK #-} !Float
, CachedBezier -> Float
_cachedC :: {-# UNPACK #-} !Float
, CachedBezier -> Float
_cachedD :: {-# UNPACK #-} !Float
}
cacheBezier :: CubicBezier -> (CachedBezier, CachedBezier)
cacheBezier :: CubicBezier -> (CachedBezier, CachedBezier)
cacheBezier (CubicBezier p0 :: Point
p0@(V2 Float
x0 Float
y0) Point
p1 Point
p2 Point
p3) =
(Float -> Float -> Float -> Float -> CachedBezier
CachedBezier Float
x0 Float
bX Float
cX Float
dX, Float -> Float -> Float -> Float -> CachedBezier
CachedBezier Float
y0 Float
bY Float
cY Float
dY)
where
V2 Float
bX Float
bY = Point
p1 Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p0 Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3
V2 Float
cX Float
cY = Point
p2 Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p1 Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
6 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Point
p0 Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3
V2 Float
dX Float
dY = Point
p3 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p2 Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point
p1 Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
3 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p0
cachedBezierAt :: CachedBezier -> Float -> Float
cachedBezierAt :: CachedBezier -> Float -> Float
cachedBezierAt (CachedBezier Float
a Float
b Float
c Float
d) Float
t =
Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
tSquare Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
tCube Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d
where
tSquare :: Float
tSquare = Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t
tCube :: Float
tCube = Float
tSquare Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t
cachedBezierDerivative :: CachedBezier -> QuadraticFormula Float
cachedBezierDerivative :: CachedBezier -> QuadraticFormula Float
cachedBezierDerivative (CachedBezier Float
_ Float
b Float
c Float
d) =
Float -> Float -> Float -> QuadraticFormula Float
forall a. a -> a -> a -> QuadraticFormula a
QuadraticFormula (Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d) (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
c) Float
b
extremums :: CachedBezier -> [Float]
extremums :: CachedBezier -> [Float]
extremums CachedBezier
cached =
[ Float
root | Float
root <- QuadraticFormula Float -> [Float]
forall a. (Ord a, Floating a) => QuadraticFormula a -> [a]
formulaRoots (QuadraticFormula Float -> [Float])
-> QuadraticFormula Float -> [Float]
forall a b. (a -> b) -> a -> b
$ CachedBezier -> QuadraticFormula Float
cachedBezierDerivative CachedBezier
cached
, Float
0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
root Bool -> Bool -> Bool
&& Float
root Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1.0 ]
extremumPoints :: (CachedBezier, CachedBezier) -> [Point]
extremumPoints :: (CachedBezier, CachedBezier) -> [Point]
extremumPoints (CachedBezier
onX, CachedBezier
onY) = Float -> Point
toPoints (Float -> Point) -> [Float] -> [Point]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Float] -> [Float]
forall a. Eq a => [a] -> [a]
nub (CachedBezier -> [Float]
extremums CachedBezier
onX [Float] -> [Float] -> [Float]
forall a. Semigroup a => a -> a -> a
<> CachedBezier -> [Float]
extremums CachedBezier
onY)
where toPoints :: Float -> Point
toPoints Float
at = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (CachedBezier -> Float -> Float
cachedBezierAt CachedBezier
onX Float
at) (CachedBezier -> Float -> Float
cachedBezierAt CachedBezier
onY Float
at)
cubicBezierBounds :: CubicBezier -> [Point]
cubicBezierBounds :: CubicBezier -> [Point]
cubicBezierBounds bez :: CubicBezier
bez@(CubicBezier Point
p0 Point
_ Point
_ Point
p3) =
Point
p0 Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: Point
p3 Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: (CachedBezier, CachedBezier) -> [Point]
extremumPoints (CubicBezier -> (CachedBezier, CachedBezier)
cacheBezier CubicBezier
bez)
offsetCubicBezier :: Float -> CubicBezier -> Container Primitive
offsetCubicBezier :: Float -> CubicBezier -> Container Primitive
offsetCubicBezier Float
offset bezier :: CubicBezier
bezier@(CubicBezier Point
a Point
b Point
c Point
d)
| Float -> CubicBezier -> Bool
isSufficientlyFlat Float
1 CubicBezier
bezier =
Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> Container Primitive)
-> (CubicBezier -> Primitive) -> CubicBezier -> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> Primitive
CubicBezierPrim (CubicBezier -> Container Primitive)
-> CubicBezier -> Container Primitive
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
shiftedA Point
shiftedB Point
shiftedC Point
shiftedD
| Bool
otherwise =
CubicBezier -> Container Primitive
recurse (Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
ab Point
abbc Point
abbcbccd) Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<>
CubicBezier -> Container Primitive
recurse (Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
abbcbccd Point
bccd Point
cd Point
d)
where
recurse :: CubicBezier -> Container Primitive
recurse = Float -> CubicBezier -> Container Primitive
offsetCubicBezier Float
offset
u :: Point
u = Point
a Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
b
v :: Point
v = Point
c Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
d
(Point
ab, Point
bc, Point
cd, Point
abbc, Point
bccd, Point
abbcbccd) = CubicBezier -> (Point, Point, Point, Point, Point, Point)
splitCubicBezier CubicBezier
bezier
w :: Point
w = Point
ab Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
bc
x :: Point
x = Point
bc Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
cd
shiftedA :: Point
shiftedA = Point
a 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)
shiftedD :: Point
shiftedD = 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)
shiftedB :: Point
shiftedB = Point
b 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)
shiftedC :: Point
shiftedC = Point
c Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (Point
x Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
offset)
clipCubicBezier
:: Point
-> Point
-> CubicBezier
-> Container Primitive
clipCubicBezier :: Point -> Point -> CubicBezier -> Container Primitive
clipCubicBezier Point
mini Point
maxi bezier :: CubicBezier
bezier@(CubicBezier Point
a Point
b Point
c Point
d)
| Bool
insideX Bool -> Bool -> Bool
&& Bool
insideY = 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
$ CubicBezier -> Primitive
CubicBezierPrim CubicBezier
bezier
| Bool
outsideX Bool -> Bool -> Bool
|| Bool
outsideY =
Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> Container Primitive)
-> (CubicBezier -> Primitive) -> CubicBezier -> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> Primitive
CubicBezierPrim (CubicBezier -> Container Primitive)
-> CubicBezier -> Container Primitive
forall a b. (a -> b) -> a -> b
$ Point
clampedA Point -> Point -> CubicBezier
`straightLine` Point
clampedD
| Bool
otherwise =
CubicBezier -> Container Primitive
recurse (Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
ab Point
abbc Point
m) Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<>
CubicBezier -> Container Primitive
recurse (Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
m Point
bccd Point
cd Point
d)
where
bmin :: Point
bmin = Point -> Point -> Point
forall n (a :: * -> *). (Ord n, Applicative a) => a n -> a n -> a n
vmin Point
a (Point -> Point) -> (Point -> Point) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Point
forall n (a :: * -> *). (Ord n, Applicative a) => a n -> a n -> a n
vmin Point
b (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point
forall n (a :: * -> *). (Ord n, Applicative a) => a n -> a n -> a n
vmin Point
c Point
d
bmax :: Point
bmax = Point -> Point -> Point
forall n (a :: * -> *). (Ord n, Applicative a) => a n -> a n -> a n
vmax Point
a (Point -> Point) -> (Point -> Point) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Point
forall n (a :: * -> *). (Ord n, Applicative a) => a n -> a n -> a n
vmax Point
b (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point
forall n (a :: * -> *). (Ord n, Applicative a) => a n -> a n -> a n
vmax Point
c Point
d
recurse :: CubicBezier -> Container Primitive
recurse = Point -> Point -> CubicBezier -> Container Primitive
clipCubicBezier Point
mini Point
maxi
clamper :: Point -> Point
clamper = Point -> Point -> Point -> Point
clampPoint Point
mini Point
maxi
clampedA :: Point
clampedA = Point -> Point
clamper Point
a
clampedD :: Point
clampedD = Point -> Point
clamper Point
d
V2 Bool
insideX Bool
insideY = Point
mini Point -> Point -> V2 Bool
forall v (a :: * -> *).
(Ord v, Applicative a) =>
a v -> a v -> a Bool
^<=^ Point
bmin V2 Bool -> V2 Bool -> V2 Bool
forall (a :: * -> *). Applicative a => a Bool -> a Bool -> a Bool
^&&^ Point
bmax Point -> Point -> V2 Bool
forall v (a :: * -> *).
(Ord v, Applicative a) =>
a v -> a v -> a Bool
^<=^ Point
maxi
V2 Bool
outsideX Bool
outsideY = Point
bmax Point -> Point -> V2 Bool
forall v (a :: * -> *).
(Ord v, Applicative a) =>
a v -> a v -> a Bool
^<=^ Point
mini V2 Bool -> V2 Bool -> V2 Bool
forall (a :: * -> *). Applicative a => a Bool -> a Bool -> a Bool
^||^ Point
maxi Point -> Point -> V2 Bool
forall v (a :: * -> *).
(Ord v, Applicative a) =>
a v -> a v -> a Bool
^<=^ Point
bmin
(Point
ab, Point
_bc, Point
cd, Point
abbc, Point
bccd, Point
abbcbccd) = CubicBezier -> (Point, Point, Point, Point, Point, Point)
splitCubicBezier CubicBezier
bezier
edgeSeparator :: V2 Bool
edgeSeparator = Point -> Point
forall n (a :: * -> *). (Num n, Functor a) => a n -> a n
vabs (Point
abbcbccd Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
mini) Point -> Point -> V2 Bool
forall v (a :: * -> *).
(Ord v, Applicative a) =>
a v -> a v -> a Bool
^<^ Point -> Point
forall n (a :: * -> *). (Num n, Functor a) => a n -> a n
vabs (Point
abbcbccd Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
maxi)
edge :: Point
edge = V2 Bool -> Point -> Point -> Point
forall (a :: * -> *) v.
Applicative a =>
a Bool -> a v -> a v -> a v
vpartition V2 Bool
edgeSeparator Point
mini Point
maxi
m :: Point
m = V2 Bool -> Point -> Point -> Point
forall (a :: * -> *) v.
Applicative a =>
a Bool -> a v -> a v -> a v
vpartition (Point -> Point
forall n (a :: * -> *). (Num n, Functor a) => a n -> a n
vabs (Point
abbcbccd Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
edge) Point -> Float -> V2 Bool
forall (a :: * -> *) v.
(Applicative a, Ord v) =>
a v -> v -> a Bool
^< Float
0.1) Point
edge Point
abbcbccd
divideCubicBezier :: CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier :: CubicBezier -> (CubicBezier, CubicBezier)
divideCubicBezier bezier :: CubicBezier
bezier@(CubicBezier Point
a Point
_ Point
_ Point
d) = (CubicBezier
left, CubicBezier
right) where
left :: CubicBezier
left = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
ab Point
abbc Point
abbcbccd
right :: CubicBezier
right = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
abbcbccd Point
bccd Point
cd Point
d
(Point
ab, Point
_bc, Point
cd, Point
abbc, Point
bccd, Point
abbcbccd) = CubicBezier -> (Point, Point, Point, Point, Point, Point)
splitCubicBezier CubicBezier
bezier
cubicBezierBreakAt :: CubicBezier -> Float
-> (CubicBezier, CubicBezier)
cubicBezierBreakAt :: CubicBezier -> Float -> (CubicBezier, CubicBezier)
cubicBezierBreakAt (CubicBezier Point
a Point
b Point
c Point
d) Float
val =
(Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
ab Point
abbc Point
abbcbccd, Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
abbcbccd Point
bccd Point
cd Point
d)
where
ab :: Point
ab = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
val Point
b Point
a
bc :: Point
bc = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
val Point
c Point
b
cd :: Point
cd = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
val Point
d Point
c
abbc :: Point
abbc = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
val Point
bc Point
ab
bccd :: Point
bccd = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
val Point
cd Point
bc
abbcbccd :: Point
abbcbccd = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
val Point
bccd Point
abbc
decomposeCubicBeziers :: CubicBezier -> Producer EdgeSample
decomposeCubicBeziers :: CubicBezier -> Producer EdgeSample
decomposeCubicBeziers cb :: CubicBezier
cb@(CubicBezier Point
a Point
b Point
c Point
d)
| Bool -> Bool
not (Point
a Point -> Point -> Bool
`isDistingableFrom` Point
d) Bool -> Bool -> Bool
&& ((Point
a Point -> Point -> Bool
`isDistingableFrom` Point
b) Bool -> Bool -> Bool
|| (Point
a Point -> Point -> Bool
`isDistingableFrom` Point
c)) =
let (CubicBezier
l, CubicBezier
r) = CubicBezier -> Float -> (CubicBezier, CubicBezier)
cubicBezierBreakAt CubicBezier
cb Float
0.5 in
CubicBezier -> Producer EdgeSample
decomposeCubicBeziers CubicBezier
l Producer EdgeSample -> Producer EdgeSample -> Producer EdgeSample
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> Producer EdgeSample
decomposeCubicBeziers CubicBezier
r
decomposeCubicBeziers (CubicBezier (V2 Float
aRx Float
aRy) (V2 Float
bRx Float
bRy) (V2 Float
cRx Float
cRy) (V2 Float
dRx Float
dRy)) =
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Producer EdgeSample
go Float
aRx Float
aRy Float
bRx Float
bRy Float
cRx Float
cRy Float
dRx Float
dRy where
go :: Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Producer EdgeSample
go Float
ax Float
ay Float
_bx Float
_by Float
_cx Float
_cy Float
dx Float
dy [EdgeSample]
cont | Bool
insideX Bool -> Bool -> Bool
&& Bool
insideY =
let !px :: Float
px = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
floorAx Int
floorDx
!py :: Float
py = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
floorAy Int
floorDy
!w :: Float
w = Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
dx Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
ax)
!h :: Float
h = Float
dy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ay
in
Float -> Float -> Float -> Float -> EdgeSample
EdgeSample (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5) (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5) (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h) Float
h EdgeSample -> Producer EdgeSample
forall a. a -> [a] -> [a]
: [EdgeSample]
cont
where
floorAx, floorAy :: Int
!floorAx :: Int
floorAx = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
ax
!floorAy :: Int
floorAy = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
ay
!floorDx :: Int
floorDx = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
dx
!floorDy :: Int
floorDy = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
dy
!insideX :: Bool
insideX =
Int
floorAx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
floorDx Bool -> Bool -> Bool
|| Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
ax Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
dx :: Int)
!insideY :: Bool
insideY =
Int
floorAy Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
floorDy Bool -> Bool -> Bool
|| Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
ay Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
dy :: Int)
go !Float
ax !Float
ay !Float
bx !Float
by !Float
cx !Float
cy !Float
dx !Float
dy [EdgeSample]
cont =
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Producer EdgeSample
go Float
ax Float
ay Float
abx Float
aby Float
abbcx Float
abbcy Float
mx Float
my Producer EdgeSample -> Producer EdgeSample
forall a b. (a -> b) -> a -> b
$
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Producer EdgeSample
go Float
mx Float
my Float
bccdx Float
bccdy Float
cdx Float
cdy Float
dx Float
dy [EdgeSample]
cont
where
!abx :: Float
abx = Float
ax Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
bx
!aby :: Float
aby = Float
ay Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
by
!bcx :: Float
bcx = Float
bx Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
cx
!bcy :: Float
bcy = Float
by Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
cy
!cdx :: Float
cdx = Float
cx Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
dx
!cdy :: Float
cdy = Float
cy Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
dy
!abbcx :: Float
abbcx = Float
abx Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
bcx
!abbcy :: Float
abbcy = Float
aby Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
bcy
!bccdx :: Float
bccdx = Float
bcx Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
cdx
!bccdy :: Float
bccdy = Float
bcy Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
cdy
!abbcbccdx :: Float
abbcbccdx = Float
abbcx Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
bccdx
!abbcbccdy :: Float
abbcbccdy = Float
abbcy Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
bccdy
!mx :: Float
mx | Float -> Float
forall a. Num a => a -> a
abs (Float
abbcbccdx Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
mini) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.1 = Float
mini
| Float -> Float
forall a. Num a => a -> a
abs (Float
abbcbccdx Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
maxi) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.1 = Float
maxi
| Bool
otherwise = Float
abbcbccdx
where !mini :: Float
mini = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
abbcbccdx :: Int)
!maxi :: Float
maxi = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
abbcbccdx :: Int)
!my :: Float
my | Float -> Float
forall a. Num a => a -> a
abs (Float
abbcbccdy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
mini) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.1 = Float
mini
| Float -> Float
forall a. Num a => a -> a
abs (Float
abbcbccdy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
maxi) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.1 = Float
maxi
| Bool
otherwise = Float
abbcbccdy
where !mini :: Float
mini = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
abbcbccdy :: Int)
!maxi :: Float
maxi = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
abbcbccdy :: Int)
isCubicBezierPoint :: CubicBezier -> Bool
isCubicBezierPoint :: CubicBezier -> Bool
isCubicBezierPoint (CubicBezier Point
a Point
b Point
c Point
d) =
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Point
a Point -> Point -> Bool
`isDistingableFrom` Point
b Bool -> Bool -> Bool
||
Point
b Point -> Point -> Bool
`isDistingableFrom` Point
c Bool -> Bool -> Bool
||
Point
c Point -> Point -> Bool
`isDistingableFrom` Point
d
sanitizeCubicBezier :: CubicBezier -> Container Primitive
sanitizeCubicBezier :: CubicBezier -> Container Primitive
sanitizeCubicBezier bezier :: CubicBezier
bezier@(CubicBezier Point
a Point
b Point
c Point
d)
| Point
a Point -> Point -> Bool
`isDistingableFrom` Point
b Bool -> Bool -> Bool
&&
Point
c Point -> Point -> Bool
`isDistingableFrom` Point
d =
Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> Container Primitive)
-> (CubicBezier -> Primitive) -> CubicBezier -> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> Primitive
CubicBezierPrim (CubicBezier -> Container Primitive)
-> CubicBezier -> Container Primitive
forall a b. (a -> b) -> a -> b
$ CubicBezier
bezier
| Point
ac Point -> Point -> Bool
`isDistingableFrom` Point
b Bool -> Bool -> Bool
&&
Point
bd Point -> Point -> Bool
`isDistingableFrom` Point
c =
Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> Container Primitive)
-> (CubicBezier -> Primitive) -> CubicBezier -> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> Primitive
CubicBezierPrim (CubicBezier -> Container Primitive)
-> CubicBezier -> Container Primitive
forall a b. (a -> b) -> a -> b
$ CubicBezier
bezier
| Point
ac Point -> Point -> Bool
`isDistingableFrom` Point
b =
Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> Container Primitive)
-> (CubicBezier -> Primitive) -> CubicBezier -> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> Primitive
CubicBezierPrim (CubicBezier -> Container Primitive)
-> CubicBezier -> Container Primitive
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
ac Point
c Point
d
| Point
bd Point -> Point -> Bool
`isDistingableFrom` Point
c =
Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> Container Primitive)
-> (CubicBezier -> Primitive) -> CubicBezier -> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> Primitive
CubicBezierPrim (CubicBezier -> Container Primitive)
-> CubicBezier -> Container Primitive
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
a Point
b Point
bd Point
d
| Bool
otherwise = Container Primitive
forall a. Monoid a => a
mempty
where ac :: Point
ac = Point
a Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
c
bd :: Point
bd = Point
a Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
d
sanitizeCubicBezierFilling :: CubicBezier -> Container Primitive
sanitizeCubicBezierFilling :: CubicBezier -> Container Primitive
sanitizeCubicBezierFilling bezier :: CubicBezier
bezier@(CubicBezier Point
a Point
b Point
c Point
d)
| Point -> Bool
isDegenerate Point
a Bool -> Bool -> Bool
|| Point -> Bool
isDegenerate Point
b Bool -> Bool -> Bool
||
Point -> Bool
isDegenerate Point
c Bool -> Bool -> Bool
|| Point -> Bool
isDegenerate Point
d = Container Primitive
forall a. Monoid a => a
mempty
| 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
$ CubicBezier -> Primitive
CubicBezierPrim CubicBezier
bezier
cubicFromQuadraticBezier :: Bezier -> CubicBezier
cubicFromQuadraticBezier :: Bezier -> CubicBezier
cubicFromQuadraticBezier (Bezier Point
p0 Point
p1 Point
p2) = Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p0 Point
pa Point
pb Point
p2 where
pa :: Point
pa = Point
p0 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (Point
p1 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p0) Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (Float
2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
3)
pb :: Point
pb = Point
p2 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (Point
p1 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p2) Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (Float
2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
3)