{-# 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

-- | Create a list of cubic bezier patch from a list of points.

--

-- > cubicBezierFromPath [a, b, c, d, e] = [CubicBezier a b c d]

-- > cubicBezierFromPath [a, b, c, d, e, f, g] =

-- >    [CubicBezier a b c d, CubicBezier d e f g]

--

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

-- | Represent a circle of radius 1 centered on 0 of

-- a cubic bezier curve.

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 -- magic constant? magic constant.


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 -- ^ Tolerance

                   -> 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
    --                     BC

    --         B X----------X---------X C

    --    ^     /      ___/   \___     \     ^

    --   u \   /   __X------X------X_   \   / v

    --      \ /___/ ABBC       BCCD  \___\ /

    --    AB X/                          \X CD

    --      /                              \

    --     /                                \

    --    /                                  \

    -- A X                                    X D

    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

--               3                    2            2                  3

-- x(t) = (1 - t) ∙x     + 3∙t∙(1 - t) ∙x     + 3∙t ∙(1 - t)∙x     + t ∙x

--                   0                    1                    2          3

--

--               3                    2            2                  3

-- y(t) = (1 - t) ∙y     + 3∙t∙(1 - t) ∙y     + 3∙t ∙(1 - t)∙y     + t ∙y

--                   0                    1                    2          3


-- Other representation:

--                3                2        2              3

-- B(t) = x(1 - t)  + 3∙y∙t∙(1 - t)  + 3∙z∙t ∙(1 - t) + w∙t



-- | Represent the cubic bezier curve as a vector ready

-- for matrix multiplication

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

-- | Find the coefficient of the extremum points

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

    --                     BC

    --         B X----------X---------X C

    --    ^     /      ___/   \___     \     ^

    --   u \   /   __X------X------X_   \   / v

    --      \ /___/ ABBC       BCCD  \___\ /

    --    AB X/                          \X CD

    --      /                              \

    --     /                                \

    --    /                                  \

    -- A X                                    X 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)

    {-shiftedABBCBCCD = abbcbccd ^+^ (w ^* 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)

-- | Clamp the cubic bezier curve inside a rectangle

-- given in parameter.

clipCubicBezier
    :: Point   -- ^ Point representing the "minimal" point for cliping

    -> Point  -- ^ Point representing the "maximal" point for cliping

    -> CubicBezier -- ^ The cubic bezier curve to be clamped

    -> 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)
    -- If we are in the range bound, return the curve

    -- unaltered

    | 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
    -- If one of the component is outside, clamp

    -- the components on the boundaries and output a

    -- straight line on this boundary. Useful for the

    -- filing case, to clamp the polygon drawing on

    -- the edge

    | 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
    -- Not completly inside nor outside, just divide

    -- and conquer.

    | 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 -- Minimal & maximal dimension of the bezier curve

        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

        --                     BC

        --         B X----------X---------X C

        --          /      ___/   \___     \

        --         /   __X------X------X_   \

        --        /___/ ABBC       BCCD  \___\

        --    AB X/                          \X CD

        --      /                              \

        --     /                                \

        --    /                                  \

        -- A X                                    X D

        (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

-- | Will subdivide the bezier from 0 to coeff and coeff to 1

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)
   -- handle case of self closed bezier curve

  | 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
      --                     BC

      --         B X----------X---------X C

      --          /      ___/   \___     \

      --         /   __X------X------X_   \

      --        /___/ ABBC       BCCD  \___\

      --    AB X/                          \X CD

      --      /                              \

      --     /                                \

      --    /                                  \

      -- A X                                    X D

      !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)