{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# OPTIONS_GHC -Wno-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Polygon.Simple
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A Simple polygon and some basic functions to interact with them.
--
--------------------------------------------------------------------------------
module HGeometry.Polygon.Simple
  ( SimplePolygon_(..)
  , SimplePolygon
  , SimplePolygonF(..)
  , toCyclic
  , VertexContainer
  , HasInPolygon(..)
  , inSimplePolygon
  , containedIn
  , hasNoSelfIntersections
  , module HGeometry.Polygon.Simple.Class
  ) where

import HGeometry.Ext
import Control.Lens
import Data.Foldable qualified as F
import Data.Foldable1
import Data.List.NonEmpty (NonEmpty(..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import HGeometry.Boundary
import HGeometry.Cyclic
import HGeometry.Foldable.Util
import HGeometry.HalfSpace
import HGeometry.HyperPlane.Class
import HGeometry.Intersection
import HGeometry.LineSegment.Intersection.BentleyOttmann
import HGeometry.Point
import HGeometry.Line
import HGeometry.Polygon.Class
import HGeometry.Polygon.Simple.Class
import HGeometry.Polygon.Simple.Implementation
import HGeometry.Polygon.Simple.InPolygon
import HGeometry.Polygon.Simple.Type
import HGeometry.Transformation
import HGeometry.Vector.NonEmpty.Util ()
--------------------------------------------------------------------------------


-- instance VertexContainer f point => HasEdges' (SimplePolygonF f point) where
--   -- ^ An edge (v_i,v_{i+1})
--   type Edge   (SimplePolygonF f point) = (point, point)
--    -- ^ every edge (v_i,v_{i+1}) is identified by (the index of) its preceding vertex v_i
--   type EdgeIx (SimplePolygonF f point) = Int
--   edgeAt i = \pEfE pg -> indexed pEfE i (pg^?!vertexAt i, pg^?!vertexAt (succ i))
--                          <&> \(u',v') -> pg&vertexAt i        .~ u'
--                                            &vertexAt (succ i) .~ v'
--     -- we first just run the function pEfE on the particular edge in question,
--     -- we get some updated vertices out of this; which we then update appropriately.
--   {-# INLINE edgeAt #-}
--   numEdges = numVertices

-- instance VertexContainer f point
--        => HasEdges (SimplePolygonF f point) (SimplePolygonF f point) where
--   -- ^ Warning for when using this as a traversal: when applying the function on an edge
--   -- (v_i,v_{i+1}) that modifies vertex v_{i+1}, this modification is discarded.
--   edges = \pEfE pg -> let pvFv i v = fst <$> indexed pEfE i (v, pg^?!vertexAt (succ i))
--                       in vertices pvFv pg
--
-- I've uncommented these for now; since the above behaviour would be inconsistent between
-- edgeAt (which would modify both vertices), and edges, which would modify only one vertex.
-- that is a bit too weird.

instance ( VertexContainer f point
         ) => HasOuterBoundary (SimplePolygonF f point) where
  outerBoundary :: IndexedTraversal1'
  (VertexIx (SimplePolygonF f point))
  (SimplePolygonF f point)
  (Vertex (SimplePolygonF f point))
outerBoundary = (f point -> f (f point))
-> SimplePolygonF f point -> f (SimplePolygonF f point)
forall {k1} {k2} (f1 :: k1 -> *) (point :: k1) (f' :: k2 -> *)
       (point' :: k2) (p :: * -> * -> *) (f2 :: * -> *).
(Profunctor p, Functor f2) =>
p (f1 point) (f2 (f' point'))
-> p (SimplePolygonF f1 point) (f2 (SimplePolygonF f' point'))
_SimplePolygonF ((f point -> f (f point))
 -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> (p point (f point) -> f point -> f (f point))
-> p point (f point)
-> SimplePolygonF f point
-> f (SimplePolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p point (f point) -> f point -> f (f point)
forall (f :: * -> *) a b.
Traversable1 f =>
IndexedTraversal1 Int (f a) (f b) a b
IndexedTraversal1 Int (f point) (f point) point point
traversed1
  outerBoundaryVertexAt :: VertexIx (SimplePolygonF f point)
-> IndexedGetter
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
outerBoundaryVertexAt VertexIx (SimplePolygonF f point)
i = Traversing
  p f (SimplePolygonF f point) (SimplePolygonF f point) point point
-> Over
     p f (SimplePolygonF f point) (SimplePolygonF f point) point point
forall (p :: * -> * -> *) (f :: * -> *) s t a.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a a -> Over p f s t a a
singular (VertexIx (SimplePolygonF f point)
-> IndexedTraversal'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
forall graph.
HasVertices' graph =>
VertexIx graph
-> IndexedTraversal' (VertexIx graph) graph (Vertex graph)
vertexAt VertexIx (SimplePolygonF f point)
i)

  ccwOuterBoundaryFrom :: VertexIx (SimplePolygonF f point)
-> IndexedTraversal1'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
ccwOuterBoundaryFrom VertexIx (SimplePolygonF f point)
i = (f point -> f (f point))
-> SimplePolygonF f point -> f (SimplePolygonF f point)
forall {k1} {k2} (f1 :: k1 -> *) (point :: k1) (f' :: k2 -> *)
       (point' :: k2) (p :: * -> * -> *) (f2 :: * -> *).
(Profunctor p, Functor f2) =>
p (f1 point) (f2 (f' point'))
-> p (SimplePolygonF f1 point) (f2 (SimplePolygonF f' point'))
_SimplePolygonF((f point -> f (f point))
 -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> (p point (f point) -> f point -> f (f point))
-> p point (f point)
-> SimplePolygonF f point
-> f (SimplePolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (f point)
-> IndexedTraversal1' (Index (f point)) (f point) point
forall a. Index (f a) -> IndexedTraversal1' (Index (f a)) (f a) a
forall (v :: * -> *) a.
HasDirectedTraversals v =>
Index (v a) -> IndexedTraversal1' (Index (v a)) (v a) a
traverseRightFrom VertexIx (SimplePolygonF f point)
Index (f point)
i
  cwOuterBoundaryFrom :: VertexIx (SimplePolygonF f point)
-> IndexedTraversal1'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
cwOuterBoundaryFrom  VertexIx (SimplePolygonF f point)
i = (f point -> f (f point))
-> SimplePolygonF f point -> f (SimplePolygonF f point)
forall {k1} {k2} (f1 :: k1 -> *) (point :: k1) (f' :: k2 -> *)
       (point' :: k2) (p :: * -> * -> *) (f2 :: * -> *).
(Profunctor p, Functor f2) =>
p (f1 point) (f2 (f' point'))
-> p (SimplePolygonF f1 point) (f2 (SimplePolygonF f' point'))
_SimplePolygonF((f point -> f (f point))
 -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> (p point (f point) -> f point -> f (f point))
-> p point (f point)
-> SimplePolygonF f point
-> f (SimplePolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (f point)
-> IndexedTraversal1' (Index (f point)) (f point) point
forall a. Index (f a) -> IndexedTraversal1' (Index (f a)) (f a) a
forall (v :: * -> *) a.
HasDirectedTraversals v =>
Index (v a) -> IndexedTraversal1' (Index (v a)) (v a) a
traverseLeftFrom  VertexIx (SimplePolygonF f point)
Index (f point)
i

instance HasHoles (SimplePolygonF f point)

instance ( Point_ point 2 r
         , HasFromFoldable1 f
         , VertexContainer f point
         ) => Polygon_ (SimplePolygonF f point) point r where

  ccwPredecessorOf :: VertexIx (SimplePolygonF f point)
-> IndexedLens'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
ccwPredecessorOf VertexIx (SimplePolygonF f point)
u = \p (Vertex (SimplePolygonF f point))
  (f (Vertex (SimplePolygonF f point)))
pvFv SimplePolygonF f point
pg -> let n :: Int
n = SimplePolygonF f point -> Int
forall graph. HasVertices' graph => graph -> Int
numVertices SimplePolygonF f point
pg
                                       p :: Int
p = (Int -> Int
forall a. Enum a => a -> a
pred Int
VertexIx (SimplePolygonF f point)
u) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n
                                       l :: Over
  p f (SimplePolygonF f point) (SimplePolygonF f point) point point
l = Traversing
  p f (SimplePolygonF f point) (SimplePolygonF f point) point point
-> Over
     p f (SimplePolygonF f point) (SimplePolygonF f point) point point
forall (p :: * -> * -> *) (f :: * -> *) s t a.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a a -> Over p f s t a a
singular (Traversing
   p f (SimplePolygonF f point) (SimplePolygonF f point) point point
 -> Over
      p f (SimplePolygonF f point) (SimplePolygonF f point) point point)
-> Traversing
     p f (SimplePolygonF f point) (SimplePolygonF f point) point point
-> Over
     p f (SimplePolygonF f point) (SimplePolygonF f point) point point
forall a b. (a -> b) -> a -> b
$ VertexIx (SimplePolygonF f point)
-> IndexedTraversal'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
forall graph.
HasVertices' graph =>
VertexIx graph
-> IndexedTraversal' (VertexIx graph) graph (Vertex graph)
vertexAt Int
VertexIx (SimplePolygonF f point)
p
                                   in Over
  p f (SimplePolygonF f point) (SimplePolygonF f point) point point
l p point (f point)
p (Vertex (SimplePolygonF f point))
  (f (Vertex (SimplePolygonF f point)))
pvFv SimplePolygonF f point
pg
  -- make sure to wrap the index to make sure we report the right index.
  ccwSuccessorOf :: VertexIx (SimplePolygonF f point)
-> IndexedLens'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
ccwSuccessorOf   VertexIx (SimplePolygonF f point)
u = \p (Vertex (SimplePolygonF f point))
  (f (Vertex (SimplePolygonF f point)))
pvFv SimplePolygonF f point
pg -> let n :: Int
n = SimplePolygonF f point -> Int
forall graph. HasVertices' graph => graph -> Int
numVertices SimplePolygonF f point
pg
                                       s :: Int
s = (Int -> Int
forall a. Enum a => a -> a
succ Int
VertexIx (SimplePolygonF f point)
u) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n
                                       l :: Over
  p f (SimplePolygonF f point) (SimplePolygonF f point) point point
l = Traversing
  p f (SimplePolygonF f point) (SimplePolygonF f point) point point
-> Over
     p f (SimplePolygonF f point) (SimplePolygonF f point) point point
forall (p :: * -> * -> *) (f :: * -> *) s t a.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a a -> Over p f s t a a
singular (Traversing
   p f (SimplePolygonF f point) (SimplePolygonF f point) point point
 -> Over
      p f (SimplePolygonF f point) (SimplePolygonF f point) point point)
-> Traversing
     p f (SimplePolygonF f point) (SimplePolygonF f point) point point
-> Over
     p f (SimplePolygonF f point) (SimplePolygonF f point) point point
forall a b. (a -> b) -> a -> b
$ VertexIx (SimplePolygonF f point)
-> IndexedTraversal'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
forall graph.
HasVertices' graph =>
VertexIx graph
-> IndexedTraversal' (VertexIx graph) graph (Vertex graph)
vertexAt Int
VertexIx (SimplePolygonF f point)
s
                                   in Over
  p f (SimplePolygonF f point) (SimplePolygonF f point) point point
l p point (f point)
p (Vertex (SimplePolygonF f point))
  (f (Vertex (SimplePolygonF f point)))
pvFv SimplePolygonF f point
pg

instance ( Point_ point 2 r
         , VertexContainer f point
         , HasFromFoldable1 f
         ) => SimplePolygon_ (SimplePolygonF f point) point r where
  uncheckedFromCCWPoints :: forall (f :: * -> *).
Foldable1 f =>
f point -> SimplePolygonF f point
uncheckedFromCCWPoints = f point -> SimplePolygonF f point
forall {k} (f :: k -> *) (point :: k).
f point -> SimplePolygonF f point
MkSimplePolygon (f point -> SimplePolygonF f point)
-> (f point -> f point) -> f point -> SimplePolygonF f point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f point -> f point
forall (f :: * -> *) (g :: * -> *) a.
(HasFromFoldable1 f, Foldable1 g) =>
g a -> f a
forall (g :: * -> *) a. Foldable1 g => g a -> f a
fromFoldable1

  fromPoints :: forall (f :: * -> *).
(Foldable f,
 ConstructableSimplePolygon (SimplePolygonF f point) point r) =>
f point -> Maybe (SimplePolygonF f point)
fromPoints f point
rawPts = do pts@(_:|_:_:_) <- NonEmpty point -> NonEmpty point
forall point r.
(Point_ point 2 r, Eq r) =>
NonEmpty point -> NonEmpty point
removeRepeated (NonEmpty point -> NonEmpty point)
-> Maybe (NonEmpty point) -> Maybe (NonEmpty point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f point -> Maybe (NonEmpty point)
forall {a}. f a -> Maybe (NonEmpty a)
toNonEmpty' f point
rawPts
                         -- note that the pattern match makes sure there are at least 3 pts
                         let pg    = NonEmpty point -> SimplePolygonF f point
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f point -> SimplePolygonF f point
uncheckedFromCCWPoints NonEmpty point
pts
                             area' = SimplePolygonF f point -> r
forall r simplePolygon point.
(Num r, HasOuterBoundary simplePolygon, Point_ point 2 r,
 Vertex simplePolygon ~ point) =>
simplePolygon -> r
signedArea2X SimplePolygonF f point
pg
                             pg'   = NonEmpty point -> SimplePolygonF f point
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f point -> SimplePolygonF f point
uncheckedFromCCWPoints (NonEmpty point -> SimplePolygonF f point)
-> NonEmpty point -> SimplePolygonF f point
forall a b. (a -> b) -> a -> b
$ NonEmpty point -> NonEmpty point
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse NonEmpty point
pts
                         case area' of
                           r
0                      -> Maybe (SimplePolygonF f point)
forall a. Maybe a
Nothing -- the points are all colinear
                           r
_ | r
area' r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r -> r
forall a. Num a => a -> a
abs r
area' -> SimplePolygonF f point -> Maybe (SimplePolygonF f point)
forall a. a -> Maybe a
Just SimplePolygonF f point
pg -- the points are given in CCW order
                             | Bool
otherwise          -> SimplePolygonF f point -> Maybe (SimplePolygonF f point)
forall a. a -> Maybe a
Just SimplePolygonF f point
pg'
                             -- pts were in CW order, so we reversed them.
    where
      toNonEmpty' :: f a -> Maybe (NonEmpty a)
toNonEmpty' = [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([a] -> Maybe (NonEmpty a))
-> (f a -> [a]) -> f a -> Maybe (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

  -- TODO: verify that:
  --      no self intersections, and

-- -- | Make sure that we have at least three points
-- requireThree     :: NonEmpty point -> Maybe (NonEmpty point)
-- requireThree pts = case pts of
--     (_ :| (_ : _ : _)) -> Just pts
--     _                  -> Nothing


-- | Makes sure there are no repeated vertices.
--
-- note that we treat f as a cyclic sequence
removeRepeated    :: (Point_ point 2 r, Eq r)
                  => NonEmpty point -> NonEmpty point
removeRepeated :: forall point r.
(Point_ point 2 r, Eq r) =>
NonEmpty point -> NonEmpty point
removeRepeated = (point, NonEmpty point) -> NonEmpty point
forall {s} {s}.
(Dimension s ~ Dimension s, NumType s ~ NumType s,
 Eq (Vector (Dimension s) (NumType s)),
 Point_ s (Dimension s) (NumType s),
 Point_ s (Dimension s) (NumType s)) =>
(s, NonEmpty s) -> NonEmpty s
checkFirst
               ((point, NonEmpty point) -> NonEmpty point)
-> (NonEmpty point -> (point, NonEmpty point))
-> NonEmpty point
-> NonEmpty point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty point -> (point, NonEmpty point))
-> (NonEmpty point
    -> (point, NonEmpty point) -> (point, NonEmpty point))
-> NonEmpty (NonEmpty point)
-> (point, NonEmpty point)
forall a b. (a -> b) -> (a -> b -> b) -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 (\(point
l :| [point]
_)         -> (point
l, point -> NonEmpty point
forall a. a -> NonEmpty a
NonEmpty.singleton point
l))
                           (\(point
x :| [point]
_) (point
l,NonEmpty point
acc) -> (point
l, point
x point -> NonEmpty point -> NonEmpty point
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.<| NonEmpty point
acc))
               (NonEmpty (NonEmpty point) -> (point, NonEmpty point))
-> (NonEmpty point -> NonEmpty (NonEmpty point))
-> NonEmpty point
-> (point, NonEmpty point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (point -> Point 2 r) -> NonEmpty point -> NonEmpty (NonEmpty point)
forall b a. Eq b => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)
NonEmpty.groupWith1 (point -> 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)
  where
    -- make sure that the first and last element are also distinct
    checkFirst :: (s, NonEmpty s) -> NonEmpty s
checkFirst (s
last', acc :: NonEmpty s
acc@(s
first' :| [s]
rest')) = case [s] -> Maybe (NonEmpty s)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [s]
rest' of
      Maybe (NonEmpty s)
Nothing                                           -> NonEmpty s
acc
        -- Apparently there is only one element, (first' == last')
      Just NonEmpty s
rest | (s
first's
-> Getting
     (Point (Dimension s) (NumType s))
     s
     (Point (Dimension s) (NumType s))
-> Point (Dimension s) (NumType s)
forall s a. s -> Getting a s a -> a
^.Getting
  (Point (Dimension s) (NumType s))
  s
  (Point (Dimension s) (NumType s))
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' s (Point (Dimension s) (NumType s))
asPoint) Point (Dimension s) (NumType s)
-> Point (Dimension s) (NumType s) -> Bool
forall a. Eq a => a -> a -> Bool
== (s
last's
-> Getting
     (Point (Dimension s) (NumType s))
     s
     (Point (Dimension s) (NumType s))
-> Point (Dimension s) (NumType s)
forall s a. s -> Getting a s a -> a
^.Getting
  (Point (Dimension s) (NumType s))
  s
  (Point (Dimension s) (NumType s))
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' s (Point (Dimension s) (NumType s))
asPoint) -> NonEmpty s
rest
                  -- in this case the first elem of rest is distinct from first' (due to
                  -- the groupwith), and and thus distinct from the last of the rest
                | Bool
otherwise                             -> NonEmpty s
acc


instance ( Show point
         , SimplePolygon_ (SimplePolygonF f point) point r
         ) => Show (SimplePolygonF f point) where
  showsPrec :: Int -> SimplePolygonF f point -> ShowS
showsPrec = String -> Int -> SimplePolygonF f point -> ShowS
forall simplePolygon point r.
(SimplePolygon_ simplePolygon point r, Show point) =>
String -> Int -> simplePolygon -> ShowS
showsPrecSimplePolygon String
"SimplePolygon"

instance ( Read point
         , SimplePolygon_ (SimplePolygonF f point) point r
         ) => Read (SimplePolygonF f point) where
  readsPrec :: Int -> ReadS (SimplePolygonF f point)
readsPrec = String -> Int -> ReadS (SimplePolygonF f point)
forall simplePolygon point r.
(Read point, SimplePolygon_ simplePolygon point r) =>
String -> Int -> ReadS simplePolygon
readsPrecSimplePolygon String
"SimplePolygon"


{-
instance (SimplePolygon_ (SimplePolygonF f) point r, Fractional r, Ord r)
         => HasSquaredEuclideanDistance (SimplePolygonF f point) where
  pointClosestToWithDistance = pointClosestToWithDistanceSimplePolygon
-}


instance ( VertexContainer nonEmpty vertex, HasFromFoldable1 nonEmpty, Point_ vertex 2 r
         , Fractional r
         ) => HasPickPoint (SimplePolygonF nonEmpty vertex) r where
  pointInteriorTo :: SimplePolygonF nonEmpty vertex -> Point 2 r
pointInteriorTo = SimplePolygonF nonEmpty vertex -> Point 2 r
forall point'.
(Fractional r, ConstructablePoint_ point' 2 r) =>
SimplePolygonF nonEmpty vertex -> point'
forall simplePolygon point r point'.
(SimplePolygon_ simplePolygon point r, Fractional r,
 ConstructablePoint_ point' 2 r) =>
simplePolygon -> point'
centroid

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

_testPoly :: SimplePolygon (Point 2 Int)
_testPoly :: SimplePolygon (Point 2 Int)
_testPoly = NonEmpty (Point 2 Int) -> SimplePolygon (Point 2 Int)
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (Point 2 Int) -> SimplePolygon (Point 2 Int)
uncheckedFromCCWPoints (NonEmpty (Point 2 Int) -> SimplePolygon (Point 2 Int))
-> NonEmpty (Point 2 Int) -> SimplePolygon (Point 2 Int)
forall a b. (a -> b) -> a -> b
$ [Point 2 Int] -> NonEmpty (Point 2 Int)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList [Int -> Int -> Point 2 Int
forall r. r -> r -> Point 2 r
Point2 Int
10 Int
20, Point 2 Int
forall point (d :: Nat) r.
(Num r, ConstructablePoint_ point d r) =>
point
origin, Int -> Int -> Point 2 Int
forall r. r -> r -> Point 2 r
Point2 Int
0 Int
100]


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

instance SimplePolygon_ (SimplePolygonF f point) point r
         => HasInPolygon (SimplePolygonF f point) point r

instance ( SimplePolygon_ (SimplePolygonF f point) point r
         , Num r, Ord r
         ) => HasIntersectionWith (Point 2 r) (SimplePolygonF f point) where
  Point 2 r
q intersects :: Point 2 r -> SimplePolygonF f point -> Bool
`intersects` SimplePolygonF f point
pg = Point 2 r
q Point 2 r
-> SimplePolygonF f point
-> PointLocationResultWith (VertexIx (SimplePolygonF f point))
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` SimplePolygonF f point
pg PointLocationResultWith Int -> PointLocationResultWith Int -> Bool
forall a. Eq a => a -> a -> Bool
/= PointLocationResultWith Int
forall edge. PointLocationResultWith edge
StrictlyOutside

type instance Intersection (Point 2 r) (SimplePolygonF f point) = Maybe (Point 2 r)

instance ( SimplePolygon_ (SimplePolygonF f point) point r
         , Num r, Ord r
         ) => IsIntersectableWith (Point 2 r) (SimplePolygonF f point) where
  Point 2 r
q intersect :: Point 2 r
-> SimplePolygonF f point
-> Intersection (Point 2 r) (SimplePolygonF f point)
`intersect` SimplePolygonF f point
pg | Point 2 r
q Point 2 r -> SimplePolygonF f point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` SimplePolygonF f point
pg = Point 2 r -> Maybe (Point 2 r)
forall a. a -> Maybe a
Just Point 2 r
q
                   | Bool
otherwise         = Maybe (Point 2 r)
Intersection (Point 2 r) (SimplePolygonF f point)
forall a. Maybe a
Nothing
  -- this implementation is a bit silly but ok

instance ( VertexContainer f point
         , DefaultTransformByConstraints (SimplePolygonF f point) 2 r
         , Point_ point 2 r
         , IsTransformable point
         , HasFromFoldable1 f, Eq r
         ) => IsTransformable (SimplePolygonF f point) where
  transformBy :: Transformation
  (Dimension (SimplePolygonF f point))
  (NumType (SimplePolygonF f point))
-> SimplePolygonF f point -> SimplePolygonF f point
transformBy Transformation
  (Dimension (SimplePolygonF f point))
  (NumType (SimplePolygonF f point))
t = SimplePolygonF f point
-> Maybe (SimplePolygonF f point) -> SimplePolygonF f point
forall a. a -> Maybe a -> a
fromMaybe SimplePolygonF f point
forall {a}. a
err (Maybe (SimplePolygonF f point) -> SimplePolygonF f point)
-> (SimplePolygonF f point -> Maybe (SimplePolygonF f point))
-> SimplePolygonF f point
-> SimplePolygonF f point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f point -> Maybe (SimplePolygonF f point)
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable f,
 ConstructableSimplePolygon simplePolygon point r) =>
f point -> Maybe simplePolygon
forall (f :: * -> *).
(Foldable f,
 ConstructableSimplePolygon (SimplePolygonF f point) point r) =>
f point -> Maybe (SimplePolygonF f point)
fromPoints (f point -> Maybe (SimplePolygonF f point))
-> (SimplePolygonF f point -> f point)
-> SimplePolygonF f point
-> Maybe (SimplePolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (point -> point) -> f point -> f point
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Transformation (Dimension point) (NumType point) -> point -> point
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy Transformation (Dimension point) (NumType point)
Transformation
  (Dimension (SimplePolygonF f point))
  (NumType (SimplePolygonF f point))
t) (f point -> f point)
-> (SimplePolygonF f point -> f point)
-> SimplePolygonF f point
-> f point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (f point) (SimplePolygonF f point) (f point)
-> SimplePolygonF f point -> f point
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (f point) (SimplePolygonF f point) (f point)
forall {k1} {k2} (f1 :: k1 -> *) (point :: k1) (f' :: k2 -> *)
       (point' :: k2) (p :: * -> * -> *) (f2 :: * -> *).
(Profunctor p, Functor f2) =>
p (f1 point) (f2 (f' point'))
-> p (SimplePolygonF f1 point) (f2 (SimplePolygonF f' point'))
_SimplePolygonF
    where
      err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"SimplePolygonF; transformBy: no longer a simple polygon!"
  -- Note that we use fromPoints again, since the transformation may
  -- e.g. reorient the vertices; e.g. when they were given CCW before, they may now
  -- end up CW. This was actually an issue before when reading the worled file.

instance ( Point_ point 2 r, Num r, Ord r, VertexContainer f point
         , HyperPlane_ line 2 r
         ) => HasIntersectionWith (HalfSpaceF line) (SimplePolygonF f point) where
  HalfSpaceF line
halfPlane intersects :: HalfSpaceF line -> SimplePolygonF f point -> Bool
`intersects` SimplePolygonF f point
poly = Getting Any (SimplePolygonF f point) (Point 2 r)
-> (Point 2 r -> Bool) -> SimplePolygonF f point -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((point -> Const Any point)
-> SimplePolygonF f point -> Const Any (SimplePolygonF f point)
(Vertex (SimplePolygonF f point)
 -> Const Any (Vertex (SimplePolygonF f point)))
-> SimplePolygonF f point -> Const Any (SimplePolygonF f point)
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (SimplePolygonF f point))
  (SimplePolygonF f point)
  (SimplePolygonF f point)
  (Vertex (SimplePolygonF f point))
  (Vertex (SimplePolygonF f point))
vertices((point -> Const Any point)
 -> SimplePolygonF f point -> Const Any (SimplePolygonF f point))
-> ((Point 2 r -> Const Any (Point 2 r))
    -> point -> Const Any point)
-> Getting Any (SimplePolygonF f point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const Any (Point 2 r)) -> point -> Const Any point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) (Point 2 r -> HalfSpaceF line -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfSpaceF line
halfPlane) SimplePolygonF f point
poly


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

instance ( Num r, Ord r
         , SimplePolygon_ (SimplePolygonF nonEmpty vertex) vertex r
         )
         => LinePV 2 r `HasIntersectionWith` SimplePolygonF nonEmpty vertex where
  LinePV 2 r
l intersects :: LinePV 2 r -> SimplePolygonF nonEmpty vertex -> Bool
`intersects` SimplePolygonF nonEmpty vertex
poly = case (vertex -> LinePV 2 r -> SideTest
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> SideTest
onSide vertex
p LinePV 2 r
l, vertex -> LinePV 2 r -> SideTest
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> SideTest
onSide vertex
q LinePV 2 r
l) of
                          (SideTest
OnLine, SideTest
_) -> Bool
True
                          (SideTest
_, SideTest
OnLine) -> Bool
True
                          (SideTest
sp, SideTest
sq)    -> SideTest
sp SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
/= SideTest
sq
    where
      (vertex
p,vertex
q) = Vector 2 r -> SimplePolygonF nonEmpty vertex -> (vertex, vertex)
forall polygon point r.
(Polygon_ polygon point r, Num r, Ord r, Point_ point 2 r) =>
Vector 2 r -> polygon -> (point, point)
extremes (LinePV 2 r -> LinePV 2 r
forall r. Num r => LinePV 2 r -> LinePV 2 r
perpendicularTo LinePV 2 r
l LinePV 2 r
-> Getting (Vector 2 r) (LinePV 2 r) (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^. Getting (Vector 2 r) (LinePV 2 r) (Vector 2 r)
forall (d :: Nat) r.
(Dimension (LinePV 2 r) ~ d, NumType (LinePV 2 r) ~ r) =>
Lens' (LinePV 2 r) (Vector d r)
forall t (d :: Nat) r.
(HasDirection t, Dimension t ~ d, NumType t ~ r) =>
Lens' t (Vector d r)
Lens' (LinePV 2 r) (Vector 2 r)
direction) SimplePolygonF nonEmpty vertex
poly


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

-- | verify that some sequence of points has no self intersecting edges.
hasNoSelfIntersections    :: forall f point r.
                             (Foldable1 f, Functor f, Point_ point 2 r, Ord r, Real r)
                          => f point -> Bool
hasNoSelfIntersections :: forall (f :: * -> *) point r.
(Foldable1 f, Functor f, Point_ point 2 r, Ord r, Real r) =>
f point -> Bool
hasNoSelfIntersections f point
vs = let vs' :: f (PointF (Vector 2 Rational))
vs' = (\point
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)Point 2 r
-> (Point 2 r -> PointF (Vector 2 Rational))
-> PointF (Vector 2 Rational)
forall a b. a -> (a -> b) -> b
&(r -> Identity Rational)
-> Point 2 r -> Identity (PointF (Vector 2 Rational))
(NumType (Point 2 r)
 -> Identity (NumType (PointF (Vector 2 Rational))))
-> Point 2 r -> Identity (PointF (Vector 2 Rational))
forall point point'.
HasCoordinates point point' =>
IndexedTraversal1 Int point point' (NumType point) (NumType point')
IndexedTraversal1
  Int
  (Point 2 r)
  (PointF (Vector 2 Rational))
  (NumType (Point 2 r))
  (NumType (PointF (Vector 2 Rational)))
coordinates ((r -> Identity Rational)
 -> Point 2 r -> Identity (PointF (Vector 2 Rational)))
-> (r -> Rational) -> Point 2 r -> PointF (Vector 2 Rational)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ r -> Rational
forall a. Real a => a -> Rational
toRational) (point -> PointF (Vector 2 Rational))
-> f point -> f (PointF (Vector 2 Rational))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f point
vs
                                pg :: SimplePolygon (Point 2 Rational)
                                pg :: SimplePolygon (PointF (Vector 2 Rational))
pg = f (PointF (Vector 2 Rational))
-> SimplePolygon (PointF (Vector 2 Rational))
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (PointF (Vector 2 Rational))
-> SimplePolygon (PointF (Vector 2 Rational))
uncheckedFromCCWPoints f (PointF (Vector 2 Rational))
vs'
                            in Map
  (PointF (Vector 2 Rational))
  (Associated (ClosedLineSegment (PointF (Vector 2 Rational))))
-> Bool
forall k a. Map k a -> Bool
Map.null (Map
   (PointF (Vector 2 Rational))
   (Associated (ClosedLineSegment (PointF (Vector 2 Rational))))
 -> Bool)
-> Map
     (PointF (Vector 2 Rational))
     (Associated (ClosedLineSegment (PointF (Vector 2 Rational))))
-> Bool
forall a b. (a -> b) -> a -> b
$ [ClosedLineSegment (PointF (Vector 2 Rational))]
-> Map
     (PointF (Vector 2 Rational))
     (Associated (ClosedLineSegment (PointF (Vector 2 Rational))))
forall lineSegment point r seg (f :: * -> *).
(LineSegment_ lineSegment point, Point_ point 2 r, Eq lineSegment,
 Ord r, Fractional r, IntersectConstraints seg lineSegment,
 LineSegment_ seg point,
 StartPointOf lineSegment ~ EndPointOf lineSegment,
 HasOnSegment lineSegment 2, Foldable f, Functor f) =>
f lineSegment -> Intersections r lineSegment
interiorIntersections ([ClosedLineSegment (PointF (Vector 2 Rational))]
 -> Map
      (PointF (Vector 2 Rational))
      (Associated (ClosedLineSegment (PointF (Vector 2 Rational)))))
-> [ClosedLineSegment (PointF (Vector 2 Rational))]
-> Map
     (PointF (Vector 2 Rational))
     (Associated (ClosedLineSegment (PointF (Vector 2 Rational))))
forall a b. (a -> b) -> a -> b
$ SimplePolygon (PointF (Vector 2 Rational))
pgSimplePolygon (PointF (Vector 2 Rational))
-> Getting
     (Endo [ClosedLineSegment (PointF (Vector 2 Rational))])
     (SimplePolygon (PointF (Vector 2 Rational)))
     (ClosedLineSegment (PointF (Vector 2 Rational)))
-> [ClosedLineSegment (PointF (Vector 2 Rational))]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting
  (Endo [ClosedLineSegment (PointF (Vector 2 Rational))])
  (SimplePolygon (PointF (Vector 2 Rational)))
  (ClosedLineSegment (PointF (Vector 2 Rational)))
forall polygon point r.
(HasOuterBoundary polygon, Vertex polygon ~ point,
 Point_ point 2 r) =>
IndexedFold1
  (VertexIx polygon, VertexIx polygon)
  polygon
  (ClosedLineSegment point)
IndexedFold1
  (VertexIx (SimplePolygon (PointF (Vector 2 Rational))),
   VertexIx (SimplePolygon (PointF (Vector 2 Rational))))
  (SimplePolygon (PointF (Vector 2 Rational)))
  (ClosedLineSegment (PointF (Vector 2 Rational)))
outerBoundaryEdgeSegments
  -- outerBoundaryEdgeSegments interiorIntersections pg



--------------------------------------------------------------------------------
-- * Instances involving Ext

instance HasIntersectionWith geom (SimplePolygonF f vertex)
         => HasIntersectionWith geom (SimplePolygonF f vertex :+ extra) where
  geom
q intersects :: geom -> (SimplePolygonF f vertex :+ extra) -> Bool
`intersects` (SimplePolygonF f vertex
pg :+ extra
_) = geom
q geom -> SimplePolygonF f vertex -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` SimplePolygonF f vertex
pg