{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE BangPatterns #-}
-- | Module handling math regarding the handling of quadratic

-- and cubic bezier curve.

module Graphics.Rasterific.QuadraticBezier
    ( -- * Helper functions

      straightLine
    , bezierFromPath
    , decomposeBeziers
    , clipBezier
    , sanitizeBezier
    , sanitizeBezierFilling
    , offsetBezier
    , flattenBezier
    , bezierBreakAt
    , bezierLengthApproximation
    , isBezierPoint
    ) where

import Graphics.Rasterific.Linear
             ( V2( .. )
             , (^-^)
             , (^+^)
             , (^*)
             , dot
             , norm
             , lerp
             )

import Graphics.Rasterific.Operators
import Graphics.Rasterific.Types

-- | Create a list of bezier patch from a list of points,

--

-- > bezierFromPath [a, b, c, d, e] == [Bezier a b c, Bezier c d e]

-- > bezierFromPath [a, b, c, d, e, f] == [Bezier a b c, Bezier c d e]

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

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

--

bezierFromPath :: [Point] -> [Bezier]
bezierFromPath :: [Point] -> [Bezier]
bezierFromPath (Point
a:Point
b:rest :: [Point]
rest@(Point
c:[Point]
_)) = Point -> Point -> Point -> Bezier
Bezier Point
a Point
b Point
c Bezier -> [Bezier] -> [Bezier]
forall a. a -> [a] -> [a]
: [Point] -> [Bezier]
bezierFromPath [Point]
rest
bezierFromPath [Point]
_ = []

isBezierPoint :: Bezier -> Bool
isBezierPoint :: Bezier -> Bool
isBezierPoint (Bezier Point
a Point
b Point
c) =
  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

-- | Only work if the quadratic bezier curve

-- is nearly flat

bezierLengthApproximation :: Bezier -> Float
bezierLengthApproximation :: Bezier -> Float
bezierLengthApproximation (Bezier Point
a Point
_ Point
c) =
    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
c Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
a

decomposeBeziers :: Bezier -> Producer EdgeSample
decomposeBeziers :: Bezier -> Producer EdgeSample
decomposeBeziers (Bezier (V2 Float
aRx Float
aRy) (V2 Float
bRx Float
bRy) (V2 Float
cRx Float
cRy)) =
    Float
-> Float -> Float -> Float -> Float -> Float -> Producer EdgeSample
go Float
aRx Float
aRy Float
bRx Float
bRy Float
cRx Float
cRy where
  go :: Float
-> Float -> Float -> Float -> Float -> Float -> Producer EdgeSample
go Float
ax Float
ay Float
_bx Float
_by Float
cx Float
cy [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
floorCx
          !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
floorCy
          !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
cx Float -> Float -> Float
forall a. Fractional a => a -> a -> a
`middle` Float
ax
          !h :: Float
h = Float
cy 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

        !floorCx :: Int
floorCx = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
cx
        !floorCy :: Int
floorCy = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
cy

        !insideX :: Bool
insideX = Int
floorAx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
floorCx 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
cx :: Int)
        !insideY :: Bool
insideY = Int
floorAy Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
floorCy 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
cy :: Int)


  go !Float
ax !Float
ay !Float
bx !Float
by !Float
cx !Float
cy [EdgeSample]
cont =
      Float
-> Float -> Float -> Float -> Float -> Float -> Producer EdgeSample
go Float
ax Float
ay Float
abx Float
aby Float
mx Float
my Producer EdgeSample -> Producer EdgeSample
forall a b. (a -> b) -> a -> b
$ Float
-> Float -> Float -> Float -> Float -> Float -> Producer EdgeSample
go Float
mx Float
my Float
bcx Float
bcy Float
cx Float
cy [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

      !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

      !mx :: Float
mx | Float -> Float
forall a. Num a => a -> a
abs (Float
abbcx 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
abbcx 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
abbcx
         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
abbcx :: 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
abbcx :: Int)

      !my :: Float
my | Float -> Float
forall a. Num a => a -> a
abs (Float
abbcy 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
abbcy 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
abbcy
         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
abbcy :: 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
abbcy :: Int)


-- | Create a quadratic bezier curve representing

-- a straight line.

straightLine :: Point -> Point -> Bezier
straightLine :: Point -> Point -> Bezier
straightLine Point
a Point
c = Point -> Point -> Point -> Bezier
Bezier Point
a (Point
a Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
c) Point
c

-- | Clamp the bezier curve inside a rectangle

-- given in parameter.

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

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

           -> Bezier    -- ^ The quadratic bezier curve to be clamped

           -> Container Primitive
clipBezier :: Point -> Point -> Bezier -> Container Primitive
clipBezier Point
mini Point
maxi bezier :: Bezier
bezier@(Bezier Point
a Point
b Point
c)
    -- 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
$ Bezier -> Primitive
BezierPrim Bezier
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)
-> (Bezier -> Primitive) -> Bezier -> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bezier -> Primitive
BezierPrim (Bezier -> Container Primitive) -> Bezier -> Container Primitive
forall a b. (a -> b) -> a -> b
$ Point
clampedA Point -> Point -> Bezier
`straightLine` Point
clampedC
    -- Not completly inside nor outside, just divide

    -- and conquer.

    | Bool
