{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Algorithms.Geometry.LineSegmentIntersection.BooleanSweep
-- Copyright   :  (C) Frank Staals, David Himmelstrup
-- License     :  see the LICENSE file
-- Maintainer  :  David Himmelstrup
--
-- \( O(n \log n) \) algorithm for determining if any two line segments overlap.
--
-- Shamos and Hoey.
--
--------------------------------------------------------------------------------
module Algorithms.Geometry.LineSegmentIntersection.BooleanSweep
  ( hasIntersections
  , segmentsOverlap
  ) where

import           Control.Lens              hiding (contains)
import           Data.Ext
import           Data.Geometry.Interval
import           Data.Geometry.Line
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Triangle
import qualified Data.List                 as L
import           Data.Maybe
import           Data.Ord                  (Down (..), comparing)
import qualified Data.Set                  as SS
import qualified Data.Set.Util             as SS

-- import           Data.RealNumber.Rational
-- import Debug.Trace

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

-- | Tests if there are any intersections.
--
-- \(O(n\log n)\)
hasIntersections    :: (Ord r, Num r)
                 => [LineSegment 2 p r] -> Bool
hasIntersections :: [LineSegment 2 p r] -> Bool
hasIntersections [LineSegment 2 p r]
ss = [Event p r] -> StatusStructure p r -> Bool
forall r p.
(Ord r, Num r) =>
[Event p r] -> StatusStructure p r -> Bool
sweep [Event p r]
pts StatusStructure p r
forall a. Set a
SS.empty
  where
    pts :: [Event p r]
pts = (Event p r -> Event p r -> Ordering) -> [Event p r] -> [Event p r]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy Event p r -> Event p r -> Ordering
forall r p. (Num r, Ord r) => Event p r -> Event p r -> Ordering
ordEvents ([Event p r] -> [Event p r])
-> ([LineSegment 2 p r] -> [Event p r])
-> [LineSegment 2 p r]
-> [Event p r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LineSegment 2 p r -> [Event p r])
-> [LineSegment 2 p r] -> [Event p r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LineSegment 2 p r -> [Event p r]
forall r p. Ord r => LineSegment 2 p r -> [Event p r]
asEventPts ([LineSegment 2 p r] -> [Event p r])
-> [LineSegment 2 p r] -> [Event p r]
forall a b. (a -> b) -> a -> b
$ [LineSegment 2 p r]
ss

-- | Computes the event points for a given line segment
asEventPts   :: Ord r => LineSegment 2 p r -> [Event p r]
asEventPts :: LineSegment 2 p r -> [Event p r]
asEventPts LineSegment 2 p r
s =
  case Point 2 r -> Point 2 r -> Ordering
forall r. Ord r => Point 2 r -> Point 2 r -> Ordering
ordPoints (LineSegment 2 p r
sLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (LineSegment 2 p r
sLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) of
    Ordering
LT -> [LineSegment 2 p r -> Event p r
forall p r. LineSegment 2 p r -> Event p r
Insert LineSegment 2 p r
s, LineSegment 2 p r -> Event p r
forall p r. LineSegment 2 p r -> Event p r
Delete LineSegment 2 p r
s]
    Ordering
_  -> let LineSegment EndPoint (Point 2 r :+ p)
a EndPoint (Point 2 r :+ p)
b = LineSegment 2 p r
s
              s' :: LineSegment 2 p r
s' = EndPoint (Point 2 r :+ p)
-> EndPoint (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment EndPoint (Point 2 r :+ p)
b EndPoint (Point 2 r :+ p)
a
          in [LineSegment 2 p r -> Event p r
forall p r. LineSegment 2 p r -> Event p r
Insert LineSegment 2 p r
s', LineSegment 2 p r -> Event p r
forall p r. LineSegment 2 p r -> Event p r
Delete LineSegment 2 p r
s']

--------------------------------------------------------------------------------
-- * Data type for Events

-- | The actual event consists of a point and its type
data Event p r = Insert (LineSegment 2 p r) | Delete (LineSegment 2 p r)

eventPoint :: Event p r -> Point 2 r
eventPoint :: Event p r -> Point 2 r
eventPoint (Insert LineSegment 2 p r
l) = LineSegment 2 p r
lLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
eventPoint (Delete LineSegment 2 p r
l) = LineSegment 2 p r
lLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core

-- Sort order:
--  1. Y-coord. Larger Ys before smaller.
--  2. X-coord. Smaller Xs before larger.
--  3. Type: Inserts before deletions
ordEvents :: (Num r, Ord r) => Event p r -> Event p r -> Ordering
ordEvents :: Event p r -> Event p r -> Ordering
ordEvents Event p r
e1 Event p r
e2 = Point 2 r -> Point 2 r -> Ordering
forall r. Ord r => Point 2 r -> Point 2 r -> Ordering
ordPoints (Event p r -> Point 2 r
forall p r. Event p r -> Point 2 r
eventPoint Event p r
e1) (Event p r -> Point 2 r
forall p r. Event p r -> Point 2 r
eventPoint Event p r
e2) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Event p r -> Event p r -> Ordering
forall p r p r. Event p r -> Event p r -> Ordering
cmpType Event p r
e1 Event p r
e2
  where
    cmpType :: Event p r -> Event p r -> Ordering
cmpType Insert{} Delete{} = Ordering
LT
    cmpType Delete{} Insert{} = Ordering
GT
    cmpType Event p r
_ Event p r
_               = Ordering
EQ

-- | An ordering that is decreasing on y, increasing on x
ordPoints     :: Ord r => Point 2 r -> Point 2 r -> Ordering
ordPoints :: Point 2 r -> Point 2 r -> Ordering
ordPoints Point 2 r
a Point 2 r
b = let f :: point d b -> (Down b, b)
f point d b
p = (b -> Down b
forall a. a -> Down a
Down (b -> Down b) -> b -> Down b
forall a b. (a -> b) -> a -> b
$ point d b
ppoint d b -> Getting b (point d b) b -> b
forall s a. s -> Getting a s a -> a
^.Getting b (point d b) b
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord, point d b
ppoint d b -> Getting b (point d b) b -> b
forall s a. s -> Getting a s a -> a
^.Getting b (point d b) b
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord) in (Point 2 r -> (Down r, r)) -> Point 2 r -> Point 2 r -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Point 2 r -> (Down r, r)
forall (d :: Nat) (point :: Nat -> * -> *) b.
(ImplicitPeano (Peano d), ArityPeano (Peano (FromPeano (Peano d))),
 KnownNat (FromPeano (Peano d)), KnownNat d, AsAPoint point,
 (1 <=? d) ~ 'True, (2 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
point d b -> (Down b, b)
f Point 2 r
a Point 2 r
b

--------------------------------------------------------------------------------
-- * The Main Sweep

type StatusStructure p r = SS.Set (LineSegment 2 p r)

-- | Run the sweep handling all events
sweep :: forall r p. (Ord r, Num r)
      => [Event p r] -> StatusStructure p r
      -> Bool
sweep :: [Event p r] -> StatusStructure p r -> Bool
sweep [] StatusStructure p r
_ = Bool
False
sweep (Delete LineSegment 2 p r
l:[Event p r]
eq) StatusStructure p r
ss =
    Bool
overlaps Bool -> Bool -> Bool
|| [Event p r] -> StatusStructure p r -> Bool
forall r p.
(Ord r, Num r) =>
[Event p r] -> StatusStructure p r -> Bool
sweep [Event p r]
eq StatusStructure p r
ss'
  where
    p :: Point 2 r
p = LineSegment 2 p r
lLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
    (StatusStructure p r
before,[LineSegment 2 p r]
_contains,StatusStructure p r
after) = Point 2 r
-> StatusStructure p r
-> (StatusStructure p r, [LineSegment 2 p r], StatusStructure p r)
forall r p.
(Num r, Ord r) =>
Point 2 r
-> StatusStructure p r
-> (StatusStructure p r, [LineSegment 2 p r], StatusStructure p r)
splitBeforeAfter Point 2 r
p StatusStructure p r
ss
    overlaps :: Bool
overlaps = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (LineSegment 2 p r -> LineSegment 2 p r -> Bool
forall r p.
(Num r, Ord r) =>
LineSegment 2 p r -> LineSegment 2 p r -> Bool
segmentsOverlap (LineSegment 2 p r -> LineSegment 2 p r -> Bool)
-> Maybe (LineSegment 2 p r) -> Maybe (LineSegment 2 p r -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LineSegment 2 p r)
sl Maybe (LineSegment 2 p r -> Bool)
-> Maybe (LineSegment 2 p r) -> Maybe Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (LineSegment 2 p r)
sr)
    sl :: Maybe (LineSegment 2 p r)
sl = StatusStructure p r -> Maybe (LineSegment 2 p r)
forall a. Set a -> Maybe a
SS.lookupMax StatusStructure p r
before
    sr :: Maybe (LineSegment 2 p r)
sr = StatusStructure p r -> Maybe (LineSegment 2 p r)
forall a. Set a -> Maybe a
SS.lookupMin StatusStructure p r
after
    ss' :: StatusStructure p r
ss' = StatusStructure p r
before StatusStructure p r -> StatusStructure p r -> StatusStructure p r
forall a. Set a -> Set a -> Set a
`SS.join` StatusStructure p r
after
sweep (Insert l :: LineSegment 2 p r
l@(LineSegment EndPoint (Point 2 r :+ p)
startPoint EndPoint (Point 2 r :+ p)
_endPoint):[Event p r]
eq) StatusStructure p r
ss =
    Bool
endOverlap Bool -> Bool -> Bool
|| Bool
overlaps Bool -> Bool -> Bool
|| [Event p r] -> StatusStructure p r -> Bool
forall r p.
(Ord r, Num r) =>
[Event p r] -> StatusStructure p r -> Bool
sweep [Event p r]
eq StatusStructure p r
ss'
  where
    p :: Point 2 r
p = LineSegment 2 p r
lLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
    (StatusStructure p r
before,[LineSegment 2 p r]
contains,StatusStructure p r
after) = Point 2 r
-> StatusStructure p r
-> (StatusStructure p r, [LineSegment 2 p r], StatusStructure p r)
forall r p.
(Num r, Ord r) =>
Point 2 r
-> StatusStructure p r
-> (StatusStructure p r, [LineSegment 2 p r], StatusStructure p r)
splitBeforeAfter Point 2 r
p StatusStructure p r
ss
    endOverlap :: Bool
endOverlap =
      (Bool -> Bool
not ([LineSegment 2 p r] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LineSegment 2 p r]
contains) Bool -> Bool -> Bool
&& EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
startPoint)
    overlaps :: Bool
overlaps = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (LineSegment 2 p r -> LineSegment 2 p r -> Bool
forall r p.
(Num r, Ord r) =>
LineSegment 2 p r -> LineSegment 2 p r -> Bool
segmentsOverlap LineSegment 2 p r
l (LineSegment 2 p r -> Bool)
-> Maybe (LineSegment 2 p r) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LineSegment 2 p r)
sl)
                  , Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (LineSegment 2 p r -> LineSegment 2 p r -> Bool
forall r p.
(Num r, Ord r) =>
LineSegment 2 p r -> LineSegment 2 p r -> Bool
segmentsOverlap LineSegment 2 p r
l (LineSegment 2 p r -> Bool)
-> Maybe (LineSegment 2 p r) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LineSegment 2 p r)
sr) ]
    sl :: Maybe (LineSegment 2 p r)
sl = StatusStructure p r -> Maybe (LineSegment 2 p r)
forall a. Set a -> Maybe a
SS.lookupMax StatusStructure p r
before
    sr :: Maybe (LineSegment 2 p r)
sr = StatusStructure p r -> Maybe (LineSegment 2 p r)
forall a. Set a -> Maybe a
SS.lookupMin StatusStructure p r
after
    ss' :: StatusStructure p r
ss' = StatusStructure p r
before StatusStructure p r -> StatusStructure p r -> StatusStructure p r
forall a. Set a -> Set a -> Set a
`SS.join` LineSegment 2 p r -> StatusStructure p r
forall a. a -> Set a
SS.singleton LineSegment 2 p r
l StatusStructure p r -> StatusStructure p r -> StatusStructure p r
forall a. Set a -> Set a -> Set a
`SS.join` StatusStructure p r
after

-- | split the status structure around p.
-- the result is (before,contains,after)
splitBeforeAfter      :: (Num r, Ord r)
                     => Point 2 r -> StatusStructure p r
                     -> (StatusStructure p r, [LineSegment 2 p r],StatusStructure p r)
splitBeforeAfter :: Point 2 r
-> StatusStructure p r
-> (StatusStructure p r, [LineSegment 2 p r], StatusStructure p r)
splitBeforeAfter Point 2 r
p StatusStructure p r
ss = (StatusStructure p r
before, (LineSegment 2 p r -> Bool)
-> [LineSegment 2 p r] -> [LineSegment 2 p r]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (LineSegment 2 p r -> Bool) -> LineSegment 2 p r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 r -> LineSegment 2 p r -> Bool
forall r p. Ord r => Point 2 r -> LineSegment 2 p r -> Bool
endsAt Point 2 r
p) ([LineSegment 2 p r] -> [LineSegment 2 p r])
-> [LineSegment 2 p r] -> [LineSegment 2 p r]
forall a b. (a -> b) -> a -> b
$ StatusStructure p r -> [LineSegment 2 p r]
forall a. Set a -> [a]
SS.toList StatusStructure p r
contains, StatusStructure p r
after)
  where
    (StatusStructure p r
before,StatusStructure p r
contains,StatusStructure p r
after) = (LineSegment 2 p r -> Ordering)
-> StatusStructure p r
-> (StatusStructure p r, StatusStructure p r, StatusStructure p r)
forall a. (a -> Ordering) -> Set a -> (Set a, Set a, Set a)
SS.splitBy LineSegment 2 p r -> Ordering
cmpLine StatusStructure p r
ss
    cmpLine :: LineSegment 2 p r -> Ordering
cmpLine LineSegment 2 p r
line
      | LineSegment 2 p r -> Bool
forall r p. Eq r => LineSegment 2 p r -> Bool
isHorizontal LineSegment 2 p r
line =
        let [Point 2 r
_top,Point 2 r
bot] = (Point 2 r -> Point 2 r -> Ordering) -> [Point 2 r] -> [Point 2 r]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy Point 2 r -> Point 2 r -> Ordering
forall r. Ord r => Point 2 r -> Point 2 r -> Ordering
ordPoints [LineSegment 2 p r
lineLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core,LineSegment 2 p r
lineLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core] in
        (Point 2 r
botPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord)
    cmpLine LineSegment 2 p r
line =
      let [Point 2 r
top,Point 2 r
bot] = (Point 2 r -> Point 2 r -> Ordering) -> [Point 2 r] -> [Point 2 r]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy Point 2 r -> Point 2 r -> Ordering
forall r. Ord r => Point 2 r -> Point 2 r -> Ordering
ordPoints [LineSegment 2 p r
lineLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core,LineSegment 2 p r
lineLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core] in
      case Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall r.
(Ord r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw Point 2 r
bot Point 2 r
top Point 2 r
p of
        CCW
CW       -> Ordering
LT
        CCW
CoLinear -> Ordering
EQ
        CCW
CCW      -> Ordering
GT


isHorizontal :: Eq r => LineSegment 2 p r -> Bool
isHorizontal :: LineSegment 2 p r -> Bool
isHorizontal LineSegment 2 p r
s  = LineSegment 2 p r
sLineSegment 2 p r -> Getting r (LineSegment 2 p r) r -> r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const r (Point 2 r :+ p))
-> LineSegment 2 p r -> Const r (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const r (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const r (LineSegment 2 p r))
-> ((r -> Const r r)
    -> (Point 2 r :+ p) -> Const r (Point 2 r :+ p))
-> Getting r (LineSegment 2 p r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const r (Point 2 r))
-> (Point 2 r :+ p) -> Const r (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point 2 r -> Const r (Point 2 r))
 -> (Point 2 r :+ p) -> Const r (Point 2 r :+ p))
-> ((r -> Const r r) -> Point 2 r -> Const r (Point 2 r))
-> (r -> Const r r)
-> (Point 2 r :+ p)
-> Const r (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> Point 2 r -> Const r (Point 2 r)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== LineSegment 2 p r
sLineSegment 2 p r -> Getting r (LineSegment 2 p r) r -> r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const r (Point 2 r :+ p))
-> LineSegment 2 p r -> Const r (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const r (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const r (LineSegment 2 p r))
-> ((r -> Const r r)
    -> (Point 2 r :+ p) -> Const r (Point 2 r :+ p))
-> Getting r (LineSegment 2 p r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const r (Point 2 r))
-> (Point 2 r :+ p) -> Const r (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point 2 r -> Const r (Point 2 r))
 -> (Point 2 r :+ p) -> Const r (Point 2 r :+ p))
-> ((r -> Const r r) -> Point 2 r -> Const r (Point 2 r))
-> (r -> Const r r)
-> (Point 2 r :+ p)
-> Const r (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> Point 2 r -> Const r (Point 2 r)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord

-- | Test if a segment ends at p
endsAt                     :: Ord r => Point 2 r -> LineSegment 2 p r -> Bool
endsAt :: Point 2 r -> LineSegment 2 p r -> Bool
endsAt Point 2 r
p (LineSegment EndPoint (Point 2 r :+ p)
_ EndPoint (Point 2 r :+ p)
b) = ((Point 2 r :+ p) -> Point 2 r)
-> EndPoint (Point 2 r :+ p) -> EndPoint (Point 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
-> (Point 2 r :+ p) -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) EndPoint (Point 2 r :+ p)
b EndPoint (Point 2 r) -> EndPoint (Point 2 r) -> Bool
forall a. Eq a => a -> a -> Bool
== Point 2 r -> EndPoint (Point 2 r)
forall a. a -> EndPoint a
Open Point 2 r
p

--------------------------------------------------------------------------------
-- * Finding New events

segmentsOverlap :: (Num r, Ord r) => LineSegment 2 p r -> LineSegment 2 p r -> Bool
segmentsOverlap :: LineSegment 2 p r -> LineSegment 2 p r -> Bool
segmentsOverlap a :: LineSegment 2 p r
a@(LineSegment EndPoint (Point 2 r :+ p)
aStart EndPoint (Point 2 r :+ p)
aEnd) LineSegment 2 p r
b =
    (EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
aStart Bool -> Bool -> Bool
&& (EndPoint (Point 2 r :+ p)
aStartEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r -> LineSegment 2 p r -> Bool
forall r p.
(Ord r, Num r) =>
Point 2 r -> LineSegment 2 p r -> Bool
`onSegment2` LineSegment 2 p r
b) Bool -> Bool -> Bool
||
    (EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
aEnd Bool -> Bool -> Bool
&& (EndPoint (Point 2 r :+ p)
aEndEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r -> LineSegment 2 p r -> Bool
forall r p.
(Ord r, Num r) =>
Point 2 r -> LineSegment 2 p r -> Bool
`onSegment2` LineSegment 2 p r
b) Bool -> Bool -> Bool
||
    (CCW -> CCW -> Bool
opposite ((Point 2 r :+ p) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' (LineSegment 2 p r
aLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start) (LineSegment 2 p r
bLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start) (LineSegment 2 p r
aLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end)) ((Point 2 r :+ p) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' (LineSegment 2 p r
aLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start) (LineSegment 2 p r
bLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end) (LineSegment 2 p r
aLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end)) Bool -> Bool -> Bool
&&
    Bool -> Bool
not (Point 2 r -> Triangle 2 p r -> Bool
forall r p. (Ord r, Num r) => Point 2 r -> Triangle 2 p r -> Bool
onTriangleRelaxed (LineSegment 2 p r
aLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Triangle 2 p r
t1) Bool -> Bool -> Bool
&&
    Bool -> Bool
not (Point 2 r -> Triangle 2 p r -> Bool
forall r p. (Ord r, Num r) => Point 2 r -> Triangle 2 p r -> Bool
onTriangleRelaxed (LineSegment 2 p r
aLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Triangle 2 p r
t2))
  where
    opposite :: CCW -> CCW -> Bool
opposite CCW
CW CCW
CCW = Bool
True
    opposite CCW
CCW CCW
CW = Bool
True
    opposite CCW
_ CCW
_    = Bool
False
    t1 :: Triangle 2 p r
t1 = (Point 2 r :+ p)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Triangle 2 p r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle (LineSegment 2 p r
aLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start) (LineSegment 2 p r
bLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start) (LineSegment 2 p r
bLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end)
    t2 :: Triangle 2 p r
t2 = (Point 2 r :+ p)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Triangle 2 p r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle (LineSegment 2 p r
aLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end) (LineSegment 2 p r
bLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start) (LineSegment 2 p r
bLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end)

-- Copied from Data.Geometry.LineSegment.Internal. Delete when PR#62 is merged.
onSegment2                          :: (Ord r, Num r)
                                    => Point 2 r -> LineSegment 2 p r -> Bool
Point 2 r
p onSegment2 :: Point 2 r -> LineSegment 2 p r -> Bool
`onSegment2` s :: LineSegment 2 p r
s@(LineSegment EndPoint (Point 2 r :+ p)
u EndPoint (Point 2 r :+ p)
v) = case (Point 2 r :+ ()) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
p) (EndPoint (Point 2 r :+ p)
uEndPoint (Point 2 r :+ p)
-> Getting
     (Point 2 r :+ p) (EndPoint (Point 2 r :+ p)) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ p) (EndPoint (Point 2 r :+ p)) (Point 2 r :+ p)
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint) (EndPoint (Point 2 r :+ p)
vEndPoint (Point 2 r :+ p)
-> Getting
     (Point 2 r :+ p) (EndPoint (Point 2 r :+ p)) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ p) (EndPoint (Point 2 r :+ p)) (Point 2 r :+ p)
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint) of
    CCW
CoLinear -> let su :: SideTest
su = Point 2 r
p Point 2 r -> Line 2 r -> SideTest
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> SideTest
`onSide` Line 2 r
lu
                    sv :: SideTest
sv = Point 2 r
p Point 2 r -> Line 2 r -> SideTest
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> SideTest
`onSide` Line 2 r
lv
                in SideTest
su SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
/= SideTest
sv
                Bool -> Bool -> Bool
&& ((SideTest
su SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
== SideTest
OnLine) Bool -> Bool -> Bool
`implies` EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
u)
                Bool -> Bool -> Bool
&& ((SideTest
sv SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
== SideTest
OnLine) Bool -> Bool -> Bool
`implies` EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
v)
    CCW
_        -> Bool
False
  where
    (Line Point 2 r
_ Vector 2 r
w) = Line 2 r -> Line 2 r
forall r. Num r => Line 2 r -> Line 2 r
perpendicularTo (Line 2 r -> Line 2 r) -> Line 2 r -> Line 2 r
forall a b. (a -> b) -> a -> b
$ LineSegment 2 p r
-> Line
     (Dimension (LineSegment 2 p r)) (NumType (LineSegment 2 p r))
forall t.
HasSupportingLine t =>
t -> Line (Dimension t) (NumType t)
supportingLine LineSegment 2 p r
s
    lu :: Line 2 r
lu = Point 2 r -> Vector 2 r -> Line 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line (EndPoint (Point 2 r :+ p)
uEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Vector 2 r
w
    lv :: Line 2 r
lv = Point 2 r -> Vector 2 r -> Line 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line (EndPoint (Point 2 r :+ p)
vEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Vector 2 r
w

    Bool
a implies :: Bool -> Bool -> Bool
`implies` Bool
b = Bool
b Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
a