    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE FlexibleContexts     #-}
    {-# LANGUAGE FlexibleInstances    #-}
    {-# LANGUAGE TypeFamilies         #-}
    {-# LANGUAGE ViewPatterns         #-}
    {-# LANGUAGE UndecidableInstances #-}

    {-# OPTIONS_GHC -fno-warn-orphans #-}
    -- Orphan Traced instances for Segment Closed V2 and FixedSegment V2.
    -- They can't go in Traced; but they shouldn't really go in
    -- Diagrams.Segment either because we only have Traced instances for
    -- the special case of R2.
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.TwoD.Segment
    -- Copyright   :  (c) 2012 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Segments in two dimensions are special since we may meaningfully
    -- compute their point of intersection with a ray.
    --
    -----------------------------------------------------------------------------

    module Diagrams.TwoD.Segment
      ( -- * Segment intersections

        intersectPointsS
      , intersectPointsS'

        -- * Closest point on a segment

      , closestPoint
      , closestPoint'
      , closestDistance
      , closestDistance'
      , closestParam
      , closestParam'

        -- ** Low level functions
      , segmentSegment
      , lineSegment
      )
      where

    import           Control.Lens                    hiding (at, contains, transform, ( # ))
    import           Data.Maybe

    import           Diagrams.Core

    import           Diagrams.Direction
    import           Diagrams.Located
    import           Diagrams.Parametric
    import           Diagrams.Segment
    import           Diagrams.TwoD.Points
    import           Diagrams.TwoD.Segment.Bernstein
    import           Diagrams.TwoD.Transform
    import           Diagrams.TwoD.Types             hiding (p2)
    import           Diagrams.TwoD.Vector

    import           Linear.Affine
    import           Linear.Metric

    {- All instances of Traced should maintain the invariant that the list of
       traces is sorted in increasing order.
    -}

    instance OrderedField n => Traced (Segment Closed V2 n) where
      getTrace :: Segment Closed V2 n
    -> Trace (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
    getTrace = FixedSegment V2 n -> Trace V2 n
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace (FixedSegment V2 n -> Trace V2 n)
    -> (Segment Closed V2 n -> FixedSegment V2 n)
    -> Segment Closed V2 n
    -> Trace V2 n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located (Segment Closed V2 n) -> FixedSegment V2 n
    forall n (v :: * -> *).
    (Num n, Additive v) =>
    Located (Segment Closed v n) -> FixedSegment v n
    mkFixedSeg (Located (Segment Closed V2 n) -> FixedSegment V2 n)
    -> (Segment Closed V2 n -> Located (Segment Closed V2 n))
    -> Segment Closed V2 n
    -> FixedSegment V2 n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Segment Closed V2 n
    -> Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
    -> Located (Segment Closed V2 n)
    forall a. a -> Point (V a) (N a) -> Located a
    `at` Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
    forall (f :: * -> *) a. (Additive f, Num a) => Point f a
    origin)

    instance OrderedField n => Traced (FixedSegment V2 n) where
      getTrace :: FixedSegment V2 n
    -> Trace (V (FixedSegment V2 n)) (N (FixedSegment V2 n))
    getTrace seg :: FixedSegment V2 n
    seg = (Point V2 n -> V2 n -> SortedList n)
    -> Trace (V (FixedSegment V2 n)) (N (FixedSegment V2 n))
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    mkTrace ((Point V2 n -> V2 n -> SortedList n)
     -> Trace (V (FixedSegment V2 n)) (N (FixedSegment V2 n)))
    -> (Point V2 n -> V2 n -> SortedList n)
    -> Trace (V (FixedSegment V2 n)) (N (FixedSegment V2 n))
    forall a b. (a -> b) -> a -> b
    $ \p :: Point V2 n
    p v :: V2 n
    v ->
        [n] -> SortedList n
    forall a. Ord a => [a] -> SortedList a
    mkSortedList ([n] -> SortedList n)
    -> ([(n, n, Point V2 n)] -> [n])
    -> [(n, n, Point V2 n)]
    -> SortedList n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((n, n, Point V2 n) -> n) -> [(n, n, Point V2 n)] -> [n]
    forall a b. (a -> b) -> [a] -> [b]
    map (Getting n (n, n, Point V2 n) n -> (n, n, Point V2 n) -> n
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting n (n, n, Point V2 n) n
    forall s t a b. Field1 s t a b => Lens s t a b
    _1) ([(n, n, Point V2 n)] -> SortedList n)
    -> [(n, n, Point V2 n)] -> SortedList n
    forall a b. (a -> b) -> a -> b
    $ n -> Located (V2 n) -> FixedSegment V2 n -> [(n, n, Point V2 n)]
    forall n.
    OrderedField n =>
    n -> Located (V2 n) -> FixedSegment V2 n -> [(n, n, P2 n)]
    lineSegment n
    forall n. Fractional n => n
    defEps (V2 n
    v V2 n -> Point (V (V2 n)) (N (V2 n)) -> Located (V2 n)
    forall a. a -> Point (V a) (N a) -> Located a
    `at` Point (V (V2 n)) (N (V2 n))
    Point V2 n
    p) FixedSegment V2 n
    seg

    defEps :: Fractional n => n
    defEps :: n
    defEps = 1e-8

    -- | Compute the intersections between two fixed segments.
    intersectPointsS :: OrderedField n => FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]
    intersectPointsS :: FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]
    intersectPointsS = n -> FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]
    forall n.
    OrderedField n =>
    n -> FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]
    intersectPointsS' n
    forall n. Fractional n => n
    defEps

    -- | Compute the intersections between two segments using the given tolerance.
    intersectPointsS' :: OrderedField n => n -> FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]
    intersectPointsS' :: n -> FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]
    intersectPointsS' eps :: n
    eps s1 :: FixedSegment V2 n
    s1 s2 :: FixedSegment V2 n
    s2 = ((n, n, P2 n) -> P2 n) -> [(n, n, P2 n)] -> [P2 n]
    forall a b. (a -> b) -> [a] -> [b]
    map (Getting (P2 n) (n, n, P2 n) (P2 n) -> (n, n, P2 n) -> P2 n
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting (P2 n) (n, n, P2 n) (P2 n)
    forall s t a b. Field3 s t a b => Lens s t a b
    _3) ([(n, n, P2 n)] -> [P2 n]) -> [(n, n, P2 n)] -> [P2 n]
    forall a b. (a -> b) -> a -> b
    $ n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n, P2 n)]
    forall n.
    OrderedField n =>
    n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n, P2 n)]
    segmentSegment n
    eps FixedSegment V2 n
    s1 FixedSegment V2 n
    s2

    -- | Get the closest distance(s) from a point to a 'FixedSegment'.
    closestDistance :: OrderedField n => FixedSegment V2 n -> P2 n -> [n]
    closestDistance :: FixedSegment V2 n -> P2 n -> [n]
    closestDistance = n -> FixedSegment V2 n -> P2 n -> [n]
    forall n. OrderedField n => n -> FixedSegment V2 n -> P2 n -> [n]
    closestDistance' n
    forall n. Fractional n => n
    defEps

    -- | Get the closest distance(s) from a point to a 'FixedSegment' within given
    --   tolerance.
    closestDistance' :: OrderedField n => n -> FixedSegment V2 n -> P2 n -> [n]
    closestDistance' :: n -> FixedSegment V2 n -> P2 n -> [n]
    closestDistance' eps :: n
    eps seg :: FixedSegment V2 n
    seg p :: P2 n
    p = (P2 n -> n) -> [P2 n] -> [n]
    forall a b. (a -> b) -> [a] -> [b]
    map (P2 n -> P2 n -> n
    forall a (p :: * -> *).
    (Floating a, Foldable (Diff p), Affine p) =>
    p a -> p a -> a
    distanceA P2 n
    p) ([P2 n] -> [n]) -> [P2 n] -> [n]
    forall a b. (a -> b) -> a -> b
    $ n -> FixedSegment V2 n -> P2 n -> [P2 n]
    forall n.
    OrderedField n =>
    n -> FixedSegment V2 n -> P2 n -> [P2 n]
    closestPoint' n
    eps FixedSegment V2 n
    seg P2 n
    p

    -- | Get the closest point(s) on a 'FixedSegment' from a point.
    closestPoint :: OrderedField n => FixedSegment V2 n -> P2 n -> [P2 n]
    closestPoint :: FixedSegment V2 n -> P2 n -> [P2 n]
    closestPoint = n -> FixedSegment V2 n -> P2 n -> [P2 n]
    forall n.
    OrderedField n =>
    n -> FixedSegment V2 n -> P2 n -> [P2 n]
    closestPoint' n
    forall n. Fractional n => n
    defEps

    -- | Get the closest point(s) on a 'FixedSegment' from a point within given
    --   tolerance.
    closestPoint' :: OrderedField n => n -> FixedSegment V2 n -> P2 n -> [P2 n]
    closestPoint' :: n -> FixedSegment V2 n -> P2 n -> [P2 n]
    closestPoint' eps :: n
    eps seg :: FixedSegment V2 n
    seg = (n -> P2 n) -> [n] -> [P2 n]
    forall a b. (a -> b) -> [a] -> [b]
    map (FixedSegment V2 n
    seg FixedSegment V2 n
    -> N (FixedSegment V2 n)
    -> Codomain (FixedSegment V2 n) (N (FixedSegment V2 n))
    forall p. Parametric p => p -> N p -> Codomain p (N p)
    `atParam`) ([n] -> [P2 n]) -> (P2 n -> [n]) -> P2 n -> [P2 n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> FixedSegment V2 n -> P2 n -> [n]
    forall n. OrderedField n => n -> FixedSegment V2 n -> P2 n -> [n]
    closestParam' n
    eps FixedSegment V2 n
    seg

    -- | Find the closest value(s) on the Bêzier to the given point.
    closestParam :: OrderedField n => FixedSegment V2 n -> P2 n -> [n]
    closestParam :: FixedSegment V2 n -> P2 n -> [n]
    closestParam = n -> FixedSegment V2 n -> P2 n -> [n]
    forall n. OrderedField n => n -> FixedSegment V2 n -> P2 n -> [n]
    closestParam' n
    forall n. Fractional n => n
    defEps

    -- | Find the closest value(s) on the Bêzier to the given point within given
    --   tolerance.
    closestParam' :: OrderedField n => n -> FixedSegment V2 n -> P2 n -> [n]
    closestParam' :: n -> FixedSegment V2 n -> P2 n -> [n]
    closestParam' _ (FLinear p0 :: P2 n
    p0 p1 :: P2 n
    p1) p :: P2 n
    p
      | n
    t n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0     = [0]
      | n
    t n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > 1     = [1]
      | Bool
    otherwise = [n
    t]
      where
        vp :: Diff (Point V2) n
    vp = P2 n
    p  P2 n -> P2 n -> Diff (Point V2) n
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
    .-. P2 n
    p0
        v :: Diff (Point V2) n
    v  = P2 n
    p1 P2 n -> P2 n -> Diff (Point V2) n
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
    .-. P2 n
    p0
        dp :: n
    dp = Diff (Point V2) n
    V2 n
    vp V2 n -> V2 n -> n
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
    `dot` Diff (Point V2) n
    V2 n
    v
        t :: n
    t  = n
    dp n -> n -> n
    forall a. Fractional a => a -> a -> a
    / V2 n -> n
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
    quadrance Diff (Point V2) n
    V2 n
    v
    closestParam' eps :: n
    eps cb :: FixedSegment V2 n
    cb (P (V2 px :: n
    px py :: n
    py)) = n -> BernsteinPoly n -> n -> n -> [n]
    forall n. OrderedField n => n -> BernsteinPoly n -> n -> n -> [n]
    bezierFindRoot n
    eps BernsteinPoly n
    poly 0 1
      where
        (bx :: BernsteinPoly n
    bx, by :: BernsteinPoly n
    by) = FixedSegment V2 n -> (BernsteinPoly n, BernsteinPoly n)
    forall n.
    Fractional n =>
    FixedSegment V2 n -> (BernsteinPoly n, BernsteinPoly n)
    bezierToBernstein FixedSegment V2 n
    cb
        bx' :: BernsteinPoly n
    bx'  = BernsteinPoly n -> BernsteinPoly n
    forall n. Fractional n => BernsteinPoly n -> BernsteinPoly n
    bernsteinDeriv BernsteinPoly n
    bx
        by' :: BernsteinPoly n
    by'  = BernsteinPoly n -> BernsteinPoly n
    forall n. Fractional n => BernsteinPoly n -> BernsteinPoly n
    bernsteinDeriv BernsteinPoly n
    by
        poly :: BernsteinPoly n
    poly = (BernsteinPoly n
    bx BernsteinPoly n -> BernsteinPoly n -> BernsteinPoly n
    forall a. Num a => a -> a -> a
    - [n] -> BernsteinPoly n
    forall n. Fractional n => [n] -> BernsteinPoly n
    listToBernstein [n
    px, n
    px, n
    px, n
    px]) BernsteinPoly n -> BernsteinPoly n -> BernsteinPoly n
    forall a. Num a => a -> a -> a
    * BernsteinPoly n
    bx'
             BernsteinPoly n -> BernsteinPoly n -> BernsteinPoly n
    forall a. Num a => a -> a -> a
    + (BernsteinPoly n
    by BernsteinPoly n -> BernsteinPoly n -> BernsteinPoly n
    forall a. Num a => a -> a -> a
    - [n] -> BernsteinPoly n
    forall n. Fractional n => [n] -> BernsteinPoly n
    listToBernstein [n
    py, n
    py, n
    py, n
    py]) BernsteinPoly n -> BernsteinPoly n -> BernsteinPoly n
    forall a. Num a => a -> a -> a
    * BernsteinPoly n
    by'

    ------------------------------------------------------------------------
    -- Low level
    ------------------------------------------------------------------------

    -- | Return the intersection points with the parameters at which each segment
    --   intersects.
    segmentSegment :: OrderedField n => n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n, P2 n)]
    segmentSegment :: n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n, P2 n)]
    segmentSegment eps :: n
    eps s1 :: FixedSegment V2 n
    s1 s2 :: FixedSegment V2 n
    s2 =
      case (FixedSegment V2 n
    s1,FixedSegment V2 n
    s2) of
        (FCubic{}, FCubic{})  -> ((n, n) -> (n, n, P2 n)) -> [(n, n)] -> [(n, n, P2 n)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(t1 :: n
    t1,t2 :: n
    t2) -> (n
    t1,n
    t2, FixedSegment V2 n
    s1 FixedSegment V2 n
    -> N (FixedSegment V2 n)
    -> Codomain (FixedSegment V2 n) (N (FixedSegment V2 n))
    forall p. Parametric p => p -> N p -> Codomain p (N p)
    `atParam` n
    N (FixedSegment V2 n)
    t1))
                               ([(n, n)] -> [(n, n, P2 n)]) -> [(n, n)] -> [(n, n, P2 n)]
    forall a b. (a -> b) -> a -> b
    $ n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n)]
    forall n.
    OrderedField n =>
    n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n)]
    bezierClip n
    eps FixedSegment V2 n
    s1 FixedSegment V2 n
    s2
        (FCubic{}, FLinear{}) -> ((n, n, P2 n) -> (n, n, P2 n)) -> [(n, n, P2 n)] -> [(n, n, P2 n)]
    forall a b. (a -> b) -> [a] -> [b]
    map (n, n, P2 n) -> (n, n, P2 n)
    forall b a c. (b, a, c) -> (a, b, c)
    flip12 ([(n, n, P2 n)] -> [(n, n, P2 n)])
    -> [(n, n, P2 n)] -> [(n, n, P2 n)]
    forall a b. (a -> b) -> a -> b
    $ Located (V2 n) -> FixedSegment V2 n -> [(n, n, P2 n)]
    linearSeg (FixedSegment V2 n -> Located (V2 n)
    forall (v :: * -> *) n.
    InSpace v n (v n) =>
    FixedSegment v n -> Located (v n)
    segLine FixedSegment V2 n
    s2) FixedSegment V2 n
    s1
        _                     -> Located (V2 n) -> FixedSegment V2 n -> [(n, n, P2 n)]
    linearSeg (FixedSegment V2 n -> Located (V2 n)
    forall (v :: * -> *) n.
    InSpace v n (v n) =>
    FixedSegment v n -> Located (v n)
    segLine FixedSegment V2 n
    s1) FixedSegment V2 n
    s2 -- s1 is linear
      where
        linearSeg :: Located (V2 n) -> FixedSegment V2 n -> [(n, n, P2 n)]
    linearSeg l :: Located (V2 n)
    l s :: FixedSegment V2 n
    s  = ((n, n, P2 n) -> Bool) -> [(n, n, P2 n)] -> [(n, n, P2 n)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (n -> Bool
    forall n. (Fractional n, Ord n) => n -> Bool
    inRange (n -> Bool) -> ((n, n, P2 n) -> n) -> (n, n, P2 n) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Getting n (n, n, P2 n) n -> (n, n, P2 n) -> n
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting n (n, n, P2 n) n
    forall s t a b. Field1 s t a b => Lens s t a b
    _1) ([(n, n, P2 n)] -> [(n, n, P2 n)])
    -> [(n, n, P2 n)] -> [(n, n, P2 n)]
    forall a b. (a -> b) -> a -> b
    $ n -> Located (V2 n) -> FixedSegment V2 n -> [(n, n, P2 n)]
    forall n.
    OrderedField n =>
    n -> Located (V2 n) -> FixedSegment V2 n -> [(n, n, P2 n)]
    lineSegment n
    eps Located (V2 n)
    l FixedSegment V2 n
    s
        flip12 :: (b, a, c) -> (a, b, c)
    flip12 (a :: b
    a,b :: a
    b,c :: c
    c) = (a
    b,b
    a,c
    c)

    -- | Return the intersection points with the parameters at which the line and segment
    --   intersect.
    lineSegment :: OrderedField n => n -> Located (V2 n) -> FixedSegment V2 n -> [(n, n, P2 n)]
    lineSegment :: n -> Located (V2 n) -> FixedSegment V2 n -> [(n, n, P2 n)]
    lineSegment _ l1 :: Located (V2 n)
    l1 p :: FixedSegment V2 n
    p@(FLinear p0 :: P2 n
    p0 p1 :: P2 n
    p1)
      = ((n, n) -> (n, n, P2 n)) -> [(n, n)] -> [(n, n, P2 n)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(tl :: n
    tl,tp :: n
    tp) -> (n
    tl, n
    tp, FixedSegment V2 n
    p FixedSegment V2 n
    -> N (FixedSegment V2 n)
    -> Codomain (FixedSegment V2 n) (N (FixedSegment V2 n))
    forall p. Parametric p => p -> N p -> Codomain p (N p)
    `atParam` n
    N (FixedSegment V2 n)
    tp))
      ([(n, n)] -> [(n, n, P2 n)])
    -> (Maybe (n, n) -> [(n, n)]) -> Maybe (n, n) -> [(n, n, P2 n)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((n, n) -> Bool) -> [(n, n)] -> [(n, n)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (n -> Bool
    forall n. (Fractional n, Ord n) => n -> Bool
    inRange (n -> Bool) -> ((n, n) -> n) -> (n, n) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (n, n) -> n
    forall a b. (a, b) -> b
    snd) ([(n, n)] -> [(n, n)])
    -> (Maybe (n, n) -> [(n, n)]) -> Maybe (n, n) -> [(n, n)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (n, n) -> [(n, n)]
    forall a. Maybe a -> [a]
    maybeToList (Maybe (n, n) -> [(n, n, P2 n)]) -> Maybe (n, n) -> [(n, n, P2 n)]
    forall a b. (a -> b) -> a -> b
    $ Located (V2 n) -> Located (V2 n) -> Maybe (n, n)
    forall n.
    (Fractional n, Eq n) =>
    Located (V2 n) -> Located (V2 n) -> Maybe (n, n)
    lineLine Located (V2 n)
    l1 (P2 n -> P2 n -> Located (V2 n)
    forall (v :: * -> *) n.
    InSpace v n (v n) =>
    Point v n -> Point v n -> Located (v n)
    mkLine P2 n
    p0 P2 n
    p1)
    lineSegment eps :: n
    eps (Located (V2 n) -> (Point (V (V2 n)) (N (V2 n)), V2 n)
    forall a. Located a -> (Point (V a) (N a), a)
    viewLoc -> (p :: Point (V (V2 n)) (N (V2 n))
    p,r :: V2 n
    r)) cb :: FixedSegment V2 n
    cb = (n -> (n, n, P2 n)) -> [n] -> [(n, n, P2 n)]
    forall a b. (a -> b) -> [a] -> [b]
    map n -> (n, n, P2 n)
    addPoint [n]
    params
      where
        params :: [n]
    params = n -> BernsteinPoly n -> n -> n -> [n]
    forall n. OrderedField n => n -> BernsteinPoly n -> n -> n -> [n]
    bezierFindRoot n
    eps ([n] -> BernsteinPoly n
    forall n. Fractional n => [n] -> BernsteinPoly n
    listToBernstein ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
    forall a b. (a -> b) -> a -> b
    $ FixedSegment V2 n
    cb' FixedSegment V2 n
    -> Getting (Endo [n]) (FixedSegment V2 n) n -> [n]
    forall s a. s -> Getting (Endo [a]) s a -> [a]
    ^.. (P2 n -> Const (Endo [n]) (P2 n))
    -> FixedSegment V2 n -> Const (Endo [n]) (FixedSegment V2 n)
    forall s t a b. Each s t a b => Traversal s t a b
    each ((P2 n -> Const (Endo [n]) (P2 n))
     -> FixedSegment V2 n -> Const (Endo [n]) (FixedSegment V2 n))
    -> ((n -> Const (Endo [n]) n) -> P2 n -> Const (Endo [n]) (P2 n))
    -> Getting (Endo [n]) (FixedSegment V2 n) n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (n -> Const (Endo [n]) n) -> P2 n -> Const (Endo [n]) (P2 n)
    forall (t :: * -> *) a. R2 t => Lens' (t a) a
    _y) 0 1
        cb' :: FixedSegment V2 n
    cb'    = Transformation (V (FixedSegment V2 n)) (N (FixedSegment V2 n))
    -> FixedSegment V2 n -> FixedSegment V2 n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform (Transformation V2 n -> Transformation V2 n
    forall (v :: * -> *) n.
    (Functor v, Num n) =>
    Transformation v n -> Transformation v n
    inv (Direction V2 n -> Transformation V2 n
    forall n. OrderedField n => Direction V2 n -> T2 n
    rotationTo (Direction V2 n -> Transformation V2 n)
    -> Direction V2 n -> Transformation V2 n
    forall a b. (a -> b) -> a -> b
    $ V2 n -> Direction V2 n
    forall (v :: * -> *) n. v n -> Direction v n
    dir V2 n
    r)) (FixedSegment V2 n -> FixedSegment V2 n)
    -> (FixedSegment V2 n -> FixedSegment V2 n)
    -> FixedSegment V2 n
    -> FixedSegment V2 n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Point (V (FixedSegment V2 n)) (N (FixedSegment V2 n))
    -> FixedSegment V2 n -> FixedSegment V2 n
    forall t. HasOrigin t => Point (V t) (N t) -> t -> t
    moveOriginTo Point (V (V2 n)) (N (V2 n))
    Point (V (FixedSegment V2 n)) (N (FixedSegment V2 n))
    p (FixedSegment V2 n -> FixedSegment V2 n)
    -> FixedSegment V2 n -> FixedSegment V2 n
    forall a b. (a -> b) -> a -> b
    $ FixedSegment V2 n
    cb
        --
        addPoint :: n -> (n, n, P2 n)
    addPoint bt :: n
    bt = (n
    lt, n
    bt, P2 n
    Codomain (FixedSegment V2 n) (N (FixedSegment V2 n))
    intersect)
          where
            intersect :: Codomain (FixedSegment V2 n) (N (FixedSegment V2 n))
    intersect = FixedSegment V2 n
    cb FixedSegment V2 n
    -> N (FixedSegment V2 n)
    -> Codomain (FixedSegment V2 n) (N (FixedSegment V2 n))
    forall p. Parametric p => p -> N p -> Codomain p (N p)
    `atParam` n
    N (FixedSegment V2 n)
    bt
            lt :: n
    lt        = (FixedSegment V2 n
    cb' FixedSegment V2 n
    -> N (FixedSegment V2 n)
    -> Codomain (FixedSegment V2 n) (N (FixedSegment V2 n))
    forall p. Parametric p => p -> N p -> Codomain p (N p)
    `atParam` n
    N (FixedSegment V2 n)
    bt) P2 n -> Getting n (P2 n) n -> n
    forall s a. s -> Getting a s a -> a
    ^. Getting n (P2 n) n
    forall (t :: * -> *) a. R1 t => Lens' (t a) a
    _x n -> n -> n
    forall a. Fractional a => a -> a -> a
    / V2 n -> n
    forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
    norm V2 n
    r

    -- Adapted from from kuribas's cubicbezier package https://github.com/kuribas/cubicbezier

    -- | Use the Bêzier clipping algorithm to return the parameters at which the
    --   Bêzier curves intersect.
    bezierClip :: OrderedField n => n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n)]
    bezierClip :: n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n)]
    bezierClip eps :: n
    eps p_ :: FixedSegment V2 n
    p_ q_ :: FixedSegment V2 n
    q_ = ((n, n) -> Bool) -> [(n, n)] -> [(n, n)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Getting All (n, n) n -> (n -> Bool) -> (n, n) -> Bool
    forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
    allOf Getting All (n, n) n
    forall (r :: * -> * -> *) a b.
    Bitraversable r =>
    Traversal (r a a) (r b b) a b
    both n -> Bool
    forall n. (Fractional n, Ord n) => n -> Bool
    inRange) -- sometimes this returns NaN
                         ([(n, n)] -> [(n, n)]) -> [(n, n)] -> [(n, n)]
    forall a b. (a -> b) -> a -> b
    $ FixedSegment V2 n
    -> FixedSegment V2 n -> n -> n -> n -> n -> n -> Bool -> [(n, n)]
    go FixedSegment V2 n
    p_ FixedSegment V2 n
    q_ 0 1 0 1 0 Bool
    False
      where
      go :: FixedSegment V2 n
    -> FixedSegment V2 n -> n -> n -> n -> n -> n -> Bool -> [(n, n)]
    go p :: FixedSegment V2 n
    p q :: FixedSegment V2 n
    q tmin :: n
    tmin tmax :: n
    tmax umin :: n
    umin umax :: n
    umax clip :: n
    clip revCurves :: Bool
    revCurves
        | Maybe (n, n) -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe (n, n)
    chopInterval = []

        -- This check happens before the subdivision
        -- test to avoid non-termination as values
        -- transition to within epsilon.
        | n -> n -> n
    forall a. Ord a => a -> a -> a
    max (n
    umax n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    umin) (n
    tmax' n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tmin') n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    < n
    eps =
          if Bool
    revCurves -- return parameters in correct order
          then [ (n -> n -> n
    forall a. Fractional a => a -> a -> a
    avg n
    umin  n
    umax,  n -> n -> n
    forall a. Fractional a => a -> a -> a
    avg n
    tmin' n
    tmax') ]
          else [ (n -> n -> n
    forall a. Fractional a => a -> a -> a
    avg n
    tmin' n
    tmax', n -> n -> n
    forall a. Fractional a => a -> a -> a
    avg n
    umin  n
    umax ) ]

        -- split the curve if there isn't enough reduction
        | n
    clip n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0.8 Bool -> Bool -> Bool
    && n
    clip' n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0.8 =
          if n
    tmax' n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tmin' n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > n
    umax n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    umin -- split the longest segment
          then let (pl :: FixedSegment V2 n
    pl, pr :: FixedSegment V2 n
    pr) = FixedSegment V2 n
    p' FixedSegment V2 n
    -> N (FixedSegment V2 n) -> (FixedSegment V2 n, FixedSegment V2 n)
    forall p. Sectionable p => p -> N p -> (p, p)
    `splitAtParam` 0.5
                   tmid :: n
    tmid = n -> n -> n
    forall a. Fractional a => a -> a -> a
    avg n
    tmin' n
    tmax'
               in  FixedSegment V2 n
    -> FixedSegment V2 n -> n -> n -> n -> n -> n -> Bool -> [(n, n)]
    go FixedSegment V2 n
    q FixedSegment V2 n
    pl n
    umin n
    umax n
    tmin' n
    tmid  n
    clip' (Bool -> Bool
    not Bool
    revCurves) [(n, n)] -> [(n, n)] -> [(n, n)]
    forall a. [a] -> [a] -> [a]
    ++
                   FixedSegment V2 n
    -> FixedSegment V2 n -> n -> n -> n -> n -> n -> Bool -> [(n, n)]
    go FixedSegment V2 n
    q FixedSegment V2 n
    pr n
    umin n
    umax n
    tmid  n
    tmax' n
    clip' (Bool -> Bool
    not Bool
    revCurves)
          else let (ql :: FixedSegment V2 n
    ql, qr :: FixedSegment V2 n
    qr) = FixedSegment V2 n
    q FixedSegment V2 n
    -> N (FixedSegment V2 n) -> (FixedSegment V2 n, FixedSegment V2 n)
    forall p. Sectionable p => p -> N p -> (p, p)
    `splitAtParam` 0.5
                   umid :: n
    umid = n -> n -> n
    forall a. Fractional a => a -> a -> a
    avg n
    umin n
    umax
               in  FixedSegment V2 n
    -> FixedSegment V2 n -> n -> n -> n -> n -> n -> Bool -> [(n, n)]
    go FixedSegment V2 n
    ql FixedSegment V2 n
    p' n
    umin n
    umid n
    tmin' n
    tmax' n
    clip' (Bool -> Bool
    not Bool
    revCurves) [(n, n)] -> [(n, n)] -> [(n, n)]
    forall a. [a] -> [a] -> [a]
    ++
                   FixedSegment V2 n
    -> FixedSegment V2 n -> n -> n -> n -> n -> n -> Bool -> [(n, n)]
    go FixedSegment V2 n
    qr FixedSegment V2 n
    p' n
    umid n
    umax n
    tmin' n
    tmax' n
    clip' (Bool -> Bool
    not Bool
    revCurves)

        -- iterate with the curves reversed.
        | Bool
    otherwise = FixedSegment V2 n
    -> FixedSegment V2 n -> n -> n -> n -> n -> n -> Bool -> [(n, n)]
    go FixedSegment V2 n
    q FixedSegment V2 n
    p' n
    umin n
    umax n
    tmin' n
    tmax' n
    clip' (Bool -> Bool
    not Bool
    revCurves)
        where
          chopInterval :: Maybe (n, n)
    chopInterval              = FixedSegment V2 n -> FixedSegment V2 n -> Maybe (n, n)
    forall n.
    OrderedField n =>
    FixedSegment V2 n -> FixedSegment V2 n -> Maybe (n, n)
    chopCubics FixedSegment V2 n
    p FixedSegment V2 n
    q
          Just (tminChop :: n
    tminChop, tmaxChop :: n
    tmaxChop) = Maybe (n, n)
    chopInterval
          p' :: FixedSegment V2 n
    p'    = FixedSegment V2 n
    -> N (FixedSegment V2 n)
    -> N (FixedSegment V2 n)
    -> FixedSegment V2 n
    forall p. Sectionable p => p -> N p -> N p -> p
    section FixedSegment V2 n
    p n
    N (FixedSegment V2 n)
    tminChop n
    N (FixedSegment V2 n)
    tmaxChop
          clip' :: n
    clip' = n
    tmaxChop n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tminChop
          tmin' :: n
    tmin' = n
    tmax n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    tminChop n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    tmin n -> n -> n
    forall a. Num a => a -> a -> a
    * (1 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tminChop)
          tmax' :: n
    tmax' = n
    tmax n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    tmaxChop n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    tmin n -> n -> n
    forall a. Num a => a -> a -> a
    * (1 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tmaxChop)

    -- | Find the zero of a 1D Bêzier curve of any degree.  Note that this
    --   can be used as a Bernstein polynomial root solver by converting from
    --   the power basis to the Bernstein basis.
    bezierFindRoot :: OrderedField n
                   => n   -- ^ The accuracy
                   -> BernsteinPoly n -- ^ the Bernstein coefficients of the polynomial
                   -> n   -- ^ The lower bound of the interval
                   -> n   -- ^ The upper bound of the interval
                   -> [n] -- ^ The roots found
    bezierFindRoot :: n -> BernsteinPoly n -> n -> n -> [n]
    bezierFindRoot eps :: n
    eps p :: BernsteinPoly n
    p tmin :: n
    tmin tmax :: n
    tmax
      | Maybe (n, n) -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe (n, n)
    chopInterval    = []
      | n
    clip n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0.8 = let (p1 :: BernsteinPoly n
    p1, p2 :: BernsteinPoly n
    p2) = BernsteinPoly n
    -> N (BernsteinPoly n) -> (BernsteinPoly n, BernsteinPoly n)
    forall p. Sectionable p => p -> N p -> (p, p)
    splitAtParam BernsteinPoly n
    newP 0.5
                         tmid :: n
    tmid     = n
    tmin' n -> n -> n
    forall a. Num a => a -> a -> a
    + (n
    tmax' n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tmin') n -> n -> n
    forall a. Fractional a => a -> a -> a
    / 2
                     in  n -> BernsteinPoly n -> n -> n -> [n]
    forall n. OrderedField n => n -> BernsteinPoly n -> n -> n -> [n]
    bezierFindRoot n
    eps BernsteinPoly n
    p1 n
    tmin' n
    tmid  [n] -> [n] -> [n]
    forall a. [a] -> [a] -> [a]
    ++
                         n -> BernsteinPoly n -> n -> n -> [n]
    forall n. OrderedField n => n -> BernsteinPoly n -> n -> n -> [n]
    bezierFindRoot n
    eps BernsteinPoly n
    p2 n
    tmid  n
    tmax'
      | n
    tmax' n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tmin' n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    < n
    eps = [n -> n -> n
    forall a. Fractional a => a -> a -> a
    avg n
    tmin' n
    tmax']
      | Bool
    otherwise           = n -> BernsteinPoly n -> n -> n -> [n]
    forall n. OrderedField n => n -> BernsteinPoly n -> n -> n -> [n]
    bezierFindRoot n
    eps BernsteinPoly n
    newP n
    tmin' n
    tmax'
      where
        chopInterval :: Maybe (n, n)
    chopInterval              = [n] -> Maybe (n, n)
    forall n. OrderedField n => [n] -> Maybe (n, n)
    chopYs (BernsteinPoly n -> [n]
    forall n. BernsteinPoly n -> [n]
    bernsteinCoeffs BernsteinPoly n
    p)
        Just (tminChop :: n
    tminChop, tmaxChop :: n
    tmaxChop) = Maybe (n, n)
    chopInterval
        newP :: BernsteinPoly n
    newP  = BernsteinPoly n
    -> N (BernsteinPoly n) -> N (BernsteinPoly n) -> BernsteinPoly n
    forall p. Sectionable p => p -> N p -> N p -> p
    section BernsteinPoly n
    p n
    N (BernsteinPoly n)
    tminChop n
    N (BernsteinPoly n)
    tmaxChop
        clip :: n
    clip  = n
    tmaxChop n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tminChop
        tmin' :: n
    tmin' = n
    tmax n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    tminChop n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    tmin n -> n -> n
    forall a. Num a => a -> a -> a
    * (1 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tminChop)
        tmax' :: n
    tmax' = n
    tmax n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    tmaxChop n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    tmin n -> n -> n
    forall a. Num a => a -> a -> a
    * (1 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    tmaxChop)

    ------------------------------------------------------------------------
    -- Internal
    ------------------------------------------------------------------------

    -- | An approximation of the fat line for a cubic Bêzier segment. Returns
    --   @(0,0)@ for a linear segment.
    fatLine :: OrderedField n => FixedSegment V2 n -> (n,n)
    fatLine :: FixedSegment V2 n -> (n, n)
    fatLine (FCubic p0 :: Point V2 n
    p0 p1 :: Point V2 n
    p1 p2 :: Point V2 n
    p2 p3 :: Point V2 n
    p3)
      = case (n
    d1 n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0, n
    d2 n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0) of
          (True,  True)  -> (0,                0.75 n -> n -> n
    forall a. Num a => a -> a -> a
    * n -> n -> n
    forall a. Ord a => a -> a -> a
    max n
    d1 n
    d2)
          (False, False) -> (0.75 n -> n -> n
    forall a. Num a => a -> a -> a
    * n -> n -> n
    forall a. Ord a => a -> a -> a
    min n
    d1 n
    d2, 0               )
          (True,  False) -> (4n -> n -> n
    forall a. Fractional a => a -> a -> a
    /9 n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    d2,         4n -> n -> n
    forall a. Fractional a => a -> a -> a
    /9 n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    d1        )
          (False, True)  -> (4n -> n -> n
    forall a. Fractional a => a -> a -> a
    /9 n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    d1,         4n -> n -> n
    forall a. Fractional a => a -> a -> a
    /9 n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    d2        )
      where
        d :: Point V2 n -> n
    d = Point V2 n -> Point V2 n -> Point V2 n -> n
    forall n. (Ord n, Floating n) => P2 n -> P2 n -> P2 n -> n
    lineDistance Point V2 n
    p0 Point V2 n
    p3
        d1 :: n
    d1 = Point V2 n -> n
    d Point V2 n
    p1; d2 :: n
    d2 = Point V2 n -> n
    d Point V2 n
    p2
    fatLine _ = (0,0)

    chopYs :: OrderedField n => [n] -> Maybe (n, n)
    chopYs :: [n] -> Maybe (n, n)
    chopYs ds :: [n]
    ds = n -> n -> [P2 n] -> Maybe (n, n)
    forall n. OrderedField n => n -> n -> [P2 n] -> Maybe (n, n)
    chopHull 0 0 [P2 n]
    points
      where
        points :: [P2 n]
    points = (n -> n -> P2 n) -> [n] -> [n] -> [P2 n]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith n -> n -> P2 n
    forall n. n -> n -> P2 n
    mkP2 [Int -> n
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i n -> n -> n
    forall a. Fractional a => a -> a -> a
    / Int -> n
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n | Int
    i <- [0..Int
    n]] [n]
    ds
        n :: Int
    n      = [n] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [n]
    ds Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1

    chopCubics :: OrderedField n => FixedSegment V2 n -> FixedSegment V2 n -> Maybe (n,n)
    chopCubics :: FixedSegment V2 n -> FixedSegment V2 n -> Maybe (n, n)
    chopCubics p :: FixedSegment V2 n
    p q :: FixedSegment V2 n
    q@(FCubic q0 :: Point V2 n
    q0 _ _ q3 :: Point V2 n
    q3)
      = n -> n -> [Point V2 n] -> Maybe (n, n)
    forall n. OrderedField n => n -> n -> [P2 n] -> Maybe (n, n)
    chopHull n
    dmin n
    dmax [Point V2 n]
    dps
      where
        dps :: [Point V2 n]
    dps = (n -> n -> Point V2 n) -> [n] -> [n] -> [Point V2 n]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith n -> n -> Point V2 n
    forall n. n -> n -> P2 n
    mkP2 [0, 1n -> n -> n
    forall a. Fractional a => a -> a -> a
    /3, 2n -> n -> n
    forall a. Fractional a => a -> a -> a
    /3, 1] [n]
    ds
        ds :: [n]
    ds  = FixedSegment V2 n
    p FixedSegment V2 n
    -> Getting (Endo [n]) (FixedSegment V2 n) n -> [n]
    forall s a. s -> Getting (Endo [a]) s a -> [a]
    ^.. (Point V2 n -> Const (Endo [n]) (Point V2 n))
    -> FixedSegment V2 n -> Const (Endo [n]) (FixedSegment V2 n)
    forall s t a b. Each s t a b => Traversal s t a b
    each ((Point V2 n -> Const (Endo [n]) (Point V2 n))
     -> FixedSegment V2 n -> Const (Endo [n]) (FixedSegment V2 n))
    -> ((n -> Const (Endo [n]) n)
        -> Point V2 n -> Const (Endo [n]) (Point V2 n))
    -> Getting (Endo [n]) (FixedSegment V2 n) n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Point V2 n -> n)
    -> (n -> Const (Endo [n]) n)
    -> Point V2 n
    -> Const (Endo [n]) (Point V2 n)
    forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    to Point V2 n -> n
    d
        d :: Point V2 n -> n
    d   = Point V2 n -> Point V2 n -> Point V2 n -> n
    forall n. (Ord n, Floating n) => P2 n -> P2 n -> P2 n -> n
    lineDistance Point V2 n
    q0 Point V2 n
    q3
        --
        (dmin :: n
    dmin,dmax :: n
    dmax) = FixedSegment V2 n -> (n, n)
    forall n. OrderedField n => FixedSegment V2 n -> (n, n)
    fatLine FixedSegment V2 n
    q
    chopCubics _ _ = Maybe (n, n)
    forall a. Maybe a
    Nothing

    -- Reduce the interval which the intersection is known to lie in using the fat
    -- line of one curve and convex hull of the points formed from the distance to
    -- the thin line of the other
    chopHull :: OrderedField n => n -> n -> [P2 n] -> Maybe (n, n)
    chopHull :: n -> n -> [P2 n] -> Maybe (n, n)
    chopHull dmin :: n
    dmin dmax :: n
    dmax dps :: [P2 n]
    dps = do
      n
    tL <- [P2 n] -> Maybe n -> Maybe n
    testBelow [P2 n]
    upper           (Maybe n -> Maybe n) -> Maybe n -> Maybe n
    forall a b. (a -> b) -> a -> b
    $ P2 n -> Maybe n -> Maybe n
    testBetween ([P2 n] -> P2 n
    forall a. [a] -> a
    head [P2 n]
    upper) (Maybe n -> Maybe n) -> Maybe n -> Maybe n
    forall a b. (a -> b) -> a -> b
    $ [P2 n] -> Maybe n
    testAbove [P2 n]
    lower
      n
    tR <- [P2 n] -> Maybe n -> Maybe n
    testBelow ([P2 n] -> [P2 n]
    forall a. [a] -> [a]
    reverse [P2 n]
    upper) (Maybe n -> Maybe n) -> Maybe n -> Maybe n
    forall a b. (a -> b) -> a -> b
    $ P2 n -> Maybe n -> Maybe n
    testBetween ([P2 n] -> P2 n
    forall a. [a] -> a
    last [P2 n]
    upper) (Maybe n -> Maybe n) -> Maybe n -> Maybe n
    forall a b. (a -> b) -> a -> b
    $ [P2 n] -> Maybe n
    testAbove ([P2 n] -> [P2 n]
    forall a. [a] -> [a]
    reverse [P2 n]
    lower)
      (n, n) -> Maybe (n, n)
    forall a. a -> Maybe a
    Just (n
    tL, n
    tR)
        where
          (upper :: [P2 n]
    upper, lower :: [P2 n]
    lower) = [P2 n] -> ([P2 n], [P2 n])
    forall n. OrderedField n => [P2 n] -> ([P2 n], [P2 n])
    sortedConvexHull [P2 n]
    dps

          testBelow :: [P2 n] -> Maybe n -> Maybe n
    testBelow (p1 :: P2 n
    p1@(P (V2 _ y1 :: n
    y1)) : p2 :: P2 n
    p2@(P (V2 _ y2 :: n
    y2)) : ps :: [P2 n]
    ps) continue :: Maybe n
    continue
            | n
    y1 n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    >= n
    dmin = Maybe n
    continue
            | n
    y1 n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    >  n
    y2   = Maybe n
    forall a. Maybe a
    Nothing
            | n
    y2 n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <  n
    dmin = [P2 n] -> Maybe n -> Maybe n
    testBelow (P2 n
    p2P2 n -> [P2 n] -> [P2 n]
    forall a. a -> [a] -> [a]
    :[P2 n]
    ps) Maybe n
    continue
            | Bool
    otherwise  = n -> Maybe n
    forall a. a -> Maybe a
    Just (n -> Maybe n) -> n -> Maybe n
    forall a b. (a -> b) -> a -> b
    $ n -> P2 n -> P2 n -> n
    forall a. Fractional a => a -> Point V2 a -> Point V2 a -> a
    intersectPt n
    dmin P2 n
    p1 P2 n
    p2
          testBelow _ _  = Maybe n
    forall a. Maybe a
    Nothing

          testBetween :: P2 n -> Maybe n -> Maybe n
    testBetween (P (V2 x :: n
    x y :: n
    y)) continue :: Maybe n
    continue
            | n
    y n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <= n
    dmax = n -> Maybe n
    forall a. a -> Maybe a
    Just n
    x
            | Bool
    otherwise = Maybe n
    continue

          testAbove :: [P2 n] -> Maybe n
    testAbove (p1 :: P2 n
    p1@(P (V2 _ y1 :: n
    y1)) : p2 :: P2 n
    p2@(P (V2 _ y2 :: n
    y2)) : ps :: [P2 n]
    ps)
            | n
    y1 n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    < n
    y2      = Maybe n
    forall a. Maybe a
    Nothing
            | n
    y2 n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > n
    dmax    = [P2 n] -> Maybe n
    testAbove (P2 n
    p2P2 n -> [P2 n] -> [P2 n]
    forall a. a -> [a] -> [a]
    :[P2 n]
    ps)
            | n
    y2 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    y1 n -> n -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 = Maybe n
    forall a. Maybe a
    Nothing  -- Check this condition to prevent
                                      -- division by zero in `intersectPt`.
            | Bool
    otherwise    = n -> Maybe n
    forall a. a -> Maybe a
    Just (n -> Maybe n) -> n -> Maybe n
    forall a b. (a -> b) -> a -> b
    $ n -> P2 n -> P2 n -> n
    forall a. Fractional a => a -> Point V2 a -> Point V2 a -> a
    intersectPt n
    dmax P2 n
    p1 P2 n
    p2
          testAbove _      = Maybe n
    forall a. Maybe a
    Nothing

          -- find the x value where the line through the two points
          -- intersect the line y=d.  Note that `y2 - y1 != 0` due
          -- to checks above.
          intersectPt :: a -> Point V2 a -> Point V2 a -> a
    intersectPt d :: a
    d (P (V2 x1 :: a
    x1 y1 :: a
    y1)) (P (V2 x2 :: a
    x2 y2 :: a
    y2)) =
              a
    x1 a -> a -> a
    forall a. Num a => a -> a -> a
    + (a
    d a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    y1) a -> a -> a
    forall a. Num a => a -> a -> a
    * (a
    x2 a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    x1) a -> a -> a
    forall a. Fractional a => a -> a -> a
    / (a
    y2 a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    y1)

    bezierToBernstein :: Fractional n => FixedSegment V2 n -> (BernsteinPoly n, BernsteinPoly n)
    bezierToBernstein :: FixedSegment V2 n -> (BernsteinPoly n, BernsteinPoly n)
    bezierToBernstein seg :: FixedSegment V2 n
    seg =
        ([n] -> BernsteinPoly n
    forall n. Fractional n => [n] -> BernsteinPoly n
    listToBernstein ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
    forall a b. (a -> b) -> a -> b
    $ (Point V2 n -> n) -> [Point V2 n] -> [n]
    forall a b. (a -> b) -> [a] -> [b]
    map (Getting n (Point V2 n) n -> Point V2 n -> n
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting n (Point V2 n) n
    forall (t :: * -> *) a. R1 t => Lens' (t a) a
    _x) [Point V2 n]
    coeffs, [n] -> BernsteinPoly n
    forall n. Fractional n => [n] -> BernsteinPoly n
    listToBernstein ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
    forall a b. (a -> b) -> a -> b
    $ (Point V2 n -> n) -> [Point V2 n] -> [n]
    forall a b. (a -> b) -> [a] -> [b]
    map (Getting n (Point V2 n) n -> Point V2 n -> n
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting n (Point V2 n) n
    forall (t :: * -> *) a. R2 t => Lens' (t a) a
    _y) [Point V2 n]
    coeffs)
      where coeffs :: [Point V2 n]
    coeffs = Getting (Endo [Point V2 n]) (FixedSegment V2 n) (Point V2 n)
    -> FixedSegment V2 n -> [Point V2 n]
    forall a s. Getting (Endo [a]) s a -> s -> [a]
    toListOf Getting (Endo [Point V2 n]) (FixedSegment V2 n) (Point V2 n)
    forall s t a b. Each s t a b => Traversal s t a b
    each FixedSegment V2 n
    seg

    ------------------------------------------------------------------------
    -- Lines
    ------------------------------------------------------------------------

    -- Could split this into a separate module.

    -- | Returns @(a, b, c, d)@ such that @ax + by + c = 0@ is the line going through
    --   @p1@ and @p2@ with @(a^2)/d + (b^2)/d = 1@.  We delay the division by
    --   @d@ as it may not be needed in all cases and @d@ may be zero.
    lineEquation :: Floating n => P2 n -> P2 n -> (n, n, n, n)
    lineEquation :: P2 n -> P2 n -> (n, n, n, n)
    lineEquation (P (V2 x1 :: n
    x1 y1 :: n
    y1)) (P (V2 x2 :: n
    x2 y2 :: n
    y2)) = (n
    a, n
    b, n
    c, n
    d)
      where
        c :: n
    c  = -(n
    x1n -> n -> n
    forall a. Num a => a -> a -> a
    *n
    a n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    y1n -> n -> n
    forall a. Num a => a -> a -> a
    *n
    b)
        a :: n
    a = n
    y1 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    y2
        b :: n
    b = n
    x2 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    x1
        d :: n
    d  = n
    an -> n -> n
    forall a. Num a => a -> a -> a
    *n
    a n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    bn -> n -> n
    forall a. Num a => a -> a -> a
    *n
    b

    -- | Return the distance from a point to the line.
    lineDistance :: (Ord n, Floating n) => P2 n -> P2 n -> P2 n -> n
    lineDistance :: P2 n -> P2 n -> P2 n -> n
    lineDistance p1 :: P2 n
    p1 p2 :: P2 n
    p2 p3 :: P2 n
    p3@(P (V2 x :: n
    x y :: n
    y))
        -- I have included the check that d' <= 0 in case
        -- there exists some d > 0 where sqrt d == 0.  I don't
        -- think this can happen as sqrt is at least recommended
        -- to be within one value of correct for sqrt and near
        -- zero values get bigger.
        | n
    d n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0 Bool -> Bool -> Bool
    || n
    d' n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0 = V2 n -> n
    forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
    norm (P2 n
    p1 P2 n -> P2 n -> Diff (Point V2) n
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
    .-. P2 n
    p3)
        | Bool
    otherwise = (n
    an -> n -> n
    forall a. Num a => a -> a -> a
    *n
    x n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    bn -> n -> n
    forall a. Num a => a -> a -> a
    *n
    y n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    c) n -> n -> n
    forall a. Fractional a => a -> a -> a
    / n
    d'
      where
        (a :: n
    a, b :: n
    b, c :: n
    c, d :: n
    d) = P2 n -> P2 n -> (n, n, n, n)
    forall n. Floating n => P2 n -> P2 n -> (n, n, n, n)
    lineEquation P2 n
    p1 P2 n
    p2
        d' :: n
    d' = n -> n
    forall a. Floating a => a -> a
    sqrt n
    d

    -- clockwise :: (Num n, Ord n) => V2 n -> V2 n -> Bool
    -- clockwise a b = a `cross2` b <= 0

    avg :: Fractional n => n -> n -> n
    avg :: n -> n -> n
    avg a :: n
    a b :: n
    b = (n
    a n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    b)n -> n -> n
    forall a. Fractional a => a -> a -> a
    /2

    lineLine :: (Fractional n, Eq n) => Located (V2 n) -> Located (V2 n) -> Maybe (n,n)
    lineLine :: Located (V2 n) -> Located (V2 n) -> Maybe (n, n)
    lineLine (Located (V2 n) -> (Point (V (V2 n)) (N (V2 n)), V2 n)
    forall a. Located a -> (Point (V a) (N a), a)
    viewLoc -> (p :: Point (V (V2 n)) (N (V2 n))
    p,r :: V2 n
    r)) (Located (V2 n) -> (Point (V (V2 n)) (N (V2 n)), V2 n)
    forall a. Located a -> (Point (V a) (N a), a)
    viewLoc -> (q :: Point (V (V2 n)) (N (V2 n))
    q,s :: V2 n
    s))
      | n
    x1 n -> n -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 Bool -> Bool -> Bool
    && n
    x2 n -> n -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 0 = Maybe (n, n)
    forall a. Maybe a
    Nothing                 -- parallel
      | Bool
    otherwise          = (n, n) -> Maybe (n, n)
    forall a. a -> Maybe a
    Just (n
    x3 n -> n -> n
    forall a. Fractional a => a -> a -> a
    / n
    x1, n
    x2 n -> n -> n
    forall a. Fractional a => a -> a -> a
    / n
    x1) -- intersecting or collinear
      where
        x1 :: n
    x1 = V2 n
    r V2 n -> V2 n -> n
    forall n. Num n => V2 n -> V2 n -> n
    × V2 n
    s
        x2 :: n
    x2 = Diff (Point V2) n
    V2 n
    v V2 n -> V2 n -> n
    forall n. Num n => V2 n -> V2 n -> n
    × V2 n
    r
        x3 :: n
    x3 = Diff (Point V2) n
    V2 n
    v V2 n -> V2 n -> n
    forall n. Num n => V2 n -> V2 n -> n
    × V2 n
    s
        v :: Diff (Point V2) n
    v  = Point (V (V2 n)) (N (V2 n))
    Point V2 n
    q Point V2 n -> Point V2 n -> Diff (Point V2) n
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
    .-. Point (V (V2 n)) (N (V2 n))
    Point V2 n
    p

    (×) :: Num n => V2 n -> V2 n -> n
    × :: V2 n -> V2 n -> n
    (×) = V2 n -> V2 n -> n
    forall n. Num n => V2 n -> V2 n -> n
    cross2

    mkLine :: InSpace v n (v n) => Point v n -> Point v n -> Located (v n)
    mkLine :: Point v n -> Point v n -> Located (v n)
    mkLine p0 :: Point v n
    p0 p1 :: Point v n
    p1 = (Point v n
    p1 Point v n -> Point v n -> Diff (Point v) n
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
    .-. Point v n
    p0) v n -> Point (V (v n)) (N (v n)) -> Located (v n)
    forall a. a -> Point (V a) (N a) -> Located a
    `at` Point v n
    Point (V (v n)) (N (v n))
    p0

    segLine :: InSpace v n (v n) => FixedSegment v n -> Located (v n)
    segLine :: FixedSegment v n -> Located (v n)
    segLine (FLinear p0 :: Point v n
    p0 p1 :: Point v n
    p1)    = Point v n -> Point v n -> Located (v n)
    forall (v :: * -> *) n.
    InSpace v n (v n) =>
    Point v n -> Point v n -> Located (v n)
    mkLine Point v n
    p0 Point v n
    p1
    segLine (FCubic p0 :: Point v n
    p0 _ _ p3 :: Point v n
    p3) = Point v n -> Point v n -> Located (v n)
    forall (v :: * -> *) n.
    InSpace v n (v n) =>
    Point v n -> Point v n -> Located (v n)
    mkLine Point v n
    p0 Point v n
    p3

    -- This function uses `defEps`, but is used in functions
    -- above that take an epsilon parameter.  It would be nice
    -- to clearify the meaning of each of these epsilons.
    inRange :: (Fractional n, Ord n) => n -> Bool
    inRange :: n -> Bool
    inRange x :: n
    x = n
    x n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    < (1n -> n -> n
    forall a. Num a => a -> a -> a
    +n
    forall n. Fractional n => n
    defEps) Bool -> Bool -> Bool
    && n
    x n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    > (-n
    forall n. Fractional n => n
    defEps)