otherwise =
        Bezier -> Container Primitive
recurse (Point -> Point -> Point -> Bezier
Bezier Point
a Point
ab Point
m) Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<>
            Bezier -> Container Primitive
recurse (Point -> Point -> Point -> Bezier
Bezier Point
m Point
bc Point
c)
  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
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
b Point
c
        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
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
b Point
c

        recurse :: Bezier -> Container Primitive
recurse = Point -> Point -> Bezier -> Container Primitive
clipBezier 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
        clampedC :: Point
clampedC = Point -> Point
clamper Point
c

        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

        --

        --         X B

        --        / \

        --       /   \

        --   ab X--X--X bc

        --     / abbc  \

        --    /         \

        -- A X           X C

        --

        (Point
ab, Point
bc, Point
abbc) = Bezier -> (Point, Point, Point)
splitBezier Bezier
bezier

        --  mini

        --     +-------------+

        --     |             |

        --     |             |

        --     |             |

        --     +-------------+

        --                   maxi

        -- the edgeSeparator vector encode which edge

        -- is te nearest to the midpoint.

        -- if True then it's the 'min' edges which are

        -- the nearest, otherwise it's the maximum edge

        edgeSeparator :: V2 Bool
edgeSeparator =
            Point -> Point
forall n (a :: * -> *). (Num n, Functor a) => a n -> a n
vabs (Point
abbc 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
abbc Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
maxi)

        -- So here we 'solidify' the nearest edge position

        -- in an edge vector.

        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

        -- If we're near an edge, snap the component to the

        -- edge.

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


-- | Rewrite the bezier curve to avoid degenerate cases.

sanitizeBezier :: Bezier -> Container Primitive
sanitizeBezier :: Bezier -> Container Primitive
sanitizeBezier bezier :: Bezier
bezier@(Bezier Point
a Point
b Point
c)
   -- If the two normals vector are far apart (cos nearly -1)

   --

   --       u           v

   -- <----------   ------------>

   -- because u dot v = ||u|| * ||v|| * cos(uv)

   --

   -- This imply that AB and BC are nearly parallel

   | Point
u Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Point
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< -Float
0.9999 =
     -- divide in to halves with

    Bezier -> Container Primitive
sanitizeBezier (Point -> Point -> Point -> Bezier
Bezier Point
a (Point
a Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
abbc) Point
abbc) Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<>
        Bezier -> Container Primitive
sanitizeBezier (Point -> Point -> Point -> Bezier
Bezier Point
abbc (Point
abbc Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
c) Point
c)

   -- b is far enough of b and c, (it's not a point)

   | Point
a Point -> Point -> Bool
`isDistingableFrom` Point
b Bool -> Bool -> Bool
&& Point
b Point -> Point -> Bool
`isDistingableFrom` Point
c =
       Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> Container Primitive)
-> (Bezier -> Primitive) -> Bezier -> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bezier -> Primitive
BezierPrim (Bezier -> Container Primitive) -> Bezier -> Container Primitive
forall a b. (a -> b) -> a -> b
$ Bezier
bezier

   -- if b is to nearby a or c, take the midpoint as new reference.

   | Point
ac Point -> Point -> Bool
`isDistingableFrom` Point
b = Bezier -> Container Primitive
sanitizeBezier (Point -> Point -> Point -> Bezier
Bezier Point
a Point
ac Point
c)
   | Bool
otherwise = Container Primitive
forall a. Monoid a => a
mempty
  where 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
b Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
c
        ac :: Point
ac = Point
a Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
c
        abbc :: Point
