{-# LANGUAGE DefaultSignatures #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Polygon.Simple.InPolygon
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Testing if a point lies in a polygon
--
--------------------------------------------------------------------------------
module HGeometry.Polygon.Simple.InPolygon
  ( HasInPolygon(..)
  , inSimplePolygon
  -- , insidePolygon
  -- , onBoundary
  , containedIn
  -- , AboveCount(..)
  ) where

import Control.Lens
import HGeometry.Boundary
import HGeometry.Intersection
import HGeometry.Interval
import HGeometry.LineSegment
import HGeometry.Point
import HGeometry.Polygon.Class
import HGeometry.Polygon.Simple.Class
import HGeometry.Properties

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

{- $setup
>>> import HGeometry.Polygon.Simple
>>> import qualified Data.List.NonEmpty as NonEmpty
>>> :{
let simplePoly :: SimplePolygon (Point 2 Int)
    simplePoly = uncheckedFromCCWPoints . NonEmpty.fromList $
                 [ Point2 0 0
                 , Point2 10 0
                 , Point2 10 10
                 , Point2 5 15
                 , Point2 1 11
                 ]
:}
-}



-- | Types that implement a point-in-polygon test.
class HasInPolygon polygon point r | polygon -> point, point -> r where
  -- | Check if a point lies inside a polygon, on the boundary, or outside of the
  -- polygon. If the point lies on the boundary we also return an edge e containing the
  -- point (identified by the vertex v so that e follows v in the CCW order along the
  -- boundary). No guarantees are given about which edge is returned if the query point
  -- lies on multiple edges (i.e. when it coincides with a vertex.)
  inPolygon :: ( Num r, Ord r, Point_ queryPoint 2 r)
            => queryPoint -> polygon -> PointLocationResultWith (VertexIx polygon)
  default inPolygon :: ( Num r, Ord r, Point_ point 2 r, Point_ queryPoint 2 r
                       , SimplePolygon_ polygon point r
                       )
                    => queryPoint -> polygon
                    -> PointLocationResultWith (VertexIx polygon)
  inPolygon = queryPoint -> polygon -> PointLocationResultWith (VertexIx polygon)
forall queryPoint simplePolygon point r.
(Num r, Ord r, Point_ point 2 r, Point_ queryPoint 2 r,
 SimplePolygon_ simplePolygon point r) =>
queryPoint
-> simplePolygon
-> PointLocationResultWith (VertexIx simplePolygon)
inSimplePolygon


-- instance HasInPolygon (Triangle vertex) vertex r where
--   q `inPolygon` tri =


    -- (Triangle u v w)



--------------------------------------------------------------------------------
-- * The Implementation

-- simpleTriangle :: SimplePolygon (Point 2 Int)
-- simpleTriangle = uncheckedFromCCWPoints . NonEmpty.fromList $ [ Point2 0 0, Point2 2 0, Point2 1 1]
-- test = Point2 1 1 `inPolygon` simplePoly

data AboveCount seg = OnEdge !seg
                    | NumStrictlyAbove {-# UNPACK #-} !Int
                    deriving (Int -> AboveCount seg -> ShowS
[AboveCount seg] -> ShowS
AboveCount seg -> String
(Int -> AboveCount seg -> ShowS)
-> (AboveCount seg -> String)
-> ([AboveCount seg] -> ShowS)
-> Show (AboveCount seg)
forall seg. Show seg => Int -> AboveCount seg -> ShowS
forall seg. Show seg => [AboveCount seg] -> ShowS
forall seg. Show seg => AboveCount seg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall seg. Show seg => Int -> AboveCount seg -> ShowS
showsPrec :: Int -> AboveCount seg -> ShowS
$cshow :: forall seg. Show seg => AboveCount seg -> String
show :: AboveCount seg -> String
$cshowList :: forall seg. Show seg => [AboveCount seg] -> ShowS
showList :: [AboveCount seg] -> ShowS
Show,AboveCount seg -> AboveCount seg -> Bool
(AboveCount seg -> AboveCount seg -> Bool)
-> (AboveCount seg -> AboveCount seg -> Bool)
-> Eq (AboveCount seg)
forall seg. Eq seg => AboveCount seg -> AboveCount seg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall seg. Eq seg => AboveCount seg -> AboveCount seg -> Bool
== :: AboveCount seg -> AboveCount seg -> Bool
$c/= :: forall seg. Eq seg => AboveCount seg -> AboveCount seg -> Bool
/= :: AboveCount seg -> AboveCount seg -> Bool
Eq)

instance Semigroup (AboveCount seg) where
  l :: AboveCount seg
l@(OnEdge seg
_)         <> :: AboveCount seg -> AboveCount seg -> AboveCount seg
<> AboveCount seg
_                    = AboveCount seg
l -- ^ prefers the first segment
  AboveCount seg
_                    <> r :: AboveCount seg
r@(OnEdge seg
_)         = AboveCount seg
r -- ^ already found a boundary
  (NumStrictlyAbove Int
l) <> (NumStrictlyAbove Int
r) = Int -> AboveCount seg
forall seg. Int -> AboveCount seg
NumStrictlyAbove (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
r)

instance Monoid (AboveCount seg) where
  mempty :: AboveCount seg
mempty = Int -> AboveCount seg
forall seg. Int -> AboveCount seg
NumStrictlyAbove Int
0







-- rename the thing below to InSimplePolygon?

-- | Check if a point lies inside a polygon, on the boundary, or
-- outside of the polygon. If the point lies on the boundary we also
-- return an edge e containing the point (identified by the vertex v
-- so that e follows v in the CCW order along the boundary). No
-- guarantees are given about which edge is returned if the query
-- point lies on multiple edges (i.e. when it coincides with a
-- vertex.)
--
--
-- Running time: O(n).
--
-- >>> Point2 1 1 `inPolygon` simplePoly
-- StrictlyInside
-- >>> Point2 0 0 `inPolygon` simplePoly
-- OnBoundaryEdge 0
-- >>> Point2 10 0 `inPolygon` simplePoly
-- OnBoundaryEdge 1
-- >>> Point2 5 13 `inPolygon` simplePoly
-- StrictlyInside
-- >>> Point2 5 10 `inPolygon` simplePoly
-- StrictlyInside
-- >>> Point2 10 5 `inPolygon` simplePoly
-- OnBoundaryEdge 1
-- >>> Point2 20 5 `inPolygon` simplePoly
-- StrictlyOutside
inSimplePolygon        :: forall queryPoint simplePolygon point r.
                          ( Num r, Ord r, Point_ point 2 r, Point_ queryPoint 2 r
                          , SimplePolygon_ simplePolygon point r
                          )
                       => queryPoint -> simplePolygon
                       -> PointLocationResultWith (VertexIx simplePolygon)
queryPoint
q inSimplePolygon :: forall queryPoint simplePolygon point r.
(Num r, Ord r, Point_ point 2 r, Point_ queryPoint 2 r,
 SimplePolygon_ simplePolygon point r) =>
queryPoint
-> simplePolygon
-> PointLocationResultWith (VertexIx simplePolygon)
`inSimplePolygon` simplePolygon
pg = case IndexedGetting
  (Int, (Int, Int))
  (AboveCount Int)
  simplePolygon
  (point, (point, point))
-> ((Int, (Int, Int)) -> (point, (point, point)) -> AboveCount Int)
-> simplePolygon
-> AboveCount Int
forall i m s a. IndexedGetting i m s a -> (i -> a -> m) -> s -> m
ifoldMapOf IndexedGetting
  (Int, (Int, Int))
  (AboveCount Int)
  simplePolygon
  (point, (point, point))
Indexed
  (Int, (Int, Int))
  (Vertex simplePolygon,
   (Vertex simplePolygon, Vertex simplePolygon))
  (Const
     (AboveCount Int)
     (Vertex simplePolygon,
      (Vertex simplePolygon, Vertex simplePolygon)))
-> simplePolygon -> Const (AboveCount Int) simplePolygon
forall polygon.
(HasOuterBoundary polygon, VertexIx polygon ~ Int) =>
IndexedFold1
  (VertexIx polygon, (VertexIx polygon, VertexIx polygon))
  polygon
  (Vertex polygon, (Vertex polygon, Vertex polygon))
IndexedFold1
  (VertexIx simplePolygon,
   (VertexIx simplePolygon, VertexIx simplePolygon))
  simplePolygon
  (Vertex simplePolygon,
   (Vertex simplePolygon, Vertex simplePolygon))
outerBoundaryWithNeighbours (Int, (Int, Int)) -> (point, (point, point)) -> AboveCount Int
countAbove simplePolygon
pg of
                            OnEdge Int
s                       -> Int -> PointLocationResultWith Int
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge Int
s
                            NumStrictlyAbove Int
m | Int -> Bool
forall a. Integral a => a -> Bool
odd Int
m     -> PointLocationResultWith Int
PointLocationResultWith (VertexIx simplePolygon)
forall edge. PointLocationResultWith edge
StrictlyInside
                                               | Bool
otherwise -> PointLocationResultWith Int
PointLocationResultWith (VertexIx simplePolygon)
forall edge. PointLocationResultWith edge
StrictlyOutside
  where
    -- we count the number of by the vertical upward ray from q intersects the boundary of
    -- the polygon. If the number of times we intersect the boundary is odd we are inside,
    -- and outside othwerise.
    --
    --
    -- Generally, countAbove will compute the contribution of the edge uv (which is edge i).
    --
    --
    -- we have to take special care of vertical edges, and when the ray goes through a
    -- vertex u.
    countAbove :: (Int, (Int, Int)) -> (point, (point, point)) -> AboveCount Int
countAbove (Int
i,(Int, Int)
_) (point
u,(point
p,point
v)) = case (point
upoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
xCoord) of
      Ordering
LT | (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
xCoord) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< (point
vpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) -> Int -> point -> point -> AboveCount Int
belowLineSeg Int
i point
u point
v
         -- for q to lie below the edge, v has to lie right of q and q has to actually lie
         -- below the line segment.
         --
         -- Note that if q lies strictly below v we don't count it here. We handle it
         -- when handing vertex v
         | Bool
otherwise                 -> AboveCount Int
forall a. Monoid a => a
mempty

      Ordering
GT | (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
xCoord) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> (point
vpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) -> Int -> point -> point -> AboveCount Int
belowLineSeg Int
i point
v point
u
            -- for q to lie below the edge, v has to lie left of q and
            -- q has to actually lie below the line through u and v.
         | Bool
otherwise                 -> AboveCount Int
forall a. Monoid a => a
mempty


      Ordering
EQ -> case (point
upoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
yCoord) of
              Ordering
EQ                             -> Int -> AboveCount Int
forall seg. seg -> AboveCount seg
OnEdge Int
i
                -- q == u, so it lies on edge i

              Ordering
LT | (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
xCoord) r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== (point
vpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) Bool -> Bool -> Bool
&&
                   (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
yCoord) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< (point
vpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) -> Int -> AboveCount Int
forall seg. seg -> AboveCount seg
OnEdge Int
i
                 -- q lies above u. So the only case in which q does lie on the edge uv
                 -- is if it is vertical, and q lies on it.
                 | Bool
otherwise                 -> AboveCount Int
forall a. Monoid a => a
mempty
                 -- q lies above u, so otherwise it does not lie on the edge starting at u.

              Ordering
GT -> case (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
xCoord) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (point
vpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) of
                Ordering
EQ | (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
yCoord) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> (point
vpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) -> Int -> AboveCount Int
forall seg. seg -> AboveCount seg
OnEdge Int
i
                   | Bool
otherwise                 -> AboveCount Int
forall a. Monoid a => a
mempty
                   -- the edge uv is vertical. We already established that u lies above
                   -- q, so it lies on the edge only if v lies strictly below q.

                Ordering
LT | queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
xCoord r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord -> AboveCount Int
forall a. Monoid a => a
mempty
                   -- the predecessor vertex p and v lie on the same side of the vertical line
                   -- through u. So we don't count this vertex/edge
                   -- TODO: not sure if this should be <= or <
                   | Bool
otherwise              -> Int -> point -> point -> AboveCount Int
belowLineSeg Int
i point
u point
v
                Ordering
GT | queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
xCoord r -> r -> Bool
forall a. Ord a => a -> a -> Bool
>= point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord -> AboveCount Int
forall a. Monoid a => a
mempty -- same as before v and p on the same side.
                   | Bool
otherwise              -> Int -> point -> point -> AboveCount Int
belowLineSeg Int
i point
v point
u

    -- | count the edge if q is below the line through l and r,
    --
    -- pre: l is left of r.
    -- pre: q-x lies in the interval [lx,rx]
    belowLineSeg :: Int -> point -> point -> AboveCount Int
belowLineSeg Int
i point
l point
r = case point -> queryPoint -> point -> 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 point
l queryPoint
q point
r of
      CCW
CW       -> AboveCount Int
forall a. Monoid a => a
mempty -- q lies strictly above the segment lr
      CCW
CoLinear -> Int -> AboveCount Int
forall seg. seg -> AboveCount seg
OnEdge Int
i
      CCW
CCW      -> Int -> AboveCount Int
forall seg. Int -> AboveCount seg
NumStrictlyAbove Int
1  -- q lies strictly below the segment lr


--------------------------------------------------------------------------------
-- * Test if a segment is contained in a polygon

-- | test if the given line segment is contained in the polygon. It is also ok if the
-- segment lies partially on the boundary
containedIn :: ( ClosedLineSegment_ lineSegment point
               , SimplePolygon_ simplePolygon vertex r
               , Intersection (ClosedLineSegment vertex) lineSegment
                 ~ Maybe (LineSegmentLineSegmentIntersection lineSegment')
               , IsIntersectableWith (ClosedLineSegment vertex) lineSegment
               , NumType lineSegment' ~ r
               , HasInPolygon simplePolygon vertex r
               , Point_ point 2 r, Point_ vertex 2 r, Ord r, Fractional r
               ) => lineSegment -> simplePolygon -> Bool
containedIn :: forall lineSegment point simplePolygon vertex r lineSegment'.
(ClosedLineSegment_ lineSegment point,
 SimplePolygon_ simplePolygon vertex r,
 Intersection (ClosedLineSegment vertex) lineSegment
 ~ Maybe (LineSegmentLineSegmentIntersection lineSegment'),
 IsIntersectableWith (ClosedLineSegment vertex) lineSegment,
 NumType lineSegment' ~ r, HasInPolygon simplePolygon vertex r,
 Point_ point 2 r, Point_ vertex 2 r, Ord r, Fractional r) =>
lineSegment -> simplePolygon -> Bool
containedIn lineSegment
seg simplePolygon
poly = case (lineSegment
seglineSegment -> 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) point
-> simplePolygon
-> PointLocationResultWith (VertexIx simplePolygon)
forall queryPoint.
(Num r, Ord r, Point_ queryPoint 2 r) =>
queryPoint
-> simplePolygon
-> PointLocationResultWith (VertexIx simplePolygon)
forall polygon point r queryPoint.
(HasInPolygon polygon point r, Num r, Ord r,
 Point_ queryPoint 2 r) =>
queryPoint -> polygon -> PointLocationResultWith (VertexIx polygon)
`inPolygon` simplePolygon
poly of
    PointLocationResultWith (VertexIx simplePolygon)
StrictlyInside    -> case (lineSegment
seglineSegment -> 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) point
-> simplePolygon
-> PointLocationResultWith (VertexIx simplePolygon)
forall queryPoint.
(Num r, Ord r, Point_ queryPoint 2 r) =>
queryPoint
-> simplePolygon
-> PointLocationResultWith (VertexIx simplePolygon)
forall polygon point r queryPoint.
(HasInPolygon polygon point r, Num r, Ord r,
 Point_ queryPoint 2 r) =>
queryPoint -> polygon -> PointLocationResultWith (VertexIx polygon)
`inPolygon` simplePolygon
poly of
                           PointLocationResultWith (VertexIx simplePolygon)
StrictlyInside    -> Bool -> Bool
not Bool
properIntersection
                           PointLocationResultWith (VertexIx simplePolygon)
StrictlyOutside   -> Bool
False
                           OnBoundaryEdge VertexIx simplePolygon
vj -> Bool -> Bool
not Bool
properIntersection Bool -> Bool -> Bool
&& Int -> point -> Bool
inCone' Int
VertexIx simplePolygon
vj (lineSegment
seglineSegment -> 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)
    PointLocationResultWith (VertexIx simplePolygon)
StrictlyOutside   -> Bool
False
    OnBoundaryEdge VertexIx simplePolygon
vi -> case (lineSegment
seglineSegment -> 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) point
-> simplePolygon
-> PointLocationResultWith (VertexIx simplePolygon)
forall queryPoint.
(Num r, Ord r, Point_ queryPoint 2 r) =>
queryPoint
-> simplePolygon
-> PointLocationResultWith (VertexIx simplePolygon)
forall polygon point r queryPoint.
(HasInPolygon polygon point r, Num r, Ord r,
 Point_ queryPoint 2 r) =>
queryPoint -> polygon -> PointLocationResultWith (VertexIx polygon)
`inPolygon` simplePolygon
poly of
                           PointLocationResultWith (VertexIx simplePolygon)
StrictlyInside    -> Bool -> Bool
not Bool
properIntersection
                           PointLocationResultWith (VertexIx simplePolygon)
StrictlyOutside   -> Bool
False
                           OnBoundaryEdge VertexIx simplePolygon
vj -> Bool -> Bool
not Bool
properIntersection
                                                Bool -> Bool -> Bool
&& Int -> point -> Bool
inCone' Int
VertexIx simplePolygon
vi (lineSegment
seglineSegment -> 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)
                                                Bool -> Bool -> Bool
&& Int -> point -> Bool
inCone' Int
VertexIx simplePolygon
vj (lineSegment
seglineSegment -> 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)
  where
    properIntersection :: Bool
properIntersection = Getting Any simplePolygon (ClosedLineSegment vertex)
-> (ClosedLineSegment vertex -> Bool) -> simplePolygon -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Getting Any simplePolygon (ClosedLineSegment vertex)
forall polygon point r.
(HasOuterBoundary polygon, Vertex polygon ~ point,
 Point_ point 2 r) =>
IndexedFold1
  (VertexIx polygon, VertexIx polygon)
  polygon
  (ClosedLineSegment point)
IndexedFold1
  (VertexIx simplePolygon, VertexIx simplePolygon)
  simplePolygon
  (ClosedLineSegment vertex)
outerBoundaryEdgeSegments (\ClosedLineSegment vertex
edgeSeg ->
                           case ClosedLineSegment vertex
edgeSeg ClosedLineSegment vertex
-> lineSegment
-> Intersection (ClosedLineSegment vertex) lineSegment
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` lineSegment
seg of
                             Just (LineSegment_x_LineSegment_Point Point 2 (NumType lineSegment')
p) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
                               Point 2 r
Point 2 (NumType lineSegment')
p Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
/= (ClosedLineSegment vertex
edgeSegClosedLineSegment vertex
-> Getting (Point 2 r) (ClosedLineSegment vertex) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(vertex -> Const (Point 2 r) vertex)
-> ClosedLineSegment vertex
-> Const (Point 2 r) (ClosedLineSegment vertex)
forall seg p. HasStart seg p => Lens' seg p
Lens' (ClosedLineSegment vertex) vertex
start((vertex -> Const (Point 2 r) vertex)
 -> ClosedLineSegment vertex
 -> Const (Point 2 r) (ClosedLineSegment vertex))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> vertex -> Const (Point 2 r) vertex)
-> Getting (Point 2 r) (ClosedLineSegment vertex) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> vertex -> Const (Point 2 r) vertex
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' vertex (Point 2 r)
asPoint) Bool -> Bool -> Bool
|| Point 2 r
Point 2 (NumType lineSegment')
p Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
/= (ClosedLineSegment vertex
edgeSegClosedLineSegment vertex
-> Getting (Point 2 r) (ClosedLineSegment vertex) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(vertex -> Const (Point 2 r) vertex)
-> ClosedLineSegment vertex
-> Const (Point 2 r) (ClosedLineSegment vertex)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (ClosedLineSegment vertex) vertex
end((vertex -> Const (Point 2 r) vertex)
 -> ClosedLineSegment vertex
 -> Const (Point 2 r) (ClosedLineSegment vertex))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> vertex -> Const (Point 2 r) vertex)
-> Getting (Point 2 r) (ClosedLineSegment vertex) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> vertex -> Const (Point 2 r) vertex
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' vertex (Point 2 r)
asPoint)
                             Just LineSegmentLineSegmentIntersection lineSegment'
_                                   -> Bool
False
                             Maybe (LineSegmentLineSegmentIntersection lineSegment')
Intersection (ClosedLineSegment vertex) lineSegment
Nothing                                  -> Bool
False
                                                         ) simplePolygon
poly
    inCone' :: Int -> point -> Bool
inCone' Int
i point
q = let a :: vertex
a = simplePolygon
polysimplePolygon
-> Getting (Endo vertex) simplePolygon vertex -> vertex
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!VertexIx simplePolygon
-> IndexedTraversal'
     (VertexIx simplePolygon) simplePolygon (Vertex simplePolygon)
forall graph.
HasVertices' graph =>
VertexIx graph
-> IndexedTraversal' (VertexIx graph) graph (Vertex graph)
vertexAt Int
VertexIx simplePolygon
i
                      p :: vertex
p = simplePolygon
polysimplePolygon
-> Getting (Endo vertex) simplePolygon vertex -> vertex
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!VertexIx simplePolygon
-> IndexedTraversal'
     (VertexIx simplePolygon) simplePolygon (Vertex simplePolygon)
forall graph.
HasVertices' graph =>
VertexIx graph
-> IndexedTraversal' (VertexIx graph) graph (Vertex graph)
vertexAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                      n :: vertex
n = simplePolygon
polysimplePolygon
-> Getting (Endo vertex) simplePolygon vertex -> vertex
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!VertexIx simplePolygon
-> IndexedTraversal'
     (VertexIx simplePolygon) simplePolygon (Vertex simplePolygon)
forall graph.
HasVertices' graph =>
VertexIx graph
-> IndexedTraversal' (VertexIx graph) graph (Vertex graph)
vertexAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                  in point -> vertex -> vertex -> vertex -> Bool
forall queryPoint r apex point point'.
(Point_ queryPoint 2 r, Point_ apex 2 r, Point_ point 2 r,
 Point_ point' 2 r, Ord r, Num r) =>
queryPoint -> apex -> point -> point' -> Bool
inCone point
q vertex
a vertex
p vertex
n

-- | Test if a point lies inside a cone.
inCone           :: ( Point_ queryPoint 2 r, Point_ apex 2 r, Point_ point 2 r, Point_ point' 2 r
                    , Ord r, Num r
                    ) =>
                    queryPoint -> apex -> point -> point' -> Bool
inCone :: forall queryPoint r apex point point'.
(Point_ queryPoint 2 r, Point_ apex 2 r, Point_ point 2 r,
 Point_ point' 2 r, Ord r, Num r) =>
queryPoint -> apex -> point -> point' -> Bool
inCone queryPoint
q apex
a point
l point'
r = case Vector 2 r -> apex -> Point 2 r -> Point 2 r -> Ordering
forall center r point.
(Point_ center 2 r, Point_ point 2 r, Ord r, Num r) =>
Vector 2 r -> center -> point -> point -> Ordering
cwCmpAroundWith ((point
lpoint -> 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 -> Vector 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. (apex
aapex -> Getting (Point 2 r) apex (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) apex (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' apex (Point 2 r)
asPoint)) apex
a (queryPoint
qqueryPoint
-> Getting (Point 2 r) queryPoint (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) queryPoint (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' queryPoint (Point 2 r)
asPoint) (point'
rpoint' -> 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) of
                   Ordering
GT -> Bool
False
                   Ordering
_  -> Bool
True

  -- case ccw a l q of
  --                  CCW -> False
  --                  _   -> case ccw a r q of
  --                           CW -> False
  --                           _  -> True

-- it seems we cannot define the cmpCCwAroundwith with flip; since now the zero vector is actually treated last. i.e. they are not inverses.