--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.LineSegment.Intersection.Naive
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Line segment intersections in \(O(n^2)\) by checking all pairs.
--
--------------------------------------------------------------------------------
module HGeometry.LineSegment.Intersection.Naive
  ( intersections
  , Intersections
  , Associated, startPointOf, endPointOf, interiorTo
  , associatedSegments

  , AroundEnd, AroundStart, AroundIntersection
  , isInteriorIntersection

  , IntersectionPoint
  , intersectionPointOf

  , intersectionPoint, associatedSegs

  , IntersectConstraints
  , OrdArounds
  ) where

import           Control.Lens ((^.))
import qualified Data.Map as Map
import           HGeometry.Combinatorial.Util
import           HGeometry.LineSegment
import           HGeometry.LineSegment.Intersection.Types
import           HGeometry.Point

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

-- | Compute all intersections (naively)
--
-- \(O(n^2)\)
intersections :: ( Ord r, Fractional r
                 , LineSegment_ lineSegment point
                 , Eq lineSegment
                 , Point_ point 2 r
                 , IntersectConstraints seg lineSegment
                 , LineSegment_ seg point
                 , Foldable f
                 )
              => f lineSegment -> Intersections r lineSegment
intersections :: forall r lineSegment point seg (f :: * -> *).
(Ord r, Fractional r, LineSegment_ lineSegment point,
 Eq lineSegment, Point_ point 2 r,
 IntersectConstraints seg lineSegment, LineSegment_ seg point,
 Foldable f) =>
f lineSegment -> Intersections r lineSegment
intersections = (Two lineSegment -> Intersections r lineSegment)
-> [Two lineSegment] -> Intersections r lineSegment
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Two lineSegment -> Intersections r lineSegment
Two lineSegment
-> Map
     (Point 2 (NumType (IxValue (EndPointOf lineSegment))))
     (Associated lineSegment)
forall {seg} {lineSegment}.
(Dimension seg ~ 2, Dimension lineSegment ~ 2,
 Dimension (IxValue (EndPointOf lineSegment)) ~ 2,
 NumType seg ~ NumType lineSegment,
 NumType (IxValue (EndPointOf lineSegment)) ~ NumType lineSegment,
 Intersection lineSegment lineSegment
 ~ Maybe (LineSegmentLineSegmentIntersection seg),
 Fractional (NumType lineSegment),
 LineSegment_ seg (IxValue (EndPointOf lineSegment)),
 LineSegment_ lineSegment (IxValue (EndPointOf lineSegment)),
 Point_ (IxValue (EndPointOf lineSegment)) 2 (NumType lineSegment),
 Ord (NumType lineSegment),
 IsIntersectableWith lineSegment lineSegment, Eq lineSegment) =>
Two lineSegment
-> Map
     (Point 2 (NumType (IxValue (EndPointOf lineSegment))))
     (Associated lineSegment)
collect ([Two lineSegment] -> Intersections r lineSegment)
-> (f lineSegment -> [Two lineSegment])
-> f lineSegment
-> Intersections r lineSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f lineSegment -> [Two lineSegment]
forall (f :: * -> *) a. Foldable f => f a -> [Two a]
uniquePairs
  where
    collect :: Two lineSegment
-> Map
     (Point 2 (NumType (IxValue (EndPointOf lineSegment))))
     (Associated lineSegment)
collect (Two lineSegment
s lineSegment
s') = case lineSegment
-> lineSegment
-> Maybe
     (IntersectionPoint
        (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment)
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' of
                           Maybe
  (IntersectionPoint
     (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment)
Nothing -> Map
  (Point 2 (NumType (IxValue (EndPointOf lineSegment))))
  (Associated lineSegment)
forall a. Monoid a => a
mempty
                           Just IntersectionPoint
  (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment
ip -> Point 2 (NumType (IxValue (EndPointOf lineSegment)))
-> Associated lineSegment
-> Map
     (Point 2 (NumType (IxValue (EndPointOf lineSegment))))
     (Associated lineSegment)
forall k a. k -> a -> Map k a
Map.singleton (IntersectionPoint
  (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment
ipIntersectionPoint
  (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment
-> Getting
     (Point 2 (NumType (IxValue (EndPointOf lineSegment))))
     (IntersectionPoint
        (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment)
     (Point 2 (NumType (IxValue (EndPointOf lineSegment))))
-> Point 2 (NumType (IxValue (EndPointOf lineSegment)))
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 (NumType (IxValue (EndPointOf lineSegment))))
  (IntersectionPoint
     (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment)
  (Point 2 (NumType (IxValue (EndPointOf lineSegment))))
forall point lineSegment point' (f :: * -> *).
Functor f =>
(point -> f point')
-> IntersectionPoint point lineSegment
-> f (IntersectionPoint point' lineSegment)
intersectionPoint) (IntersectionPoint
  (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment
ipIntersectionPoint
  (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment
-> Getting
     (Associated lineSegment)
     (IntersectionPoint
        (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment)
     (Associated lineSegment)
-> Associated lineSegment
forall s a. s -> Getting a s a -> a
^.Getting
  (Associated lineSegment)
  (IntersectionPoint
     (Point 2 (NumType (IxValue (EndPointOf lineSegment)))) lineSegment)
  (Associated lineSegment)
forall point lineSegment lineSegment' (f :: * -> *).
Functor f =>
(Associated lineSegment -> f (Associated lineSegment'))
-> IntersectionPoint point lineSegment
-> f (IntersectionPoint point lineSegment')
associatedSegs)

-- type R = Rational

-- seg1, seg2 :: LineSegment 2 () R
-- seg1 = ClosedLineSegment (ext $ Point2 0 0) (ext $ Point2 0 10)
-- seg2 = ClosedLineSegment (ext $ Point2 0 1) (ext $ Point2 0 5)