abbc = (Point
a Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
b) Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` (Point
b Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
c)

sanitizeBezierFilling :: Bezier -> Container Primitive
sanitizeBezierFilling :: Bezier -> Container Primitive
sanitizeBezierFilling bezier :: Bezier
bezier@(Bezier Point
a Point
b Point
c)
  | Point -> Bool
isDegenerate Point
a Bool -> Bool -> Bool
|| Point -> Bool
isDegenerate Point
b Bool -> Bool -> Bool
|| Point -> Bool
isDegenerate Point
c = 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
$ Bezier -> Primitive
BezierPrim Bezier
bezier

bezierBreakAt :: Bezier -> Float -> (Bezier, Bezier)
bezierBreakAt :: Bezier -> Float -> (Bezier, Bezier)
bezierBreakAt (Bezier Point
a Point
b Point
c) Float
t = (Point -> Point -> Point -> Bezier
Bezier Point
a Point
ab Point
abbc, Point -> Point -> Point -> Bezier
Bezier Point
abbc Point
bc Point
c)
  where
    --         X B

    --        / \

    --       /   \

    --   ab X--X--X bc

    --     / abbc  \

    --    /         \

    -- A X           X C

    ab :: Point
ab = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
t 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
t Point
c Point
b
    abbc :: Point
abbc = Float -> Point -> Point -> Point
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Float
t Point
bc Point
ab

splitBezier :: Bezier -> (Point, Point, Point)
{-# INLINE splitBezier #-}
splitBezier :: Bezier -> (Point, Point, Point)
splitBezier (Bezier Point
a Point
b Point
c) = (Point
ab, Point
bc, Point
abbc)
  where
    --

    --         X B

    --        / \

    --       /   \

    --   ab X--X--X bc

    --     / abbc  \

    --    /         \

    -- A X           X C

    --

    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
    abbc :: Point
abbc = Point
ab Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
bc

flattenBezier :: Bezier -> Container Primitive
flattenBezier :: Bezier -> Container Primitive
flattenBezier bezier :: Bezier
bezier@(Bezier Point
a Point
b Point
c)
    -- If the spline is not too curvy, just return the

    -- shifted component

    | Point
u Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Point
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0.9 = 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
$ Bezier -> Primitive
BezierPrim Bezier
bezier
    -- Otherwise, divide and conquer

    | Point
a Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
b Bool -> Bool -> Bool
&& Point
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
c =
        Bezier -> Container Primitive
flattenBezier (Point -> Point -> Point -> Bezier
Bezier Point
a Point
ab Point
abbc) Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<>
            Bezier -> Container Primitive
flattenBezier (Point -> Point -> Point -> Bezier
Bezier Point
abbc Point
bc Point
c)
    | Bool
otherwise = Container Primitive
forall a. Monoid a => a
mempty
  where --

        --         X B   

        --    ^   /^\   ^

        --   u \ /w| \ / v

        --      X-----X

        --     /       \

        --    /         \

        -- A X           X C

        --

        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
b Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
c

        (Point
ab, Point
bc, Point
abbc) = Bezier -> (Point, Point, Point)
splitBezier Bezier
bezier

-- | Move the bezier to a new position with an offset.

offsetBezier :: Float -> Bezier -> Container Primitive
offsetBezier :: Float -> Bezier -> Container Primitive
offsetBezier Float
offset bezier :: Bezier
bezier@(Bezier Point
a Point
b Point
c)
    -- If the spline is not too curvy, just return the

    -- shifted component

    | Point
u Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Point
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0.9 =
        Primitive -> Container Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Primitive -> Container Primitive)
-> (Bezier -> Primitive) -> Bezier -> Container Primitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bezier -> Primitive
BezierPrim (Bezier -> Container Primitive) -> Bezier -> Container Primitive
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point -> Bezier
Bezier Point
shiftedA Point
mergedB Point
shiftedC
    -- Otherwise, divide and conquer

    | Point
a Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
b Bool -> Bool -> Bool
&& Point
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
c =
        Float -> Bezier -> Container Primitive
offsetBezier Float
offset (Point -> Point -> Point -> Bezier
Bezier Point
a Point
ab Point
abbc) Container Primitive -> Container Primitive -> Container Primitive
forall a. Semigroup a => a -> a -> a
<>
            Float -> Bezier -> Container Primitive
offsetBezier Float
offset (Point -> Point -> Point -> Bezier
Bezier Point
abbc Point
bc Point
c)
    | Bool
otherwise = Container Primitive
forall a. Monoid a => a
mempty
  where --

        --         X B   

        --    ^   /^\   ^

        --   u \ /w| \ / v

        --      X-----X

        --     /       \

        --    /         \

        -- A X           X C

        --

        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
b Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
c
        w :: Point
w = Point
ab Point -> Point -> Point
forall v. (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
`normal` Point
bc

        (Point
ab, Point
bc, Point
abbc) = Bezier -> (Point, Point, Point)
splitBezier Bezier
bezier

        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)
        shiftedC :: Point
shiftedC = Point
c 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)
        shiftedABBC :: Point
shiftedABBC = Point
abbc 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)
        mergedB :: Point
mergedB =
            (Point
shiftedABBC Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
2.0) Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ (Point
shiftedA Point -> Point -> Point
forall (a :: * -> *) coord.
(Additive a, Fractional coord) =>
a coord -> a coord -> a coord
`midPoint` Point
shiftedC)