{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.LineSegment.Intersection.Types
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Types for line segment intersections
--
--------------------------------------------------------------------------------
module HGeometry.LineSegment.Intersection.Types
  ( Intersections
  , intersectionPoints

  , Associated(Associated)
  , startPointOf, endPointOf, interiorTo
  , empty
  , mkAssociated
  , mkAroundStart, mkAroundEnd
  , associatedSegments

  , AroundEnd(..), AroundStart(..), AroundIntersection(..)
  , isInteriorIntersection


  , IntersectionPoint
  , intersectionPointOf

  , intersectionPoint, associatedSegs
  , mkIntersectionPoint


  , IntersectConstraints
  , OrdArounds

  , ordPoints


  , fromInteriors
  , mergeInteriorsWith
  ) where

import Control.Applicative((<|>))
import Control.DeepSeq
import Control.Lens
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Ord (comparing, Down(..))
import Data.Set qualified as Set
import GHC.Generics
import HGeometry.Intersection
import HGeometry.Line
import HGeometry.Properties
import HGeometry.Interval ()
import HGeometry.LineSegment
import HGeometry.Point
import HGeometry.Algorithms.DivideAndConquer (mergeSortedListsBy)
import Data.Coerce

----------------------------------------------------------------------------------


-- FIXME: What do we do when one segment lies *on* the other one. For
-- the short segment it should be an "around start", but then the
-- startpoints do not match.
--
-- for the long one it's an "on" segment, but they do not intersect


-- | A newtype helping us order segments CCW around their common start
-- point. I.e. this assumes that two segments have the same start
-- point.
newtype AroundStart a = AroundStart a
  deriving (Int -> AroundStart a -> ShowS
[AroundStart a] -> ShowS
AroundStart a -> String
(Int -> AroundStart a -> ShowS)
-> (AroundStart a -> String)
-> ([AroundStart a] -> ShowS)
-> Show (AroundStart a)
forall a. Show a => Int -> AroundStart a -> ShowS
forall a. Show a => [AroundStart a] -> ShowS
forall a. Show a => AroundStart a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AroundStart a -> ShowS
showsPrec :: Int -> AroundStart a -> ShowS
$cshow :: forall a. Show a => AroundStart a -> String
show :: AroundStart a -> String
$cshowList :: forall a. Show a => [AroundStart a] -> ShowS
showList :: [AroundStart a] -> ShowS
Show,AroundStart a -> ()
(AroundStart a -> ()) -> NFData (AroundStart a)
forall a. NFData a => AroundStart a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => AroundStart a -> ()
rnf :: AroundStart a -> ()
NFData,(forall a b. (a -> b) -> AroundStart a -> AroundStart b)
-> (forall a b. a -> AroundStart b -> AroundStart a)
-> Functor AroundStart
forall a b. a -> AroundStart b -> AroundStart a
forall a b. (a -> b) -> AroundStart a -> AroundStart b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AroundStart a -> AroundStart b
fmap :: forall a b. (a -> b) -> AroundStart a -> AroundStart b
$c<$ :: forall a b. a -> AroundStart b -> AroundStart a
<$ :: forall a b. a -> AroundStart b -> AroundStart a
Functor,(forall x. AroundStart a -> Rep (AroundStart a) x)
-> (forall x. Rep (AroundStart a) x -> AroundStart a)
-> Generic (AroundStart a)
forall x. Rep (AroundStart a) x -> AroundStart a
forall x. AroundStart a -> Rep (AroundStart a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AroundStart a) x -> AroundStart a
forall a x. AroundStart a -> Rep (AroundStart a) x
$cfrom :: forall a x. AroundStart a -> Rep (AroundStart a) x
from :: forall x. AroundStart a -> Rep (AroundStart a) x
$cto :: forall a x. Rep (AroundStart a) x -> AroundStart a
to :: forall x. Rep (AroundStart a) x -> AroundStart a
Generic)

instance Wrapped (AroundStart a) where
  type Unwrapped (AroundStart a) = a

instance (AroundStart a ~ t) => Rewrapped (AroundStart a) t

instance ( Point_ point 2 r, Eq r
         , HasEnd lineSegment point) => Eq (AroundStart lineSegment) where
  -- | equality on endpoint
  (AroundStart lineSegment
s) == :: AroundStart lineSegment -> AroundStart lineSegment -> Bool
== (AroundStart lineSegment
s') = lineSegment
slineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== lineSegment
s'lineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint

instance ( LineSegment_ lineSegment point
         , Point_ point 2 r
         , Ord r, Num r
         ) => Ord (AroundStart lineSegment) where
  -- | ccw ordered around their suposed common startpoint
  (AroundStart lineSegment
s) compare :: AroundStart lineSegment -> AroundStart lineSegment -> Ordering
`compare` (AroundStart lineSegment
s') = point -> point -> point -> Ordering
forall center r point.
(Point_ center 2 r, Point_ point 2 r, Ord r, Num r) =>
center -> point -> point -> Ordering
ccwCmpAround (lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start) (lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end)  (lineSegment
s'lineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end)

----------------------------------------

-- | Assumes that two segments have the same end point (ordering is CCW around common endpoint)
-- (note that we specifically mean end point; not startpoint. See AroundStart)
newtype AroundEnd a = AroundEnd a deriving (Int -> AroundEnd a -> ShowS
[AroundEnd a] -> ShowS
AroundEnd a -> String
(Int -> AroundEnd a -> ShowS)
-> (AroundEnd a -> String)
-> ([AroundEnd a] -> ShowS)
-> Show (AroundEnd a)
forall a. Show a => Int -> AroundEnd a -> ShowS
forall a. Show a => [AroundEnd a] -> ShowS
forall a. Show a => AroundEnd a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AroundEnd a -> ShowS
showsPrec :: Int -> AroundEnd a -> ShowS
$cshow :: forall a. Show a => AroundEnd a -> String
show :: AroundEnd a -> String
$cshowList :: forall a. Show a => [AroundEnd a] -> ShowS
showList :: [AroundEnd a] -> ShowS
Show,AroundEnd a -> ()
(AroundEnd a -> ()) -> NFData (AroundEnd a)
forall a. NFData a => AroundEnd a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => AroundEnd a -> ()
rnf :: AroundEnd a -> ()
NFData,(forall a b. (a -> b) -> AroundEnd a -> AroundEnd b)
-> (forall a b. a -> AroundEnd b -> AroundEnd a)
-> Functor AroundEnd
forall a b. a -> AroundEnd b -> AroundEnd a
forall a b. (a -> b) -> AroundEnd a -> AroundEnd b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AroundEnd a -> AroundEnd b
fmap :: forall a b. (a -> b) -> AroundEnd a -> AroundEnd b
$c<$ :: forall a b. a -> AroundEnd b -> AroundEnd a
<$ :: forall a b. a -> AroundEnd b -> AroundEnd a
Functor,(forall x. AroundEnd a -> Rep (AroundEnd a) x)
-> (forall x. Rep (AroundEnd a) x -> AroundEnd a)
-> Generic (AroundEnd a)
forall x. Rep (AroundEnd a) x -> AroundEnd a
forall x. AroundEnd a -> Rep (AroundEnd a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AroundEnd a) x -> AroundEnd a
forall a x. AroundEnd a -> Rep (AroundEnd a) x
$cfrom :: forall a x. AroundEnd a -> Rep (AroundEnd a) x
from :: forall x. AroundEnd a -> Rep (AroundEnd a) x
$cto :: forall a x. Rep (AroundEnd a) x -> AroundEnd a
to :: forall x. Rep (AroundEnd a) x -> AroundEnd a
Generic)

instance Wrapped (AroundEnd a) where
  type Unwrapped (AroundEnd a) = a

instance (AroundEnd a ~ t) => Rewrapped (AroundEnd a) t

instance (Point_ point 2 r, Eq r, HasStart lineSegment point) => Eq (AroundEnd lineSegment) where
  -- | equality on endpoint
  (AroundEnd lineSegment
s) == :: AroundEnd lineSegment -> AroundEnd lineSegment -> Bool
== (AroundEnd lineSegment
s') = lineSegment
slineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== lineSegment
s'lineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint

instance ( LineSegment_ lineSegment point
         , Point_ point 2 r
         , Ord r, Num r
         , Eq lineSegment
         ) => Ord (AroundEnd lineSegment) where
  -- | ccw ordered around their suposed common end point
  (AroundEnd lineSegment
s) compare :: AroundEnd lineSegment -> AroundEnd lineSegment -> Ordering
`compare` (AroundEnd lineSegment
s') = point -> point -> point -> Ordering
forall center r point.
(Point_ center 2 r, Point_ point 2 r, Ord r, Num r) =>
center -> point -> point -> Ordering
ccwCmpAround (lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end) (lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start) (lineSegment
s'lineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start)

--------------------------------------------------------------------------------

-- | This type represents a line segment seg, that contains some
-- globally known point "p" in its interior. The Ord instance of
-- 'AroundIntersection' orders segments of this type "around" p. In
-- particular, it orders the segments in CCW order by their starting
-- point (starting from the positive x-axis).
newtype AroundIntersection a = AroundIntersection a
  deriving (AroundIntersection a -> AroundIntersection a -> Bool
(AroundIntersection a -> AroundIntersection a -> Bool)
-> (AroundIntersection a -> AroundIntersection a -> Bool)
-> Eq (AroundIntersection a)
forall a.
Eq a =>
AroundIntersection a -> AroundIntersection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
AroundIntersection a -> AroundIntersection a -> Bool
== :: AroundIntersection a -> AroundIntersection a -> Bool
$c/= :: forall a.
Eq a =>
AroundIntersection a -> AroundIntersection a -> Bool
/= :: AroundIntersection a -> AroundIntersection a -> Bool
Eq,Int -> AroundIntersection a -> ShowS
[AroundIntersection a] -> ShowS
AroundIntersection a -> String
(Int -> AroundIntersection a -> ShowS)
-> (AroundIntersection a -> String)
-> ([AroundIntersection a] -> ShowS)
-> Show (AroundIntersection a)
forall a. Show a => Int -> AroundIntersection a -> ShowS
forall a. Show a => [AroundIntersection a] -> ShowS
forall a. Show a => AroundIntersection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AroundIntersection a -> ShowS
showsPrec :: Int -> AroundIntersection a -> ShowS
$cshow :: forall a. Show a => AroundIntersection a -> String
show :: AroundIntersection a -> String
$cshowList :: forall a. Show a => [AroundIntersection a] -> ShowS
showList :: [AroundIntersection a] -> ShowS
Show,AroundIntersection a -> ()
(AroundIntersection a -> ()) -> NFData (AroundIntersection a)
forall a. NFData a => AroundIntersection a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => AroundIntersection a -> ()
rnf :: AroundIntersection a -> ()
NFData,(forall a b.
 (a -> b) -> AroundIntersection a -> AroundIntersection b)
-> (forall a b. a -> AroundIntersection b -> AroundIntersection a)
-> Functor AroundIntersection
forall a b. a -> AroundIntersection b -> AroundIntersection a
forall a b.
(a -> b) -> AroundIntersection a -> AroundIntersection b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> AroundIntersection a -> AroundIntersection b
fmap :: forall a b.
(a -> b) -> AroundIntersection a -> AroundIntersection b
$c<$ :: forall a b. a -> AroundIntersection b -> AroundIntersection a
<$ :: forall a b. a -> AroundIntersection b -> AroundIntersection a
Functor,(forall x. AroundIntersection a -> Rep (AroundIntersection a) x)
-> (forall x. Rep (AroundIntersection a) x -> AroundIntersection a)
-> Generic (AroundIntersection a)
forall x. Rep (AroundIntersection a) x -> AroundIntersection a
forall x. AroundIntersection a -> Rep (AroundIntersection a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AroundIntersection a) x -> AroundIntersection a
forall a x. AroundIntersection a -> Rep (AroundIntersection a) x
$cfrom :: forall a x. AroundIntersection a -> Rep (AroundIntersection a) x
from :: forall x. AroundIntersection a -> Rep (AroundIntersection a) x
$cto :: forall a x. Rep (AroundIntersection a) x -> AroundIntersection a
to :: forall x. Rep (AroundIntersection a) x -> AroundIntersection a
Generic)

instance Wrapped (AroundIntersection a) where
    type Unwrapped (AroundIntersection a) = a

instance (AroundIntersection a ~ t) => Rewrapped (AroundIntersection a) t

-- instance ( LineSegment_ lineSegment point
--          , Point_ point 2 r
--          , Ord r, Fractional r
--          , Eq lineSegment
--          , IsIntersectableWith lineSegment lineSegment
--          , Intersection lineSegment lineSegment ~
--            Maybe (LineSegmentLineSegmentIntersection lineSegment')
--          , NumType lineSegment' ~ r
--          ) => Ord (AroundIntersection lineSegment) where
--   -- | ccw ordered around their common intersection point.
--   (AroundIntersection s) `compare` (AroundIntersection s') = case s `intersect` s' of
--     Nothing                                  ->
--       error "AroundIntersection: segments do not intersect!"
--     Just (LineSegment_x_LineSegment_Point p)       -> cmpAroundP p s s'
--     Just (LineSegment_x_LineSegment_LineSegment _) ->
--       error "BOOM!"
--       -- squaredLength s `compare` (squaredLength s')

--         -- if s and s' just happen to be the same length but
--         -- intersect in different behaviour from using (==).
--         -- but that situation doese not satisfy the precondition
--         -- of aroundIntersection anyway.
--     where
--       squaredLength ss = squaredEuclideanDist (ss^.start) (ss^.end)
-- -- FIXME: should this instance really exist?


-- | We compare the segments by their startPoints, ordered CCCW around
-- p, starting from the positive x-axis.
cmpAroundP        :: ( LineSegment_ lineSegment point
                     , Point_ point 2 r
                     , Point_ point' 2 r
                     , Ord r, Num r
                     )
                  => point' -> lineSegment -> lineSegment -> Ordering
cmpAroundP :: forall lineSegment point r point'.
(LineSegment_ lineSegment point, Point_ point 2 r,
 Point_ point' 2 r, Ord r, Num r) =>
point' -> lineSegment -> lineSegment -> Ordering
cmpAroundP point'
p lineSegment
s lineSegment
s' = Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall center r point.
(Point_ center 2 r, Point_ point 2 r, Ord r, Num r) =>
center -> point -> point -> Ordering
ccwCmpAround (point'
ppoint' -> Getting (Point 2 r) point' (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point' (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point' (Point 2 r)
asPoint) (lineSegment
slineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint)  (lineSegment
s'lineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint)





-- seg1 = ClosedLineSegment (ext $ Point2 0 0) (ext $ Point2 0 10)
-- seg2 = ClosedLineSegment (ext $ Point2 0 0) (ext $ Point2 0 10)

--------------------------------------------------------------------------------



-- | The line segments that contain a given point p may either have p
-- as the endpoint or have p in their interior.
--
-- if somehow the segment is degenerate, and p is both the start and
-- end it is reported only as the start point.
data Associated lineSegment =
  Associated { forall lineSegment.
Associated lineSegment -> Set (AroundStart lineSegment)
_startPointOf :: Set.Set (AroundStart lineSegment)
             -- ^ segments for which the intersection point is the
             -- start point (i.e. s^.start == p). These segments are
             -- stored in CCW order around their common starting point.
             , forall lineSegment.
Associated lineSegment -> Set (AroundEnd lineSegment)
_endPointOf   :: Set.Set (AroundEnd lineSegment)
             -- ^ segments for which the intersection point is the end
             -- point (i.e. s^.end == p)
             , forall lineSegment.
Associated lineSegment -> Set (AroundIntersection lineSegment)
_interiorTo   :: Set.Set (AroundIntersection lineSegment)
             } deriving stock (Int -> Associated lineSegment -> ShowS
[Associated lineSegment] -> ShowS
Associated lineSegment -> String
(Int -> Associated lineSegment -> ShowS)
-> (Associated lineSegment -> String)
-> ([Associated lineSegment] -> ShowS)
-> Show (Associated lineSegment)
forall lineSegment.
Show lineSegment =>
Int -> Associated lineSegment -> ShowS
forall lineSegment.
Show lineSegment =>
[Associated lineSegment] -> ShowS
forall lineSegment.
Show lineSegment =>
Associated lineSegment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall lineSegment.
Show lineSegment =>
Int -> Associated lineSegment -> ShowS
showsPrec :: Int -> Associated lineSegment -> ShowS
$cshow :: forall lineSegment.
Show lineSegment =>
Associated lineSegment -> String
show :: Associated lineSegment -> String
$cshowList :: forall lineSegment.
Show lineSegment =>
[Associated lineSegment] -> ShowS
showList :: [Associated lineSegment] -> ShowS
Show, (forall x.
 Associated lineSegment -> Rep (Associated lineSegment) x)
-> (forall x.
    Rep (Associated lineSegment) x -> Associated lineSegment)
-> Generic (Associated lineSegment)
forall x. Rep (Associated lineSegment) x -> Associated lineSegment
forall x. Associated lineSegment -> Rep (Associated lineSegment) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall lineSegment x.
Rep (Associated lineSegment) x -> Associated lineSegment
forall lineSegment x.
Associated lineSegment -> Rep (Associated lineSegment) x
$cfrom :: forall lineSegment x.
Associated lineSegment -> Rep (Associated lineSegment) x
from :: forall x. Associated lineSegment -> Rep (Associated lineSegment) x
$cto :: forall lineSegment x.
Rep (Associated lineSegment) x -> Associated lineSegment
to :: forall x. Rep (Associated lineSegment) x -> Associated lineSegment
Generic)


deriving stock instance ( Eq (AroundStart lineSegment)
                        , Eq (AroundIntersection lineSegment)
                        , Eq (AroundEnd lineSegment)
                        ) => Eq (Associated lineSegment)

-- deriving stock instance ( Read lineSegment
--                         , OrdArounds lineSegment
--                         ) => Read (Associated lineSegment)

-- | Constructs an empty associated
empty :: Associated lineSegment
empty :: forall lineSegment. Associated lineSegment
empty = Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
forall lineSegment.
Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
Associated Set (AroundStart lineSegment)
forall a. Set a
Set.empty Set (AroundEnd lineSegment)
forall a. Set a
Set.empty Set (AroundIntersection lineSegment)
forall a. Set a
Set.empty


-- | Shorthand for the required Ord instances
type OrdArounds lineSegment = ( Ord (AroundStart lineSegment)
                              -- , Ord (AroundIntersection lineSegment)
                              , Ord (AroundEnd lineSegment)
                              )

-- | Lens to access the segments for which this is a startPoint
startPointOf :: Lens' (Associated lineSegment) (Set.Set (AroundStart lineSegment))
startPointOf :: forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundStart lineSegment)
 -> f (Set (AroundStart lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
startPointOf Set (AroundStart lineSegment) -> f (Set (AroundStart lineSegment))
f (Associated Set (AroundStart lineSegment)
ss Set (AroundEnd lineSegment)
es Set (AroundIntersection lineSegment)
is) = (Set (AroundStart lineSegment) -> Associated lineSegment)
-> f (Set (AroundStart lineSegment)) -> f (Associated lineSegment)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Set (AroundStart lineSegment)
ss' -> Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
forall lineSegment.
Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
Associated Set (AroundStart lineSegment)
ss' Set (AroundEnd lineSegment)
es Set (AroundIntersection lineSegment)
is) (Set (AroundStart lineSegment) -> f (Set (AroundStart lineSegment))
f Set (AroundStart lineSegment)
ss)
{-# INLINE startPointOf #-}

-- | Lens to access the segments for which this is an endPoint
endPointOf :: Lens' (Associated lineSegment) (Set.Set (AroundEnd lineSegment))
endPointOf :: forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
endPointOf Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment))
f (Associated Set (AroundStart lineSegment)
ss Set (AroundEnd lineSegment)
es Set (AroundIntersection lineSegment)
is) = (Set (AroundEnd lineSegment) -> Associated lineSegment)
-> f (Set (AroundEnd lineSegment)) -> f (Associated lineSegment)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Set (AroundEnd lineSegment)
es' -> Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
forall lineSegment.
Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
Associated Set (AroundStart lineSegment)
ss Set (AroundEnd lineSegment)
es' Set (AroundIntersection lineSegment)
is) (Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment))
f Set (AroundEnd lineSegment)
es)
{-# INLINE endPointOf #-}

-- | Lens to access the segments for which this point lies in the interior of the segment
interiorTo :: Lens' (Associated lineSegment) (Set.Set (AroundIntersection lineSegment))
interiorTo :: forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundIntersection lineSegment)
 -> f (Set (AroundIntersection lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
interiorTo Set (AroundIntersection lineSegment)
-> f (Set (AroundIntersection lineSegment))
f (Associated Set (AroundStart lineSegment)
ss Set (AroundEnd lineSegment)
es Set (AroundIntersection lineSegment)
is) = (Set (AroundIntersection lineSegment) -> Associated lineSegment)
-> f (Set (AroundIntersection lineSegment))
-> f (Associated lineSegment)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Set (AroundIntersection lineSegment)
is' -> Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
forall lineSegment.
Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
Associated Set (AroundStart lineSegment)
ss Set (AroundEnd lineSegment)
es Set (AroundIntersection lineSegment)
is') (Set (AroundIntersection lineSegment)
-> f (Set (AroundIntersection lineSegment))
f Set (AroundIntersection lineSegment)
is)
{-# INLINE interiorTo #-}


-- | Fold over the segments associated with the intersection.
associatedSegments     :: Fold (Associated lineSegment) lineSegment
associatedSegments :: forall lineSegment (f :: * -> *).
(Contravariant f, Applicative f) =>
(lineSegment -> f lineSegment)
-> Associated lineSegment -> f (Associated lineSegment)
associatedSegments lineSegment -> f lineSegment
f Associated lineSegment
a =  ((Set (AroundStart lineSegment)
 -> f (Set (AroundStart lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundStart lineSegment)
 -> f (Set (AroundStart lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
startPointOf ((Set (AroundStart lineSegment)
  -> f (Set (AroundStart lineSegment)))
 -> Associated lineSegment -> f (Associated lineSegment))
-> ((lineSegment -> f lineSegment)
    -> Set (AroundStart lineSegment)
    -> f (Set (AroundStart lineSegment)))
-> (lineSegment -> f lineSegment)
-> Associated lineSegment
-> f (Associated lineSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AroundStart lineSegment -> f (AroundStart lineSegment))
-> Set (AroundStart lineSegment)
-> f (Set (AroundStart lineSegment))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int (Set (AroundStart lineSegment)) (AroundStart lineSegment)
folded ((AroundStart lineSegment -> f (AroundStart lineSegment))
 -> Set (AroundStart lineSegment)
 -> f (Set (AroundStart lineSegment)))
-> ((lineSegment -> f lineSegment)
    -> AroundStart lineSegment -> f (AroundStart lineSegment))
-> (lineSegment -> f lineSegment)
-> Set (AroundStart lineSegment)
-> f (Set (AroundStart lineSegment))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (lineSegment -> f lineSegment)
-> AroundStart lineSegment -> f (AroundStart lineSegment)
(Unwrapped (AroundStart lineSegment)
 -> f (Unwrapped (AroundStart lineSegment)))
-> AroundStart lineSegment -> f (AroundStart lineSegment)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (AroundStart lineSegment)
  (AroundStart lineSegment)
  (Unwrapped (AroundStart lineSegment))
  (Unwrapped (AroundStart lineSegment))
_Wrapped) lineSegment -> f lineSegment
f Associated lineSegment
a f (Associated lineSegment)
-> f (Associated lineSegment) -> f (Associated lineSegment)
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                          ((Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
endPointOf   ((Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment)))
 -> Associated lineSegment -> f (Associated lineSegment))
-> ((lineSegment -> f lineSegment)
    -> Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment)))
-> (lineSegment -> f lineSegment)
-> Associated lineSegment
-> f (Associated lineSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AroundEnd lineSegment -> f (AroundEnd lineSegment))
-> Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int (Set (AroundEnd lineSegment)) (AroundEnd lineSegment)
folded ((AroundEnd lineSegment -> f (AroundEnd lineSegment))
 -> Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment)))
-> ((lineSegment -> f lineSegment)
    -> AroundEnd lineSegment -> f (AroundEnd lineSegment))
-> (lineSegment -> f lineSegment)
-> Set (AroundEnd lineSegment)
-> f (Set (AroundEnd lineSegment))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (lineSegment -> f lineSegment)
-> AroundEnd lineSegment -> f (AroundEnd lineSegment)
(Unwrapped (AroundEnd lineSegment)
 -> f (Unwrapped (AroundEnd lineSegment)))
-> AroundEnd lineSegment -> f (AroundEnd lineSegment)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (AroundEnd lineSegment)
  (AroundEnd lineSegment)
  (Unwrapped (AroundEnd lineSegment))
  (Unwrapped (AroundEnd lineSegment))
_Wrapped) lineSegment -> f lineSegment
f Associated lineSegment
a f (Associated lineSegment)
-> f (Associated lineSegment) -> f (Associated lineSegment)
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                          ((Set (AroundIntersection lineSegment)
 -> f (Set (AroundIntersection lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundIntersection lineSegment)
 -> f (Set (AroundIntersection lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
interiorTo   ((Set (AroundIntersection lineSegment)
  -> f (Set (AroundIntersection lineSegment)))
 -> Associated lineSegment -> f (Associated lineSegment))
-> ((lineSegment -> f lineSegment)
    -> Set (AroundIntersection lineSegment)
    -> f (Set (AroundIntersection lineSegment)))
-> (lineSegment -> f lineSegment)
-> Associated lineSegment
-> f (Associated lineSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AroundIntersection lineSegment
 -> f (AroundIntersection lineSegment))
-> Set (AroundIntersection lineSegment)
-> f (Set (AroundIntersection lineSegment))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Set (AroundIntersection lineSegment))
  (AroundIntersection lineSegment)
folded ((AroundIntersection lineSegment
  -> f (AroundIntersection lineSegment))
 -> Set (AroundIntersection lineSegment)
 -> f (Set (AroundIntersection lineSegment)))
-> ((lineSegment -> f lineSegment)
    -> AroundIntersection lineSegment
    -> f (AroundIntersection lineSegment))
-> (lineSegment -> f lineSegment)
-> Set (AroundIntersection lineSegment)
-> f (Set (AroundIntersection lineSegment))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (lineSegment -> f lineSegment)
-> AroundIntersection lineSegment
-> f (AroundIntersection lineSegment)
(Unwrapped (AroundIntersection lineSegment)
 -> f (Unwrapped (AroundIntersection lineSegment)))
-> AroundIntersection lineSegment
-> f (AroundIntersection lineSegment)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (AroundIntersection lineSegment)
  (AroundIntersection lineSegment)
  (Unwrapped (AroundIntersection lineSegment))
  (Unwrapped (AroundIntersection lineSegment))
_Wrapped) lineSegment -> f lineSegment
f Associated lineSegment
a
  -- combine the folds

-- instance Functor (Associated lineSegment) where
--   fmap f (Associated ss es is) = Associated (Set.mapMonotonic (g f) ss)
--                                             (Set.mapMonotonic (g f) es)
--                                             (Set.mapMonotonic (g f) is)
--     where
--       g   :: forall f c e b. Functor f => (e -> b) -> f (c :+ e) -> f (c :+ b)
--       g f' = fmap (&extra %~ f')


-- | Reports whether this associated has any interior intersections
--
-- \(O(1)\)
isInteriorIntersection :: Associated lineSegment -> Bool
isInteriorIntersection :: forall lineSegment. Associated lineSegment -> Bool
isInteriorIntersection = Bool -> Bool
not (Bool -> Bool)
-> (Associated lineSegment -> Bool)
-> Associated lineSegment
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (AroundIntersection lineSegment) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set (AroundIntersection lineSegment) -> Bool)
-> (Associated lineSegment -> Set (AroundIntersection lineSegment))
-> Associated lineSegment
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Associated lineSegment -> Set (AroundIntersection lineSegment)
forall lineSegment.
Associated lineSegment -> Set (AroundIntersection lineSegment)
_interiorTo


-- | Constructs an around start
mkAroundStart   :: lineSegment -> Associated lineSegment
mkAroundStart :: forall lineSegment. lineSegment -> Associated lineSegment
mkAroundStart lineSegment
s = Associated lineSegment
forall lineSegment. Associated lineSegment
emptyAssociated lineSegment
-> (Associated lineSegment -> Associated lineSegment)
-> Associated lineSegment
forall a b. a -> (a -> b) -> b
&(Set (AroundStart lineSegment)
 -> Identity (Set (AroundStart lineSegment)))
-> Associated lineSegment -> Identity (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundStart lineSegment)
 -> f (Set (AroundStart lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
startPointOf ((Set (AroundStart lineSegment)
  -> Identity (Set (AroundStart lineSegment)))
 -> Associated lineSegment -> Identity (Associated lineSegment))
-> Set (AroundStart lineSegment)
-> Associated lineSegment
-> Associated lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~  AroundStart lineSegment -> Set (AroundStart lineSegment)
forall a. a -> Set a
Set.singleton (lineSegment -> AroundStart lineSegment
forall a. a -> AroundStart a
AroundStart lineSegment
s)

-- | Constructs an ArroundEnd
mkAroundEnd   :: lineSegment -> Associated lineSegment
mkAroundEnd :: forall lineSegment. lineSegment -> Associated lineSegment
mkAroundEnd lineSegment
s = Associated lineSegment
forall lineSegment. Associated lineSegment
emptyAssociated lineSegment
-> (Associated lineSegment -> Associated lineSegment)
-> Associated lineSegment
forall a b. a -> (a -> b) -> b
&(Set (AroundEnd lineSegment)
 -> Identity (Set (AroundEnd lineSegment)))
-> Associated lineSegment -> Identity (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
endPointOf   ((Set (AroundEnd lineSegment)
  -> Identity (Set (AroundEnd lineSegment)))
 -> Associated lineSegment -> Identity (Associated lineSegment))
-> Set (AroundEnd lineSegment)
-> Associated lineSegment
-> Associated lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~  AroundEnd lineSegment -> Set (AroundEnd lineSegment)
forall a. a -> Set a
Set.singleton (lineSegment -> AroundEnd lineSegment
forall a. a -> AroundEnd a
AroundEnd lineSegment
s)


-- | test if the given segment has p as its endpoint, an construct the
-- appropriate associated representing that.
--
-- pre: p intersects the segment
mkAssociated      :: ( LineSegment_ lineSegment point
                     , Point_ point 2 r
                     , Point_ point' 2 r
                     , Eq r
                     )
                  => point' -> lineSegment -> Associated lineSegment
mkAssociated :: forall lineSegment point r point'.
(LineSegment_ lineSegment point, Point_ point 2 r,
 Point_ point' 2 r, Eq r) =>
point' -> lineSegment -> Associated lineSegment
mkAssociated point'
p lineSegment
s
  | point'
ppoint' -> Getting (Point 2 r) point' (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point' (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point' (Point 2 r)
asPoint Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== lineSegment
slineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint = Associated lineSegment
forall lineSegment. Associated lineSegment
emptyAssociated lineSegment
-> (Associated lineSegment -> Associated lineSegment)
-> Associated lineSegment
forall a b. a -> (a -> b) -> b
&(Set (AroundStart lineSegment)
 -> Identity (Set (AroundStart lineSegment)))
-> Associated lineSegment -> Identity (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundStart lineSegment)
 -> f (Set (AroundStart lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
startPointOf ((Set (AroundStart lineSegment)
  -> Identity (Set (AroundStart lineSegment)))
 -> Associated lineSegment -> Identity (Associated lineSegment))
-> Set (AroundStart lineSegment)
-> Associated lineSegment
-> Associated lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~  AroundStart lineSegment -> Set (AroundStart lineSegment)
forall a. a -> Set a
Set.singleton (lineSegment -> AroundStart lineSegment
forall a. a -> AroundStart a
AroundStart lineSegment
s)
  | point'
ppoint' -> Getting (Point 2 r) point' (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point' (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point' (Point 2 r)
asPoint Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== lineSegment
slineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint   = Associated lineSegment
forall lineSegment. Associated lineSegment
emptyAssociated lineSegment
-> (Associated lineSegment -> Associated lineSegment)
-> Associated lineSegment
forall a b. a -> (a -> b) -> b
&(Set (AroundEnd lineSegment)
 -> Identity (Set (AroundEnd lineSegment)))
-> Associated lineSegment -> Identity (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
endPointOf   ((Set (AroundEnd lineSegment)
  -> Identity (Set (AroundEnd lineSegment)))
 -> Associated lineSegment -> Identity (Associated lineSegment))
-> Set (AroundEnd lineSegment)
-> Associated lineSegment
-> Associated lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~  AroundEnd lineSegment -> Set (AroundEnd lineSegment)
forall a. a -> Set a
Set.singleton (lineSegment -> AroundEnd lineSegment
forall a. a -> AroundEnd a
AroundEnd lineSegment
s)
  | Bool
otherwise                      = Associated lineSegment
forall lineSegment. Associated lineSegment
emptyAssociated lineSegment
-> (Associated lineSegment -> Associated lineSegment)
-> Associated lineSegment
forall a b. a -> (a -> b) -> b
&(Set (AroundIntersection lineSegment)
 -> Identity (Set (AroundIntersection lineSegment)))
-> Associated lineSegment -> Identity (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundIntersection lineSegment)
 -> f (Set (AroundIntersection lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
interiorTo   ((Set (AroundIntersection lineSegment)
  -> Identity (Set (AroundIntersection lineSegment)))
 -> Associated lineSegment -> Identity (Associated lineSegment))
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
-> Associated lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~  AroundIntersection lineSegment
-> Set (AroundIntersection lineSegment)
forall a. a -> Set a
Set.singleton (lineSegment -> AroundIntersection lineSegment
forall a. a -> AroundIntersection a
AroundIntersection lineSegment
s)





---- | test if the given segment has p as its endpoint, an construct the
---- appropriate associated representing that.
----
---- If p is not one of the endpoints we concstruct an empty Associated!
----
--mkAssociated'     :: ( LineSegment_ lineSegment point
--                     , Point_ point 2 r
--                     , Eq r
--                     , OrdArounds lineSegment
--                     )
--                  => point -> lineSegment -> Associated lineSegment
--mkAssociated' p s = (mkAssociated p s)&interiorTo .~ mempty


instance ( OrdArounds lineSegment
         , LineSegment_ lineSegment point, Point_ point 2 r, Ord r, Fractional r
         , HasSupportingLine lineSegment
         ) => Semigroup (Associated lineSegment) where
  (Associated Set (AroundStart lineSegment)
ss Set (AroundEnd lineSegment)
es Set (AroundIntersection lineSegment)
is) <> :: Associated lineSegment
-> Associated lineSegment -> Associated lineSegment
<> (Associated Set (AroundStart lineSegment)
ss' Set (AroundEnd lineSegment)
es' Set (AroundIntersection lineSegment)
is') =
    Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
forall lineSegment.
Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
Associated Set (AroundStart lineSegment)
starts Set (AroundEnd lineSegment)
ends (Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
-> Maybe (Point 2 r)
-> Set (AroundIntersection lineSegment)
forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Fractional r, HasSupportingLine lineSegment) =>
Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
-> Maybe (Point 2 r)
-> Set (AroundIntersection lineSegment)
mergeInteriors Set (AroundIntersection lineSegment)
is Set (AroundIntersection lineSegment)
is' Maybe (Point 2 r)
mp)
    where
      starts :: Set (AroundStart lineSegment)
starts = Set (AroundStart lineSegment)
ss Set (AroundStart lineSegment)
-> Set (AroundStart lineSegment) -> Set (AroundStart lineSegment)
forall a. Semigroup a => a -> a -> a
<> Set (AroundStart lineSegment)
ss'
      ends :: Set (AroundEnd lineSegment)
ends   = Set (AroundEnd lineSegment)
es Set (AroundEnd lineSegment)
-> Set (AroundEnd lineSegment) -> Set (AroundEnd lineSegment)
forall a. Semigroup a => a -> a -> a
<> Set (AroundEnd lineSegment)
es'
      -- try to find the intersection point p that this Associated represents
      mp :: Maybe (Point 2 r)
mp     = Getting
  (Leftmost (Point 2 r)) (Set (AroundStart lineSegment)) (Point 2 r)
-> Set (AroundStart lineSegment) -> Maybe (Point 2 r)
forall a s. Getting (Leftmost a) s a -> s -> Maybe a
firstOf ((AroundStart lineSegment
 -> Const (Leftmost (Point 2 r)) (AroundStart lineSegment))
-> Set (AroundStart lineSegment)
-> Const (Leftmost (Point 2 r)) (Set (AroundStart lineSegment))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int (Set (AroundStart lineSegment)) (AroundStart lineSegment)
folded((AroundStart lineSegment
  -> Const (Leftmost (Point 2 r)) (AroundStart lineSegment))
 -> Set (AroundStart lineSegment)
 -> Const (Leftmost (Point 2 r)) (Set (AroundStart lineSegment)))
-> ((Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
    -> AroundStart lineSegment
    -> Const (Leftmost (Point 2 r)) (AroundStart lineSegment))
-> Getting
     (Leftmost (Point 2 r)) (Set (AroundStart lineSegment)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(lineSegment -> Const (Leftmost (Point 2 r)) lineSegment)
-> AroundStart lineSegment
-> Const (Leftmost (Point 2 r)) (AroundStart lineSegment)
(Unwrapped (AroundStart lineSegment)
 -> Const
      (Leftmost (Point 2 r)) (Unwrapped (AroundStart lineSegment)))
-> AroundStart lineSegment
-> Const (Leftmost (Point 2 r)) (AroundStart lineSegment)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (AroundStart lineSegment)
  (AroundStart lineSegment)
  (Unwrapped (AroundStart lineSegment))
  (Unwrapped (AroundStart lineSegment))
_Wrapped((lineSegment -> Const (Leftmost (Point 2 r)) lineSegment)
 -> AroundStart lineSegment
 -> Const (Leftmost (Point 2 r)) (AroundStart lineSegment))
-> ((Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
    -> lineSegment -> Const (Leftmost (Point 2 r)) lineSegment)
-> (Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
-> AroundStart lineSegment
-> Const (Leftmost (Point 2 r)) (AroundStart lineSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(point -> Const (Leftmost (Point 2 r)) point)
-> lineSegment -> Const (Leftmost (Point 2 r)) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start((point -> Const (Leftmost (Point 2 r)) point)
 -> lineSegment -> Const (Leftmost (Point 2 r)) lineSegment)
-> ((Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
    -> point -> Const (Leftmost (Point 2 r)) point)
-> (Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
-> lineSegment
-> Const (Leftmost (Point 2 r)) lineSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
-> point -> Const (Leftmost (Point 2 r)) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Set (AroundStart lineSegment)
starts
               Maybe (Point 2 r) -> Maybe (Point 2 r) -> Maybe (Point 2 r)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Getting
  (Leftmost (Point 2 r)) (Set (AroundEnd lineSegment)) (Point 2 r)
-> Set (AroundEnd lineSegment) -> Maybe (Point 2 r)
forall a s. Getting (Leftmost a) s a -> s -> Maybe a
firstOf ((AroundEnd lineSegment
 -> Const (Leftmost (Point 2 r)) (AroundEnd lineSegment))
-> Set (AroundEnd lineSegment)
-> Const (Leftmost (Point 2 r)) (Set (AroundEnd lineSegment))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int (Set (AroundEnd lineSegment)) (AroundEnd lineSegment)
folded((AroundEnd lineSegment
  -> Const (Leftmost (Point 2 r)) (AroundEnd lineSegment))
 -> Set (AroundEnd lineSegment)
 -> Const (Leftmost (Point 2 r)) (Set (AroundEnd lineSegment)))
-> ((Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
    -> AroundEnd lineSegment
    -> Const (Leftmost (Point 2 r)) (AroundEnd lineSegment))
-> Getting
     (Leftmost (Point 2 r)) (Set (AroundEnd lineSegment)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(lineSegment -> Const (Leftmost (Point 2 r)) lineSegment)
-> AroundEnd lineSegment
-> Const (Leftmost (Point 2 r)) (AroundEnd lineSegment)
(Unwrapped (AroundEnd lineSegment)
 -> Const
      (Leftmost (Point 2 r)) (Unwrapped (AroundEnd lineSegment)))
-> AroundEnd lineSegment
-> Const (Leftmost (Point 2 r)) (AroundEnd lineSegment)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (AroundEnd lineSegment)
  (AroundEnd lineSegment)
  (Unwrapped (AroundEnd lineSegment))
  (Unwrapped (AroundEnd lineSegment))
_Wrapped((lineSegment -> Const (Leftmost (Point 2 r)) lineSegment)
 -> AroundEnd lineSegment
 -> Const (Leftmost (Point 2 r)) (AroundEnd lineSegment))
-> ((Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
    -> lineSegment -> Const (Leftmost (Point 2 r)) lineSegment)
-> (Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
-> AroundEnd lineSegment
-> Const (Leftmost (Point 2 r)) (AroundEnd lineSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(point -> Const (Leftmost (Point 2 r)) point)
-> lineSegment -> Const (Leftmost (Point 2 r)) lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end((point -> Const (Leftmost (Point 2 r)) point)
 -> lineSegment -> Const (Leftmost (Point 2 r)) lineSegment)
-> ((Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
    -> point -> Const (Leftmost (Point 2 r)) point)
-> (Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
-> lineSegment
-> Const (Leftmost (Point 2 r)) lineSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Leftmost (Point 2 r)) (Point 2 r))
-> point -> Const (Leftmost (Point 2 r)) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Set (AroundEnd lineSegment)
ends

-- | Merge the interiors of the Associated. The Maybe (Point 2 r) is
-- the intersection point in which all the segments intersect in their
-- interior (if we already know it; e.g. because it was the start or
-- endpoint of one of the other segments that also intersect here).
--
-- If this value is Nothing, then it must mean that all given segments
-- actually are interior intersections.
--
-- pre: if Nothing, then not all segments are colinear. This should be the
-- case (at least assuming we don't have )
mergeInteriors        :: forall lineSegment endPoint r.
                         ( LineSegment_ lineSegment endPoint
                         , Point_ endPoint 2 r, Ord r, Fractional r
                         , HasSupportingLine lineSegment
                         )
                      => Set.Set (AroundIntersection lineSegment)
                      -> Set.Set (AroundIntersection lineSegment)
                      -> Maybe (Point 2 r)
                      -> Set.Set (AroundIntersection lineSegment)
mergeInteriors :: forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Fractional r, HasSupportingLine lineSegment) =>
Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
-> Maybe (Point 2 r)
-> Set (AroundIntersection lineSegment)
mergeInteriors Set (AroundIntersection lineSegment)
is Set (AroundIntersection lineSegment)
is' = \case
    Just Point 2 r
p  -> Point 2 r
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Num r) =>
Point 2 r
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
mergeInteriorsWith Point 2 r
p Set (AroundIntersection lineSegment)
is Set (AroundIntersection lineSegment)
is'
    Maybe (Point 2 r)
Nothing -> case Set (AroundIntersection lineSegment)
-> Maybe
     (AroundIntersection lineSegment,
      Set (AroundIntersection lineSegment))
forall a. Set a -> Maybe (a, Set a)
Set.minView Set (AroundIntersection lineSegment)
is of
      Maybe
  (AroundIntersection lineSegment,
   Set (AroundIntersection lineSegment))
Nothing    -> Set (AroundIntersection lineSegment)
is' -- nothing to mrege anyway
      Just (AroundIntersection lineSegment
s,Set (AroundIntersection lineSegment)
rest) -> case Set (AroundIntersection lineSegment)
-> Maybe
     (AroundIntersection lineSegment,
      Set (AroundIntersection lineSegment))
forall a. Set a -> Maybe (a, Set a)
Set.minView Set (AroundIntersection lineSegment)
is' of
        Maybe
  (AroundIntersection lineSegment,
   Set (AroundIntersection lineSegment))
Nothing -> Set (AroundIntersection lineSegment)
is -- nothing to merge anyway
        Just (AroundIntersection lineSegment,
 Set (AroundIntersection lineSegment))
_  -> Point 2 r
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Num r) =>
Point 2 r
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
mergeInteriorsWith (AroundIntersection lineSegment
-> Set (AroundIntersection lineSegment) -> Point 2 r
findInteriorIntersection AroundIntersection lineSegment
s Set (AroundIntersection lineSegment)
rest) Set (AroundIntersection lineSegment)
is Set (AroundIntersection lineSegment)
is'
                   -- in this case, we claim there must be some segment that is not
                   -- colinear with s.
  where
    findInteriorIntersection :: AroundIntersection lineSegment
-> Set (AroundIntersection lineSegment) -> Point 2 r
findInteriorIntersection (AroundIntersection s :: lineSegment
s@(LineSegment_ endPoint
a endPoint
b)) Set (AroundIntersection lineSegment)
rest =
      case (lineSegment -> Bool) -> [lineSegment] -> [lineSegment]
forall a. (a -> Bool) -> [a] -> [a]
filter lineSegment -> Bool
nonColinear ([lineSegment] -> [lineSegment]) -> [lineSegment] -> [lineSegment]
forall a b. (a -> b) -> a -> b
$
             forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @[lineSegment] (Set (AroundIntersection lineSegment)
-> [AroundIntersection lineSegment]
forall a. Set a -> [a]
Set.toAscList Set (AroundIntersection lineSegment)
rest [AroundIntersection lineSegment]
-> [AroundIntersection lineSegment]
-> [AroundIntersection lineSegment]
forall a. Semigroup a => a -> a -> a
<> Set (AroundIntersection lineSegment)
-> [AroundIntersection lineSegment]
forall a. Set a -> [a]
Set.toAscList Set (AroundIntersection lineSegment)
is') of
        (lineSegment
s':[lineSegment]
_) -> case lineSegment -> LinePV (Dimension lineSegment) (NumType lineSegment)
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine lineSegment
s LinePV 2 r -> LinePV 2 r -> Intersection (LinePV 2 r) (LinePV 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` lineSegment -> LinePV (Dimension lineSegment) (NumType lineSegment)
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine lineSegment
s' of
          Just (Line_x_Line_Point Point 2 r
p) -> Point 2 r
p
          Intersection (LinePV 2 r) (LinePV 2 r)
_                          -> String -> Point 2 r
forall a. HasCallStack => String -> a
error String
"mergeInteriors. absurd. non-colinear intersect in point"
        [lineSegment]
_      -> String -> Point 2 r
forall a. HasCallStack => String -> a
error String
"mergeInteriors. no non-colinear segments !?"
      where
        nonColinear :: lineSegment -> Bool
nonColinear lineSegment
s' = endPoint -> endPoint -> endPoint -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw endPoint
a endPoint
b (lineSegment
s'lineSegment -> Getting endPoint lineSegment endPoint -> endPoint
forall s a. s -> Getting a s a -> a
^.Getting endPoint lineSegment endPoint
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment endPoint
start) CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
/= CCW
CoLinear Bool -> Bool -> Bool
|| endPoint -> endPoint -> endPoint -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw endPoint
a endPoint
b (lineSegment
s'lineSegment -> Getting endPoint lineSegment endPoint -> endPoint
forall s a. s -> Getting a s a -> a
^.Getting endPoint lineSegment endPoint
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment endPoint
end) CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
/= CCW
CoLinear

-- | Merge the two 'AroundIntersection' sets; given that they all have
-- point p in their interior.
mergeInteriorsWith ::       forall lineSegment endPoint r.
                            ( LineSegment_ lineSegment endPoint
                            , Point_ endPoint 2 r, Ord r, Num r
                            ) => Point 2 r
                            -> Set.Set (AroundIntersection lineSegment)
                            -> Set.Set (AroundIntersection lineSegment)
                            -> Set.Set (AroundIntersection lineSegment)
mergeInteriorsWith :: forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Num r) =>
Point 2 r
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
-> Set (AroundIntersection lineSegment)
mergeInteriorsWith Point 2 r
p Set (AroundIntersection lineSegment)
is Set (AroundIntersection lineSegment)
is' = [AroundIntersection lineSegment]
-> Set (AroundIntersection lineSegment)
forall a. [a] -> Set a
Set.fromDistinctAscList ([AroundIntersection lineSegment]
 -> Set (AroundIntersection lineSegment))
-> ([lineSegment] -> [AroundIntersection lineSegment])
-> [lineSegment]
-> Set (AroundIntersection lineSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [lineSegment] -> [AroundIntersection lineSegment]
forall a b. Coercible a b => a -> b
coerce
                            ([lineSegment] -> Set (AroundIntersection lineSegment))
-> [lineSegment] -> Set (AroundIntersection lineSegment)
forall a b. (a -> b) -> a -> b
$ (lineSegment -> lineSegment -> Ordering)
-> [lineSegment] -> [lineSegment] -> [lineSegment]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeSortedListsBy (Point 2 r -> lineSegment -> lineSegment -> Ordering
forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Num r) =>
Point 2 r -> lineSegment -> lineSegment -> Ordering
cmpInteriors Point 2 r
p)
                                                 (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @[lineSegment] ([AroundIntersection lineSegment] -> [lineSegment])
-> [AroundIntersection lineSegment] -> [lineSegment]
forall a b. (a -> b) -> a -> b
$ Set (AroundIntersection lineSegment)
-> [AroundIntersection lineSegment]
forall a. Set a -> [a]
Set.toAscList Set (AroundIntersection lineSegment)
is)
                                                 ([AroundIntersection lineSegment] -> [lineSegment]
forall a b. Coercible a b => a -> b
coerce ([AroundIntersection lineSegment] -> [lineSegment])
-> [AroundIntersection lineSegment] -> [lineSegment]
forall a b. (a -> b) -> a -> b
$ Set (AroundIntersection lineSegment)
-> [AroundIntersection lineSegment]
forall a. Set a -> [a]
Set.toAscList Set (AroundIntersection lineSegment)
is')

instance ( OrdArounds lineSegment
         , LineSegment_ lineSegment point, Point_ point 2 r, Ord r, Fractional r
         , HasSupportingLine lineSegment
         ) => Monoid (Associated lineSegment) where
  mempty :: Associated lineSegment
mempty = Associated lineSegment
forall lineSegment. Associated lineSegment
empty

instance (NFData lineSegment) => NFData (Associated lineSegment)

-- | For each intersection point the segments intersecting there.
type Intersections r lineSegment = Map.Map (Point 2 r) (Associated lineSegment)

-- | Get the set of all intersection points
intersectionPoints :: Intersections r lineSegment -> Set.Set (Point 2 r)
intersectionPoints :: forall r lineSegment.
Intersections r lineSegment -> Set (Point 2 r)
intersectionPoints = Map (Point 2 r) (Associated lineSegment) -> Set (Point 2 r)
forall k a. Map k a -> Set k
Map.keysSet

-- | An intersection point together with all segments intersecting at
-- this point.
data IntersectionPoint point lineSegment =
  IntersectionPoint { forall point lineSegment.
IntersectionPoint point lineSegment -> point
_intersectionPoint :: !point
                    , forall point lineSegment.
IntersectionPoint point lineSegment -> Associated lineSegment
_associatedSegs    :: !(Associated lineSegment)
                    } deriving stock (Int -> IntersectionPoint point lineSegment -> ShowS
[IntersectionPoint point lineSegment] -> ShowS
IntersectionPoint point lineSegment -> String
(Int -> IntersectionPoint point lineSegment -> ShowS)
-> (IntersectionPoint point lineSegment -> String)
-> ([IntersectionPoint point lineSegment] -> ShowS)
-> Show (IntersectionPoint point lineSegment)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall point lineSegment.
(Show point, Show lineSegment) =>
Int -> IntersectionPoint point lineSegment -> ShowS
forall point lineSegment.
(Show point, Show lineSegment) =>
[IntersectionPoint point lineSegment] -> ShowS
forall point lineSegment.
(Show point, Show lineSegment) =>
IntersectionPoint point lineSegment -> String
$cshowsPrec :: forall point lineSegment.
(Show point, Show lineSegment) =>
Int -> IntersectionPoint point lineSegment -> ShowS
showsPrec :: Int -> IntersectionPoint point lineSegment -> ShowS
$cshow :: forall point lineSegment.
(Show point, Show lineSegment) =>
IntersectionPoint point lineSegment -> String
show :: IntersectionPoint point lineSegment -> String
$cshowList :: forall point lineSegment.
(Show point, Show lineSegment) =>
[IntersectionPoint point lineSegment] -> ShowS
showList :: [IntersectionPoint point lineSegment] -> ShowS
Show,(forall x.
 IntersectionPoint point lineSegment
 -> Rep (IntersectionPoint point lineSegment) x)
-> (forall x.
    Rep (IntersectionPoint point lineSegment) x
    -> IntersectionPoint point lineSegment)
-> Generic (IntersectionPoint point lineSegment)
forall x.
Rep (IntersectionPoint point lineSegment) x
-> IntersectionPoint point lineSegment
forall x.
IntersectionPoint point lineSegment
-> Rep (IntersectionPoint point lineSegment) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall point lineSegment x.
Rep (IntersectionPoint point lineSegment) x
-> IntersectionPoint point lineSegment
forall point lineSegment x.
IntersectionPoint point lineSegment
-> Rep (IntersectionPoint point lineSegment) x
$cfrom :: forall point lineSegment x.
IntersectionPoint point lineSegment
-> Rep (IntersectionPoint point lineSegment) x
from :: forall x.
IntersectionPoint point lineSegment
-> Rep (IntersectionPoint point lineSegment) x
$cto :: forall point lineSegment x.
Rep (IntersectionPoint point lineSegment) x
-> IntersectionPoint point lineSegment
to :: forall x.
Rep (IntersectionPoint point lineSegment) x
-> IntersectionPoint point lineSegment
Generic)

-- | Lens to access the intersectionp oint
intersectionPoint :: Lens (IntersectionPoint point lineSegment)
                          (IntersectionPoint point' lineSegment)
                          point point'
intersectionPoint :: forall point lineSegment point' (f :: * -> *).
Functor f =>
(point -> f point')
-> IntersectionPoint point lineSegment
-> f (IntersectionPoint point' lineSegment)
intersectionPoint point -> f point'
f (IntersectionPoint point
p Associated lineSegment
ss) = (point' -> IntersectionPoint point' lineSegment)
-> f point' -> f (IntersectionPoint point' lineSegment)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\point'
p' -> point'
-> Associated lineSegment -> IntersectionPoint point' lineSegment
forall point lineSegment.
point
-> Associated lineSegment -> IntersectionPoint point lineSegment
IntersectionPoint point'
p' Associated lineSegment
ss) (point -> f point'
f point
p)
{-# INLINE intersectionPoint #-}

-- | Lens to access the associated segments
associatedSegs :: Lens (IntersectionPoint point lineSegment)
                       (IntersectionPoint point lineSegment')
                       (Associated lineSegment) (Associated lineSegment')
associatedSegs :: forall point lineSegment lineSegment' (f :: * -> *).
Functor f =>
(Associated lineSegment -> f (Associated lineSegment'))
-> IntersectionPoint point lineSegment
-> f (IntersectionPoint point lineSegment')
associatedSegs Associated lineSegment -> f (Associated lineSegment')
f (IntersectionPoint point
p Associated lineSegment
ss) = (Associated lineSegment' -> IntersectionPoint point lineSegment')
-> f (Associated lineSegment')
-> f (IntersectionPoint point lineSegment')
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Associated lineSegment'
ss' -> point
-> Associated lineSegment' -> IntersectionPoint point lineSegment'
forall point lineSegment.
point
-> Associated lineSegment -> IntersectionPoint point lineSegment
IntersectionPoint point
p Associated lineSegment'
ss') (Associated lineSegment -> f (Associated lineSegment')
f Associated lineSegment
ss)
{-# INLINE associatedSegs #-}


deriving stock instance ( Eq (AroundStart lineSegment)
                        , Eq (AroundIntersection lineSegment)
                        , Eq (AroundEnd lineSegment)
                        , Eq point
                        ) => Eq (IntersectionPoint point lineSegment)

-- deriving stock instance ( Read lineSegment, Read point
--                         , OrdArounds lineSegment
--                         ) => Read (IntersectionPoint point lineSegment)


instance (NFData point, NFData lineSegment) => NFData (IntersectionPoint point lineSegment)




-- | Given a point p, and a bunch of segments that suposedly intersect
-- at p, correctly categorize them.
mkIntersectionPoint         :: ( LineSegment_ lineSegment endPoint
                               , Point_ endPoint 2 r
                               , Point_ point 2 r, Ord r, Num r
                               , OrdArounds lineSegment
                               )
                            => point
                            -> [lineSegment] -- ^ uncategorized
                            -> [lineSegment] -- ^ segments we know contain p,
                            -> IntersectionPoint point lineSegment
mkIntersectionPoint :: forall lineSegment endPoint r point.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r,
 Point_ point 2 r, Ord r, Num r, OrdArounds lineSegment) =>
point
-> [lineSegment]
-> [lineSegment]
-> IntersectionPoint point lineSegment
mkIntersectionPoint point
p [lineSegment]
as [lineSegment]
cs = point
-> Associated lineSegment -> IntersectionPoint point lineSegment
forall point lineSegment.
point
-> Associated lineSegment -> IntersectionPoint point lineSegment
IntersectionPoint point
p (Associated lineSegment -> IntersectionPoint point lineSegment)
-> Associated lineSegment -> IntersectionPoint point lineSegment
forall a b. (a -> b) -> a -> b
$ Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
forall lineSegment.
Set (AroundStart lineSegment)
-> Set (AroundEnd lineSegment)
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
Associated Set (AroundStart lineSegment)
starts Set (AroundEnd lineSegment)
ends Set (AroundIntersection lineSegment)
interiors
  where
    p' :: Point 2 r
p' = point
ppoint -> Getting (Point 2 r) point (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint
    ([lineSegment]
starts',[lineSegment]
ends') = (lineSegment -> Bool)
-> [lineSegment] -> ([lineSegment], [lineSegment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (\lineSegment
seg -> lineSegment
seglineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(endPoint -> Const (Point 2 r) endPoint)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment endPoint
start((endPoint -> Const (Point 2 r) endPoint)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> endPoint -> Const (Point 2 r) endPoint)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> endPoint -> Const (Point 2 r) endPoint
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' endPoint (Point 2 r)
asPoint Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== Point 2 r
p') [lineSegment]
as
    starts :: Set (AroundStart lineSegment)
starts    = (lineSegment -> Set (AroundStart lineSegment))
-> [lineSegment] -> Set (AroundStart lineSegment)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (AroundStart lineSegment -> Set (AroundStart lineSegment)
forall a. a -> Set a
Set.singleton (AroundStart lineSegment -> Set (AroundStart lineSegment))
-> (lineSegment -> AroundStart lineSegment)
-> lineSegment
-> Set (AroundStart lineSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. lineSegment -> AroundStart lineSegment
forall a. a -> AroundStart a
AroundStart) [lineSegment]
starts'
    ends :: Set (AroundEnd lineSegment)
ends      = (lineSegment -> Set (AroundEnd lineSegment))
-> [lineSegment] -> Set (AroundEnd lineSegment)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (AroundEnd lineSegment -> Set (AroundEnd lineSegment)
forall a. a -> Set a
Set.singleton (AroundEnd lineSegment -> Set (AroundEnd lineSegment))
-> (lineSegment -> AroundEnd lineSegment)
-> lineSegment
-> Set (AroundEnd lineSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. lineSegment -> AroundEnd lineSegment
forall a. a -> AroundEnd a
AroundEnd)   [lineSegment]
ends'
    interiors :: Set (AroundIntersection lineSegment)
interiors = Point 2 r -> [lineSegment] -> Set (AroundIntersection lineSegment)
forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Num r) =>
Point 2 r -> [lineSegment] -> Set (AroundIntersection lineSegment)
fromInteriors Point 2 r
p' [lineSegment]
cs


-- | Helper to produce the "AroundIntersection" part of the associate segments
fromInteriors      :: ( LineSegment_ lineSegment endPoint
                      , Point_ endPoint 2 r, Ord r, Num r
                      ) => Point 2 r -> [lineSegment] -> Set.Set (AroundIntersection lineSegment)
fromInteriors :: forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Num r) =>
Point 2 r -> [lineSegment] -> Set (AroundIntersection lineSegment)
fromInteriors Point 2 r
p [lineSegment]
cs =
  [AroundIntersection lineSegment]
-> Set (AroundIntersection lineSegment)
forall a. [a] -> Set a
Set.fromDistinctAscList ([AroundIntersection lineSegment]
 -> Set (AroundIntersection lineSegment))
-> ([lineSegment] -> [AroundIntersection lineSegment])
-> [lineSegment]
-> Set (AroundIntersection lineSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (lineSegment -> AroundIntersection lineSegment)
-> [lineSegment] -> [AroundIntersection lineSegment]
forall a b. (a -> b) -> [a] -> [b]
map lineSegment -> AroundIntersection lineSegment
forall a. a -> AroundIntersection a
AroundIntersection ([lineSegment] -> [AroundIntersection lineSegment])
-> ([lineSegment] -> [lineSegment])
-> [lineSegment]
-> [AroundIntersection lineSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (lineSegment -> lineSegment -> Ordering)
-> [lineSegment] -> [lineSegment]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (Point 2 r -> lineSegment -> lineSegment -> Ordering
forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Num r) =>
Point 2 r -> lineSegment -> lineSegment -> Ordering
cmpInteriors Point 2 r
p) ([lineSegment] -> Set (AroundIntersection lineSegment))
-> [lineSegment] -> Set (AroundIntersection lineSegment)
forall a b. (a -> b) -> a -> b
$ [lineSegment]
cs

-- | we first compare by the CCW orrientation of the startin point; on
-- equal starting angles, we prefer segments closer to p. If those are
-- equal as well, order by distance to the endpoint. (If those are
-- equal, the segments would really have the same endpoints; so
-- consider them equal
cmpInteriors        :: ( LineSegment_ lineSegment endPoint
                       , Point_ endPoint 2 r, Ord r, Num r
                       )
                    => Point 2 r -> lineSegment -> lineSegment -> Ordering
cmpInteriors :: forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Num r) =>
Point 2 r -> lineSegment -> lineSegment -> Ordering
cmpInteriors Point 2 r
p lineSegment
s lineSegment
s' = Point 2 r -> lineSegment -> lineSegment -> Ordering
forall lineSegment point r point'.
(LineSegment_ lineSegment point, Point_ point 2 r,
 Point_ point' 2 r, Ord r, Num r) =>
point' -> lineSegment -> lineSegment -> Ordering
cmpAroundP Point 2 r
p lineSegment
s lineSegment
s' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Point 2 r -> Point 2 r -> Ordering
cmpDist (lineSegment
slineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(endPoint -> Const (Point 2 r) endPoint)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment endPoint
start((endPoint -> Const (Point 2 r) endPoint)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> endPoint -> Const (Point 2 r) endPoint)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> endPoint -> Const (Point 2 r) endPoint
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' endPoint (Point 2 r)
asPoint) (lineSegment
s'lineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(endPoint -> Const (Point 2 r) endPoint)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment endPoint
start((endPoint -> Const (Point 2 r) endPoint)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> endPoint -> Const (Point 2 r) endPoint)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> endPoint -> Const (Point 2 r) endPoint
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' endPoint (Point 2 r)
asPoint)
                                   Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Point 2 r -> Point 2 r -> Ordering
cmpDist (lineSegment
slineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(endPoint -> Const (Point 2 r) endPoint)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment endPoint
end((endPoint -> Const (Point 2 r) endPoint)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> endPoint -> Const (Point 2 r) endPoint)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> endPoint -> Const (Point 2 r) endPoint
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' endPoint (Point 2 r)
asPoint)   (lineSegment
s'lineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(endPoint -> Const (Point 2 r) endPoint)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment endPoint
end((endPoint -> Const (Point 2 r) endPoint)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> endPoint -> Const (Point 2 r) endPoint)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> endPoint -> Const (Point 2 r) endPoint
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' endPoint (Point 2 r)
asPoint)
  where
    -- compare by increasing distance to p.
    cmpDist :: Point 2 r -> Point 2 r -> Ordering
cmpDist = (Point 2 r -> r) -> Point 2 r -> Point 2 r -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Point 2 r -> Point 2 r -> r
forall r point (d :: Nat) point'.
(Num r, Point_ point d r, Point_ point' d r,
 Metric_ (Vector d r) d r) =>
point -> point' -> r
squaredEuclideanDist Point 2 r
p)

-- | An ordering that is decreasing on y, increasing on x
ordPoints     :: (Point_ point 2 r, Ord r) => point -> point -> Ordering
ordPoints :: forall point r.
(Point_ point 2 r, Ord r) =>
point -> point -> Ordering
ordPoints point
a point
b = let f :: s -> (Down (NumType s), NumType s)
f s
p = (NumType s -> Down (NumType s)
forall a. a -> Down a
Down (NumType s -> Down (NumType s)) -> NumType s -> Down (NumType s)
forall a b. (a -> b) -> a -> b
$ s
ps -> Getting (NumType s) s (NumType s) -> NumType s
forall s a. s -> Getting a s a -> a
^.Getting (NumType s) s (NumType s)
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int s (NumType s)
yCoord, s
ps -> Getting (NumType s) s (NumType s) -> NumType s
forall s a. s -> Getting a s a -> a
^.Getting (NumType s) s (NumType s)
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int s (NumType s)
xCoord) in (point -> (Down r, r)) -> point -> point -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing point -> (Down r, r)
point -> (Down (NumType point), NumType point)
forall {s}.
(Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Point_ s (Dimension s) (NumType s)) =>
s -> (Down (NumType s), NumType s)
f point
a point
b

-- | Given two segments, compute an IntersectionPoint representing their intersection (if
-- such an intersection exists).
intersectionPointOf      :: ( LineSegment_ lineSegment point
                            , LineSegment_ seg point
                            , Point_ point 2 r
                            , Ord r, Fractional r
                            , IntersectConstraints seg lineSegment
                            )
                         => lineSegment -> lineSegment
                         -> Maybe (IntersectionPoint (Point 2 r) lineSegment)
intersectionPointOf :: forall lineSegment point seg r.
(LineSegment_ lineSegment point, LineSegment_ seg point,
 Point_ point 2 r, Ord r, Fractional r,
 IntersectConstraints seg lineSegment) =>
lineSegment
-> lineSegment -> Maybe (IntersectionPoint (Point 2 r) lineSegment)
intersectionPointOf lineSegment
s lineSegment
s' = lineSegment
s lineSegment -> lineSegment -> Intersection lineSegment lineSegment
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` lineSegment
s' Maybe (LineSegmentLineSegmentIntersection seg)
-> (LineSegmentLineSegmentIntersection seg
    -> IntersectionPoint (Point 2 r) lineSegment)
-> Maybe (IntersectionPoint (Point 2 r) lineSegment)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
     LineSegment_x_LineSegment_Point Point 2 (NumType seg)
p         -> Point 2 r -> IntersectionPoint (Point 2 r) lineSegment
intersectionPoint' Point 2 r
Point 2 (NumType seg)
p
     LineSegment_x_LineSegment_LineSegment seg
seg -> Point 2 r -> IntersectionPoint (Point 2 r) lineSegment
intersectionPoint' (seg -> Point (Dimension point) (NumType point)
forall {p} {p} {s}.
(NumType p ~ NumType p, Dimension p ~ Dimension p, Dimension p ~ 2,
 Ord (NumType p), HasStart s p, HasEnd s p, Point_ p 2 (NumType p),
 Point_ p 2 (NumType p)) =>
s -> Point (Dimension p) (NumType p)
topEndPoint seg
seg)
  where
    intersectionPoint' :: Point 2 r -> IntersectionPoint (Point 2 r) lineSegment
intersectionPoint' Point 2 r
p = Point 2 r
-> Associated lineSegment
-> IntersectionPoint (Point 2 r) lineSegment
forall point lineSegment.
point
-> Associated lineSegment -> IntersectionPoint point lineSegment
IntersectionPoint Point 2 r
p Associated lineSegment
associated
      where
        associated :: Associated lineSegment
associated = case Point 2 r -> lineSegment -> IntersectionType
forall r lineSegment point.
(Eq r, LineSegment_ lineSegment point, Point_ point 2 r) =>
Point 2 r -> lineSegment -> IntersectionType
categorize Point 2 r
p lineSegment
s of
          IntersectionType
Start    -> Point 2 r -> lineSegment -> Associated lineSegment
forall lineSegment point r point'.
(LineSegment_ lineSegment point, Point_ point 2 r,
 Point_ point' 2 r, Eq r) =>
point' -> lineSegment -> Associated lineSegment
mkAssociated Point 2 r
p lineSegment
s' Associated lineSegment
-> (Associated lineSegment -> Associated lineSegment)
-> Associated lineSegment
forall a b. a -> (a -> b) -> b
& (Set (AroundStart lineSegment)
 -> Identity (Set (AroundStart lineSegment)))
-> Associated lineSegment -> Identity (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundStart lineSegment)
 -> f (Set (AroundStart lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
startPointOf ((Set (AroundStart lineSegment)
  -> Identity (Set (AroundStart lineSegment)))
 -> Associated lineSegment -> Identity (Associated lineSegment))
-> (Set (AroundStart lineSegment) -> Set (AroundStart lineSegment))
-> Associated lineSegment
-> Associated lineSegment
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AroundStart lineSegment
-> Set (AroundStart lineSegment) -> Set (AroundStart lineSegment)
forall a. Ord a => a -> Set a -> Set a
Set.insert (lineSegment -> AroundStart lineSegment
forall a. a -> AroundStart a
AroundStart lineSegment
s)
          IntersectionType
End      -> Point 2 r -> lineSegment -> Associated lineSegment
forall lineSegment point r point'.
(LineSegment_ lineSegment point, Point_ point 2 r,
 Point_ point' 2 r, Eq r) =>
point' -> lineSegment -> Associated lineSegment
mkAssociated Point 2 r
p lineSegment
s' Associated lineSegment
-> (Associated lineSegment -> Associated lineSegment)
-> Associated lineSegment
forall a b. a -> (a -> b) -> b
& (Set (AroundEnd lineSegment)
 -> Identity (Set (AroundEnd lineSegment)))
-> Associated lineSegment -> Identity (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundEnd lineSegment) -> f (Set (AroundEnd lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
endPointOf   ((Set (AroundEnd lineSegment)
  -> Identity (Set (AroundEnd lineSegment)))
 -> Associated lineSegment -> Identity (Associated lineSegment))
-> (Set (AroundEnd lineSegment) -> Set (AroundEnd lineSegment))
-> Associated lineSegment
-> Associated lineSegment
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AroundEnd lineSegment
-> Set (AroundEnd lineSegment) -> Set (AroundEnd lineSegment)
forall a. Ord a => a -> Set a -> Set a
Set.insert (lineSegment -> AroundEnd lineSegment
forall a. a -> AroundEnd a
AroundEnd lineSegment
s)
          IntersectionType
Interior -> case Point 2 r -> lineSegment -> IntersectionType
forall r lineSegment point.
(Eq r, LineSegment_ lineSegment point, Point_ point 2 r) =>
Point 2 r -> lineSegment -> IntersectionType
categorize Point 2 r
p lineSegment
s' of
             IntersectionType
Interior -> Associated lineSegment
forall lineSegment. Associated lineSegment
empty             Associated lineSegment
-> (Associated lineSegment -> Associated lineSegment)
-> Associated lineSegment
forall a b. a -> (a -> b) -> b
& (Set (AroundIntersection lineSegment)
 -> Identity (Set (AroundIntersection lineSegment)))
-> Associated lineSegment -> Identity (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundIntersection lineSegment)
 -> f (Set (AroundIntersection lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
interiorTo ((Set (AroundIntersection lineSegment)
  -> Identity (Set (AroundIntersection lineSegment)))
 -> Associated lineSegment -> Identity (Associated lineSegment))
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
-> Associated lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point 2 r -> [lineSegment] -> Set (AroundIntersection lineSegment)
forall lineSegment endPoint r.
(LineSegment_ lineSegment endPoint, Point_ endPoint 2 r, Ord r,
 Num r) =>
Point 2 r -> [lineSegment] -> Set (AroundIntersection lineSegment)
fromInteriors Point 2 r
p [lineSegment
s,lineSegment
s']
             IntersectionType
_        -> Point 2 r -> lineSegment -> Associated lineSegment
forall lineSegment point r point'.
(LineSegment_ lineSegment point, Point_ point 2 r,
 Point_ point' 2 r, Eq r) =>
point' -> lineSegment -> Associated lineSegment
mkAssociated Point 2 r
p lineSegment
s' Associated lineSegment
-> (Associated lineSegment -> Associated lineSegment)
-> Associated lineSegment
forall a b. a -> (a -> b) -> b
& (Set (AroundIntersection lineSegment)
 -> Identity (Set (AroundIntersection lineSegment)))
-> Associated lineSegment -> Identity (Associated lineSegment)
forall lineSegment (f :: * -> *).
Functor f =>
(Set (AroundIntersection lineSegment)
 -> f (Set (AroundIntersection lineSegment)))
-> Associated lineSegment -> f (Associated lineSegment)
interiorTo ((Set (AroundIntersection lineSegment)
  -> Identity (Set (AroundIntersection lineSegment)))
 -> Associated lineSegment -> Identity (Associated lineSegment))
-> Set (AroundIntersection lineSegment)
-> Associated lineSegment
-> Associated lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AroundIntersection lineSegment
-> Set (AroundIntersection lineSegment)
forall a. a -> Set a
Set.singleton (lineSegment -> AroundIntersection lineSegment
forall a. a -> AroundIntersection a
AroundIntersection lineSegment
s)
    topEndPoint :: s -> Point (Dimension p) (NumType p)
topEndPoint s
seg = (Point (Dimension p) (NumType p)
 -> Point (Dimension p) (NumType p) -> Ordering)
-> [Point (Dimension p) (NumType p)]
-> Point (Dimension p) (NumType p)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.minimumBy Point (Dimension p) (NumType p)
-> Point (Dimension p) (NumType p) -> Ordering
forall point r.
(Point_ point 2 r, Ord r) =>
point -> point -> Ordering
ordPoints [s
segs
-> Getting
     (Point (Dimension p) (NumType p))
     s
     (Point (Dimension p) (NumType p))
-> Point (Dimension p) (NumType p)
forall s a. s -> Getting a s a -> a
^.(p -> Const (Point (Dimension p) (NumType p)) p)
-> s -> Const (Point (Dimension p) (NumType p)) s
forall seg p. HasStart seg p => Lens' seg p
Lens' s p
start((p -> Const (Point (Dimension p) (NumType p)) p)
 -> s -> Const (Point (Dimension p) (NumType p)) s)
-> ((Point (Dimension p) (NumType p)
     -> Const
          (Point (Dimension p) (NumType p))
          (Point (Dimension p) (NumType p)))
    -> p -> Const (Point (Dimension p) (NumType p)) p)
-> Getting
     (Point (Dimension p) (NumType p))
     s
     (Point (Dimension p) (NumType p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point (Dimension p) (NumType p)
 -> Const
      (Point (Dimension p) (NumType p))
      (Point (Dimension p) (NumType p)))
-> p -> Const (Point (Dimension p) (NumType p)) p
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' p (Point (Dimension p) (NumType p))
asPoint, s
segs
-> Getting
     (Point (Dimension p) (NumType p))
     s
     (Point (Dimension p) (NumType p))
-> Point (Dimension p) (NumType p)
forall s a. s -> Getting a s a -> a
^.(p -> Const (Point (Dimension p) (NumType p)) p)
-> s -> Const (Point (Dimension p) (NumType p)) s
forall seg p. HasEnd seg p => Lens' seg p
Lens' s p
end((p -> Const (Point (Dimension p) (NumType p)) p)
 -> s -> Const (Point (Dimension p) (NumType p)) s)
-> ((Point (Dimension p) (NumType p)
     -> Const
          (Point (Dimension p) (NumType p))
          (Point (Dimension p) (NumType p)))
    -> p -> Const (Point (Dimension p) (NumType p)) p)
-> Getting
     (Point (Dimension p) (NumType p))
     s
     (Point (Dimension p) (NumType p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point (Dimension p) (NumType p)
 -> Const
      (Point (Dimension p) (NumType p))
      (Point (Dimension p) (NumType p)))
-> p -> Const (Point (Dimension p) (NumType p)) p
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' p (Point (Dimension p) (NumType p))
asPoint]

data IntersectionType = Start | End | Interior deriving (Int -> IntersectionType -> ShowS
[IntersectionType] -> ShowS
IntersectionType -> String
(Int -> IntersectionType -> ShowS)
-> (IntersectionType -> String)
-> ([IntersectionType] -> ShowS)
-> Show IntersectionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntersectionType -> ShowS
showsPrec :: Int -> IntersectionType -> ShowS
$cshow :: IntersectionType -> String
show :: IntersectionType -> String
$cshowList :: [IntersectionType] -> ShowS
showList :: [IntersectionType] -> ShowS
Show,IntersectionType -> IntersectionType -> Bool
(IntersectionType -> IntersectionType -> Bool)
-> (IntersectionType -> IntersectionType -> Bool)
-> Eq IntersectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntersectionType -> IntersectionType -> Bool
== :: IntersectionType -> IntersectionType -> Bool
$c/= :: IntersectionType -> IntersectionType -> Bool
/= :: IntersectionType -> IntersectionType -> Bool
Eq)

-- | Try to find the apprpriate intersection type
categorize    :: (Eq r, LineSegment_ lineSegment point, Point_ point 2 r)
              => Point 2 r -> lineSegment -> IntersectionType
categorize :: forall r lineSegment point.
(Eq r, LineSegment_ lineSegment point, Point_ point 2 r) =>
Point 2 r -> lineSegment -> IntersectionType
categorize Point 2 r
p lineSegment
s
  | Point 2 r
p Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== lineSegment
slineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint = IntersectionType
Start
  | Point 2 r
p Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== lineSegment
slineSegment
-> Getting (Point 2 r) lineSegment (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> lineSegment -> Const (Point 2 r) lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end((point -> Const (Point 2 r) point)
 -> lineSegment -> Const (Point 2 r) lineSegment)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) lineSegment (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint   = IntersectionType
End
  | Bool
otherwise             = IntersectionType
Interior


-- | Shorthand for the more-or-less standard constraints that we need on LineSegments
type IntersectConstraints seg lineSegment =
  ( OrdArounds lineSegment
  , IsIntersectableWith lineSegment lineSegment
  , Intersection lineSegment lineSegment ~ Maybe (LineSegmentLineSegmentIntersection seg)
  , NumType seg ~ NumType lineSegment
  , Dimension seg ~ Dimension lineSegment
  )