{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Polygon.Core
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A Polygon data type and some basic functions to interact with them.
--
--------------------------------------------------------------------------------
module Data.Geometry.Polygon.Core
  ( PolygonType(..)
  , Polygon(..)
  , Vertices
  , _SimplePolygon, _MultiPolygon
  , SimplePolygon, MultiPolygon, SomePolygon

    -- * Construction
  , fromPoints
  , fromCircularVector

  , simpleFromPoints
  , simpleFromCircularVector

  , unsafeFromPoints
  , unsafeFromCircularVector
  , unsafeFromVector
  , toVector
  , toPoints

  , isSimple

  , size
  , polygonVertices, listEdges

  , outerBoundary, outerBoundaryVector
  , unsafeOuterBoundaryVector
  , outerBoundaryEdges
  , outerVertex, unsafeOuterVertex
  , outerBoundaryEdge

  , polygonHoles, polygonHoles'
  , holeList

  , area, signedArea

  , centroid
  , pickPoint

  , isTriangle

  , isCounterClockwise
  , toCounterClockWiseOrder, toCounterClockWiseOrder'
  , toClockwiseOrder, toClockwiseOrder'
  , reverseOuterBoundary

  , findDiagonal

  , withIncidentEdges, numberVertices

  -- * Testing for Reflex or Convex

  , isReflexVertex, isConvexVertex, isStrictlyConvexVertex
  , reflexVertices, convexVertices, strictlyConvexVertices

    -- * Specialized folds
  , maximumVertexBy
  , minimumVertexBy
  , findRotateTo
  , rotateLeft
  , rotateRight
  ) where

import qualified Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann as BO
import           Control.DeepSeq
import           Control.Lens                                               (Getter, Lens', Prism',
                                                                             Traversal', lens, over,
                                                                             prism', to, toListOf,
                                                                             view, (%~), (&), (.~),
                                                                             (^.))
import           Data.Aeson
import           Data.Bifoldable
import           Data.Bifunctor
import           Data.Bitraversable
import           Data.Ext
import qualified Data.Foldable                                              as F
import           Data.Geometry.Boundary
import           Data.Geometry.Box                                          (IsBoxable (..),
                                                                             boundingBoxList')
import           Data.Geometry.Line
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.Transformation
import           Data.Geometry.Triangle                                     (Triangle (..),
                                                                             inTriangle)
import           Data.Geometry.Vector                                       (Additive (zero, (^+^)),
                                                                             Affine ((.+^), (.-.)),
                                                                             (*^), (^*), (^/))
import qualified Data.List                                                  as List
import qualified Data.List.NonEmpty                                         as NonEmpty
import           Data.Maybe                                                 (catMaybes)
import           Data.Ord                                                   (comparing)
import           Data.Semigroup                                             (sconcat)
import           Data.Semigroup.Foldable
import           Data.Util
import           Data.Vector                                                (Vector)
import qualified Data.Vector                                                as V
import           Data.Vector.Circular                                       (CircularVector)
import qualified Data.Vector.Circular                                       as CV
import qualified Data.Vector.Circular.Util                                  as CV


-- import Data.RealNumber.Rational

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

{- $setup
>>> import Data.RealNumber.Rational
>>> import Data.Foldable
>>> import Control.Lens.Extras
>>> :{
-- import qualified Data.Vector.Circular as CV
let simplePoly :: SimplePolygon () (RealNumber 10)
    simplePoly = fromPoints . map ext $
      [ Point2 0 0
      , Point2 10 0
      , Point2 10 10
      , Point2 5 15
      , Point2 1 11
      ]
    simpleTriangle :: SimplePolygon () (RealNumber 10)
    simpleTriangle = fromPoints  . map ext $
      [ Point2 0 0, Point2 2 0, Point2 1 1]
    multiPoly :: MultiPolygon () (RealNumber 10)
    multiPoly = MultiPolygon
      (fromPoints . map ext $ [Point2 (-1) (-1), Point2 3 (-1), Point2 2 2])
      [simpleTriangle]
:} -}

-- | We distinguish between simple polygons (without holes) and polygons with holes.
data PolygonType = Simple | Multi

-- | Polygons are sequences of points and may or may not contain holes.
--
--   Degenerate polygons (polygons with self-intersections or fewer than 3 points)
--   are only possible if you use functions marked as unsafe.
data Polygon (t :: PolygonType) p r where
  SimplePolygon :: Vertices (Point 2 r :+ p)                -> SimplePolygon p r
  MultiPolygon  :: SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon  p r

newtype Vertices a = Vertices (CircularVector a)
  deriving (a -> Vertices b -> Vertices a
(a -> b) -> Vertices a -> Vertices b
(forall a b. (a -> b) -> Vertices a -> Vertices b)
-> (forall a b. a -> Vertices b -> Vertices a) -> Functor Vertices
forall a b. a -> Vertices b -> Vertices a
forall a b. (a -> b) -> Vertices a -> Vertices b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Vertices b -> Vertices a
$c<$ :: forall a b. a -> Vertices b -> Vertices a
fmap :: (a -> b) -> Vertices a -> Vertices b
$cfmap :: forall a b. (a -> b) -> Vertices a -> Vertices b
Functor, a -> Vertices a -> Bool
Vertices m -> m
Vertices a -> [a]
Vertices a -> Bool
Vertices a -> Int
Vertices a -> a
Vertices a -> a
Vertices a -> a
Vertices a -> a
(a -> m) -> Vertices a -> m
(a -> m) -> Vertices a -> m
(a -> b -> b) -> b -> Vertices a -> b
(a -> b -> b) -> b -> Vertices a -> b
(b -> a -> b) -> b -> Vertices a -> b
(b -> a -> b) -> b -> Vertices a -> b
(a -> a -> a) -> Vertices a -> a
(a -> a -> a) -> Vertices a -> a
(forall m. Monoid m => Vertices m -> m)
-> (forall m a. Monoid m => (a -> m) -> Vertices a -> m)
-> (forall m a. Monoid m => (a -> m) -> Vertices a -> m)
-> (forall a b. (a -> b -> b) -> b -> Vertices a -> b)
-> (forall a b. (a -> b -> b) -> b -> Vertices a -> b)
-> (forall b a. (b -> a -> b) -> b -> Vertices a -> b)
-> (forall b a. (b -> a -> b) -> b -> Vertices a -> b)
-> (forall a. (a -> a -> a) -> Vertices a -> a)
-> (forall a. (a -> a -> a) -> Vertices a -> a)
-> (forall a. Vertices a -> [a])
-> (forall a. Vertices a -> Bool)
-> (forall a. Vertices a -> Int)
-> (forall a. Eq a => a -> Vertices a -> Bool)
-> (forall a. Ord a => Vertices a -> a)
-> (forall a. Ord a => Vertices a -> a)
-> (forall a. Num a => Vertices a -> a)
-> (forall a. Num a => Vertices a -> a)
-> Foldable Vertices
forall a. Eq a => a -> Vertices a -> Bool
forall a. Num a => Vertices a -> a
forall a. Ord a => Vertices a -> a
forall m. Monoid m => Vertices m -> m
forall a. Vertices a -> Bool
forall a. Vertices a -> Int
forall a. Vertices a -> [a]
forall a. (a -> a -> a) -> Vertices a -> a
forall m a. Monoid m => (a -> m) -> Vertices a -> m
forall b a. (b -> a -> b) -> b -> Vertices a -> b
forall a b. (a -> b -> b) -> b -> Vertices a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Vertices a -> a
$cproduct :: forall a. Num a => Vertices a -> a
sum :: Vertices a -> a
$csum :: forall a. Num a => Vertices a -> a
minimum :: Vertices a -> a
$cminimum :: forall a. Ord a => Vertices a -> a
maximum :: Vertices a -> a
$cmaximum :: forall a. Ord a => Vertices a -> a
elem :: a -> Vertices a -> Bool
$celem :: forall a. Eq a => a -> Vertices a -> Bool
length :: Vertices a -> Int
$clength :: forall a. Vertices a -> Int
null :: Vertices a -> Bool
$cnull :: forall a. Vertices a -> Bool
toList :: Vertices a -> [a]
$ctoList :: forall a. Vertices a -> [a]
foldl1 :: (a -> a -> a) -> Vertices a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Vertices a -> a
foldr1 :: (a -> a -> a) -> Vertices a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Vertices a -> a
foldl' :: (b -> a -> b) -> b -> Vertices a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Vertices a -> b
foldl :: (b -> a -> b) -> b -> Vertices a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Vertices a -> b
foldr' :: (a -> b -> b) -> b -> Vertices a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Vertices a -> b
foldr :: (a -> b -> b) -> b -> Vertices a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Vertices a -> b
foldMap' :: (a -> m) -> Vertices a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Vertices a -> m
foldMap :: (a -> m) -> Vertices a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Vertices a -> m
fold :: Vertices m -> m
$cfold :: forall m. Monoid m => Vertices m -> m
Foldable, Foldable Vertices
Foldable Vertices
-> (forall m. Semigroup m => Vertices m -> m)
-> (forall m a. Semigroup m => (a -> m) -> Vertices a -> m)
-> (forall a. Vertices a -> NonEmpty a)
-> Foldable1 Vertices
Vertices m -> m
Vertices a -> NonEmpty a
(a -> m) -> Vertices a -> m
forall m. Semigroup m => Vertices m -> m
forall a. Vertices a -> NonEmpty a
forall m a. Semigroup m => (a -> m) -> Vertices a -> m
forall (t :: * -> *).
Foldable t
-> (forall m. Semigroup m => t m -> m)
-> (forall m a. Semigroup m => (a -> m) -> t a -> m)
-> (forall a. t a -> NonEmpty a)
-> Foldable1 t
toNonEmpty :: Vertices a -> NonEmpty a
$ctoNonEmpty :: forall a. Vertices a -> NonEmpty a
foldMap1 :: (a -> m) -> Vertices a -> m
$cfoldMap1 :: forall m a. Semigroup m => (a -> m) -> Vertices a -> m
fold1 :: Vertices m -> m
$cfold1 :: forall m. Semigroup m => Vertices m -> m
$cp1Foldable1 :: Foldable Vertices
Foldable1, Functor Vertices
Foldable Vertices
Functor Vertices
-> Foldable Vertices
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Vertices a -> f (Vertices b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Vertices (f a) -> f (Vertices a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Vertices a -> m (Vertices b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Vertices (m a) -> m (Vertices a))
-> Traversable Vertices
(a -> f b) -> Vertices a -> f (Vertices b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Vertices (m a) -> m (Vertices a)
forall (f :: * -> *) a.
Applicative f =>
Vertices (f a) -> f (Vertices a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vertices a -> m (Vertices b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vertices a -> f (Vertices b)
sequence :: Vertices (m a) -> m (Vertices a)
$csequence :: forall (m :: * -> *) a. Monad m => Vertices (m a) -> m (Vertices a)
mapM :: (a -> m b) -> Vertices a -> m (Vertices b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vertices a -> m (Vertices b)
sequenceA :: Vertices (f a) -> f (Vertices a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Vertices (f a) -> f (Vertices a)
traverse :: (a -> f b) -> Vertices a -> f (Vertices b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vertices a -> f (Vertices b)
$cp2Traversable :: Foldable Vertices
$cp1Traversable :: Functor Vertices
Traversable, Vertices a -> ()
(Vertices a -> ()) -> NFData (Vertices a)
forall a. NFData a => Vertices a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Vertices a -> ()
$crnf :: forall a. NFData a => Vertices a -> ()
NFData, Vertices a -> Vertices a -> Bool
(Vertices a -> Vertices a -> Bool)
-> (Vertices a -> Vertices a -> Bool) -> Eq (Vertices a)
forall a. Eq a => Vertices a -> Vertices a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertices a -> Vertices a -> Bool
$c/= :: forall a. Eq a => Vertices a -> Vertices a -> Bool
== :: Vertices a -> Vertices a -> Bool
$c== :: forall a. Eq a => Vertices a -> Vertices a -> Bool
Eq, Eq (Vertices a)
Eq (Vertices a)
-> (Vertices a -> Vertices a -> Ordering)
-> (Vertices a -> Vertices a -> Bool)
-> (Vertices a -> Vertices a -> Bool)
-> (Vertices a -> Vertices a -> Bool)
-> (Vertices a -> Vertices a -> Bool)
-> (Vertices a -> Vertices a -> Vertices a)
-> (Vertices a -> Vertices a -> Vertices a)
-> Ord (Vertices a)
Vertices a -> Vertices a -> Bool
Vertices a -> Vertices a -> Ordering
Vertices a -> Vertices a -> Vertices a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Vertices a)
forall a. Ord a => Vertices a -> Vertices a -> Bool
forall a. Ord a => Vertices a -> Vertices a -> Ordering
forall a. Ord a => Vertices a -> Vertices a -> Vertices a
min :: Vertices a -> Vertices a -> Vertices a
$cmin :: forall a. Ord a => Vertices a -> Vertices a -> Vertices a
max :: Vertices a -> Vertices a -> Vertices a
$cmax :: forall a. Ord a => Vertices a -> Vertices a -> Vertices a
>= :: Vertices a -> Vertices a -> Bool
$c>= :: forall a. Ord a => Vertices a -> Vertices a -> Bool
> :: Vertices a -> Vertices a -> Bool
$c> :: forall a. Ord a => Vertices a -> Vertices a -> Bool
<= :: Vertices a -> Vertices a -> Bool
$c<= :: forall a. Ord a => Vertices a -> Vertices a -> Bool
< :: Vertices a -> Vertices a -> Bool
$c< :: forall a. Ord a => Vertices a -> Vertices a -> Bool
compare :: Vertices a -> Vertices a -> Ordering
$ccompare :: forall a. Ord a => Vertices a -> Vertices a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Vertices a)
Ord)

-- | Prism to 'test' if we are a simple polygon
--
-- >>> is _SimplePolygon simplePoly
-- True
_SimplePolygon :: Prism' (Polygon Simple p r) (Vertices (Point 2 r :+ p))
_SimplePolygon :: p (Vertices (Point 2 r :+ p)) (f (Vertices (Point 2 r :+ p)))
-> p (Polygon 'Simple p r) (f (Polygon 'Simple p r))
_SimplePolygon = (Vertices (Point 2 r :+ p) -> Polygon 'Simple p r)
-> (Polygon 'Simple p r -> Maybe (Vertices (Point 2 r :+ p)))
-> Prism
     (Polygon 'Simple p r)
     (Polygon 'Simple p r)
     (Vertices (Point 2 r :+ p))
     (Vertices (Point 2 r :+ p))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Vertices (Point 2 r :+ p) -> Polygon 'Simple p r
forall r p. Vertices (Point 2 r :+ p) -> SimplePolygon p r
SimplePolygon (\(SimplePolygon Vertices (Point 2 r :+ p)
vs) -> Vertices (Point 2 r :+ p) -> Maybe (Vertices (Point 2 r :+ p))
forall a. a -> Maybe a
Just Vertices (Point 2 r :+ p)
vs)

-- | Prism to 'test' if we are a Multi polygon
--
-- >>> is _MultiPolygon multiPoly
-- True
_MultiPolygon :: Prism' (Polygon Multi p r) (Polygon Simple p r, [Polygon Simple p r])
_MultiPolygon :: p (Polygon 'Simple p r, [Polygon 'Simple p r])
  (f (Polygon 'Simple p r, [Polygon 'Simple p r]))
-> p (Polygon 'Multi p r) (f (Polygon 'Multi p r))
_MultiPolygon = ((Polygon 'Simple p r, [Polygon 'Simple p r])
 -> Polygon 'Multi p r)
-> (Polygon 'Multi p r
    -> Maybe (Polygon 'Simple p r, [Polygon 'Simple p r]))
-> Prism
     (Polygon 'Multi p r)
     (Polygon 'Multi p r)
     (Polygon 'Simple p r, [Polygon 'Simple p r])
     (Polygon 'Simple p r, [Polygon 'Simple p r])
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((Polygon 'Simple p r
 -> [Polygon 'Simple p r] -> Polygon 'Multi p r)
-> (Polygon 'Simple p r, [Polygon 'Simple p r])
-> Polygon 'Multi p r
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Polygon 'Simple p r -> [Polygon 'Simple p r] -> Polygon 'Multi p r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon) (\(MultiPolygon Polygon 'Simple p r
vs [Polygon 'Simple p r]
hs) -> (Polygon 'Simple p r, [Polygon 'Simple p r])
-> Maybe (Polygon 'Simple p r, [Polygon 'Simple p r])
forall a. a -> Maybe a
Just (Polygon 'Simple p r
vs,[Polygon 'Simple p r]
hs))

instance Functor (Polygon t p) where
  fmap :: (a -> b) -> Polygon t p a -> Polygon t p b
fmap = (p -> p) -> (a -> b) -> Polygon t p a -> Polygon t p b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap p -> p
forall a. a -> a
id

instance Bifunctor (Polygon t) where
  bimap :: (a -> b) -> (c -> d) -> Polygon t a c -> Polygon t b d
bimap = (a -> b) -> (c -> d) -> Polygon t a c -> Polygon t b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault

instance Bifoldable (Polygon t) where
  bifoldMap :: (a -> m) -> (b -> m) -> Polygon t a b -> m
bifoldMap = (a -> m) -> (b -> m) -> Polygon t a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault

instance Bitraversable (Polygon t) where
  bitraverse :: (a -> f c) -> (b -> f d) -> Polygon t a b -> f (Polygon t c d)
bitraverse a -> f c
f b -> f d
g Polygon t a b
p = case Polygon t a b
p of
    SimplePolygon Vertices (Point 2 b :+ a)
vs   -> Vertices (Point 2 d :+ c) -> SimplePolygon c d
forall r p. Vertices (Point 2 r :+ p) -> SimplePolygon p r
SimplePolygon (Vertices (Point 2 d :+ c) -> SimplePolygon c d)
-> f (Vertices (Point 2 d :+ c)) -> f (SimplePolygon c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c)
-> (b -> f d)
-> Vertices (Point 2 b :+ a)
-> f (Vertices (Point 2 d :+ c))
forall (f :: * -> *) (t :: * -> *) p q r s.
(Applicative f, Traversable t) =>
(p -> f q)
-> (r -> f s) -> t (Point 2 r :+ p) -> f (t (Point 2 s :+ q))
bitraverseVertices a -> f c
f b -> f d
g Vertices (Point 2 b :+ a)
vs
    MultiPolygon SimplePolygon a b
vs [SimplePolygon a b]
hs -> SimplePolygon c d -> [SimplePolygon c d] -> MultiPolygon c d
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon  (SimplePolygon c d -> [SimplePolygon c d] -> MultiPolygon c d)
-> f (SimplePolygon c d)
-> f ([SimplePolygon c d] -> MultiPolygon c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c)
-> (b -> f d) -> SimplePolygon a b -> f (SimplePolygon c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g SimplePolygon a b
vs
                                        f ([SimplePolygon c d] -> MultiPolygon c d)
-> f [SimplePolygon c d] -> f (MultiPolygon c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SimplePolygon a b -> f (SimplePolygon c d))
-> [SimplePolygon a b] -> f [SimplePolygon c d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c)
-> (b -> f d) -> SimplePolygon a b -> f (SimplePolygon c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) [SimplePolygon a b]
hs

instance (NFData p, NFData r) => NFData (Polygon t p r) where
  rnf :: Polygon t p r -> ()
rnf (SimplePolygon Vertices (Point 2 r :+ p)
vs)   = Vertices (Point 2 r :+ p) -> ()
forall a. NFData a => a -> ()
rnf Vertices (Point 2 r :+ p)
vs
  rnf (MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs) = (SimplePolygon p r, [SimplePolygon p r]) -> ()
forall a. NFData a => a -> ()
rnf (SimplePolygon p r
vs,[SimplePolygon p r]
hs)

bitraverseVertices     :: (Applicative f, Traversable t) => (p -> f q) -> (r -> f s)
                  -> t (Point 2 r :+ p) -> f (t (Point 2 s :+ q))
bitraverseVertices :: (p -> f q)
-> (r -> f s) -> t (Point 2 r :+ p) -> f (t (Point 2 s :+ q))
bitraverseVertices p -> f q
f r -> f s
g = ((Point 2 r :+ p) -> f (Point 2 s :+ q))
-> t (Point 2 r :+ p) -> f (t (Point 2 s :+ q))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Point 2 r -> f (Point 2 s))
-> (p -> f q) -> (Point 2 r :+ p) -> f (Point 2 s :+ q)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((r -> f s) -> Point 2 r -> f (Point 2 s)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse r -> f s
g) p -> f q
f)

-- | Polygon without holes.
type SimplePolygon = Polygon Simple

-- | Polygon with zero or more holes.
type MultiPolygon  = Polygon Multi

-- | Either a simple or multipolygon
type SomePolygon p r = Either (Polygon Simple p r) (Polygon Multi p r)

type instance Dimension (SomePolygon p r) = 2
type instance NumType   (SomePolygon p r) = r

-- | Polygons are per definition 2 dimensional
type instance Dimension (Polygon t p r) = 2
type instance NumType   (Polygon t p r) = r

instance (Show p, Show r) => Show (Polygon t p r) where
  show :: Polygon t p r -> String
show (SimplePolygon Vertices (Point 2 r :+ p)
vs)   = String
"SimplePolygon " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Point 2 r :+ p] -> String
forall a. Show a => a -> String
show (Vertices (Point 2 r :+ p) -> [Point 2 r :+ p]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vertices (Point 2 r :+ p)
vs)
  show (MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs) = String
"MultiPolygon (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SimplePolygon p r -> String
forall a. Show a => a -> String
show SimplePolygon p r
vs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SimplePolygon p r] -> String
forall a. Show a => a -> String
show [SimplePolygon p r]
hs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

instance (Read p, Read r) => Read (SimplePolygon p r) where
  readsPrec :: Int -> ReadS (SimplePolygon p r)
readsPrec Int
d = Bool -> ReadS (SimplePolygon p r) -> ReadS (SimplePolygon p r)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ReadS (SimplePolygon p r) -> ReadS (SimplePolygon p r))
-> ReadS (SimplePolygon p r) -> ReadS (SimplePolygon p r)
forall a b. (a -> b) -> a -> b
$ \String
r ->
      [ ([Point 2 r :+ p] -> SimplePolygon p r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints [Point 2 r :+ p]
vs, String
t)
      | (String
"SimplePolygon", String
s) <- ReadS String
lex String
r, ([Point 2 r :+ p]
vs, String
t) <- ReadS [Point 2 r :+ p]
forall a. Read a => ReadS a
reads String
s ]
    where app_prec :: Int
app_prec = Int
10

instance (Read p, Read r) => Read (MultiPolygon p r) where
  readsPrec :: Int -> ReadS (MultiPolygon p r)
readsPrec Int
d = Bool -> ReadS (MultiPolygon p r) -> ReadS (MultiPolygon p r)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ReadS (MultiPolygon p r) -> ReadS (MultiPolygon p r))
-> ReadS (MultiPolygon p r) -> ReadS (MultiPolygon p r)
forall a b. (a -> b) -> a -> b
$ \String
r ->
      [ (SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs, String
t')
      | (String
"MultiPolygon", String
s) <- ReadS String
lex String
r
      , (SimplePolygon p r
vs, String
t) <- ReadS (SimplePolygon p r)
forall a. Read a => ReadS a
reads String
s
      , ([SimplePolygon p r]
hs, String
t') <- ReadS [SimplePolygon p r]
forall a. Read a => ReadS a
reads String
t ]
    where app_prec :: Int
app_prec = Int
10

-- instance (Read p, Read r) => Show (Polygon t p r) where
--   show (SimplePolygon vs)   = "SimplePolygon (" <> show vs <> ")"
--   show (MultiPolygon vs hs) = "MultiPolygon (" <> show vs <> ") (" <> show hs <> ")"



instance (Eq p, Eq r) => Eq (Polygon t p r) where
  (SimplePolygon Vertices (Point 2 r :+ p)
vs)   == :: Polygon t p r -> Polygon t p r -> Bool
== (SimplePolygon Vertices (Point 2 r :+ p)
vs')    = Vertices (Point 2 r :+ p)
vs Vertices (Point 2 r :+ p) -> Vertices (Point 2 r :+ p) -> Bool
forall a. Eq a => a -> a -> Bool
== Vertices (Point 2 r :+ p)
vs'
  (MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs) == (MultiPolygon SimplePolygon p r
vs' [SimplePolygon p r]
hs') = SimplePolygon p r
vs SimplePolygon p r -> SimplePolygon p r -> Bool
forall a. Eq a => a -> a -> Bool
== SimplePolygon p r
vs' Bool -> Bool -> Bool
&& [SimplePolygon p r]
hs [SimplePolygon p r] -> [SimplePolygon p r] -> Bool
forall a. Eq a => a -> a -> Bool
== [SimplePolygon p r]
hs'

instance PointFunctor (Polygon t p) where
  pmap :: (Point (Dimension (Polygon t p r)) r
 -> Point (Dimension (Polygon t p s)) s)
-> Polygon t p r -> Polygon t p s
pmap Point (Dimension (Polygon t p r)) r
-> Point (Dimension (Polygon t p s)) s
f (SimplePolygon Vertices (Point 2 r :+ p)
vs)   = Vertices (Point 2 s :+ p) -> SimplePolygon p s
forall r p. Vertices (Point 2 r :+ p) -> SimplePolygon p r
SimplePolygon (((Point 2 r :+ p) -> Point 2 s :+ p)
-> Vertices (Point 2 r :+ p) -> Vertices (Point 2 s :+ p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Point 2 r -> Point 2 s) -> (Point 2 r :+ p) -> Point 2 s :+ p
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Point 2 r -> Point 2 s
Point (Dimension (Polygon t p r)) r
-> Point (Dimension (Polygon t p s)) s
f) Vertices (Point 2 r :+ p)
vs)
  pmap Point (Dimension (Polygon t p r)) r
-> Point (Dimension (Polygon t p s)) s
f (MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs) = SimplePolygon p s -> [SimplePolygon p s] -> MultiPolygon p s
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon  ((Point (Dimension (SimplePolygon p r)) r
 -> Point (Dimension (SimplePolygon p s)) s)
-> SimplePolygon p r -> SimplePolygon p s
forall (g :: * -> *) r s.
PointFunctor g =>
(Point (Dimension (g r)) r -> Point (Dimension (g s)) s)
-> g r -> g s
pmap Point (Dimension (Polygon t p r)) r
-> Point (Dimension (Polygon t p s)) s
Point (Dimension (SimplePolygon p r)) r
-> Point (Dimension (SimplePolygon p s)) s
f SimplePolygon p r
vs) ((SimplePolygon p r -> SimplePolygon p s)
-> [SimplePolygon p r] -> [SimplePolygon p s]
forall a b. (a -> b) -> [a] -> [b]
map ((Point (Dimension (SimplePolygon p r)) r
 -> Point (Dimension (SimplePolygon p s)) s)
-> SimplePolygon p r -> SimplePolygon p s
forall (g :: * -> *) r s.
PointFunctor g =>
(Point (Dimension (g r)) r -> Point (Dimension (g s)) s)
-> g r -> g s
pmap Point (Dimension (Polygon t p r)) r
-> Point (Dimension (Polygon t p s)) s
Point (Dimension (SimplePolygon p r)) r
-> Point (Dimension (SimplePolygon p s)) s
f) [SimplePolygon p r]
hs)

instance Fractional r => IsTransformable (Polygon t p r) where
  transformBy :: Transformation
  (Dimension (Polygon t p r)) (NumType (Polygon t p r))
-> Polygon t p r -> Polygon t p r
transformBy = Transformation
  (Dimension (Polygon t p r)) (NumType (Polygon t p r))
-> Polygon t p r -> Polygon t p r
forall (g :: * -> *) r (d :: Nat).
(PointFunctor g, Fractional r, d ~ Dimension (g r), Arity d,
 Arity (d + 1)) =>
Transformation d r -> g r -> g r
transformPointFunctor

instance IsBoxable (Polygon t p r) where
  boundingBox :: Polygon t p r
-> Box (Dimension (Polygon t p r)) () (NumType (Polygon t p r))
boundingBox = [Point 2 r] -> Box 2 () r
forall g (c :: * -> *).
(IsBoxable g, Foldable c, Ord (NumType g), Arity (Dimension g)) =>
c g -> Box (Dimension g) () (NumType g)
boundingBoxList' ([Point 2 r] -> Box 2 () r)
-> (Polygon t p r -> [Point 2 r]) -> Polygon t p r -> Box 2 () r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Point 2 r]) (Polygon t p r) (Point 2 r)
-> Polygon t p r -> [Point 2 r]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((CircularVector (Point 2 r :+ p)
 -> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p)))
-> Polygon t p r -> Const (Endo [Point 2 r]) (Polygon t p r)
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector((CircularVector (Point 2 r :+ p)
  -> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p)))
 -> Polygon t p r -> Const (Endo [Point 2 r]) (Polygon t p r))
-> ((Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
    -> CircularVector (Point 2 r :+ p)
    -> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p)))
-> Getting (Endo [Point 2 r]) (Polygon t p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Endo [Point 2 r]) (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
-> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse(((Point 2 r :+ p) -> Const (Endo [Point 2 r]) (Point 2 r :+ p))
 -> CircularVector (Point 2 r :+ p)
 -> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Endo [Point 2 r]) (Point 2 r :+ p))
-> (Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> CircularVector (Point 2 r :+ p)
-> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Endo [Point 2 r]) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)


instance (ToJSON r, ToJSON p) => ToJSON (Polygon t p r) where
  toJSON :: Polygon t p r -> Value
toJSON     = \case
    (SimplePolygon Vertices (Point 2 r :+ p)
vs)   -> [Pair] -> Value
object [ Text
"tag"           Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
"SimplePolygon" :: String)
                                   , Text
"vertices"      Text -> [Point 2 r :+ p] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Vertices (Point 2 r :+ p) -> [Point 2 r :+ p]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vertices (Point 2 r :+ p)
vs
                                   ]
    (MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs) -> [Pair] -> Value
object [ Text
"tag"           Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
"MultiPolygon" :: String)
                                   , Text
"outerBoundary" Text -> [Point 2 r :+ p] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SimplePolygon p r -> [Point 2 r :+ p]
getVertices SimplePolygon p r
vs
                                   , Text
"holes"         Text -> [[Point 2 r :+ p]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (SimplePolygon p r -> [Point 2 r :+ p])
-> [SimplePolygon p r] -> [[Point 2 r :+ p]]
forall a b. (a -> b) -> [a] -> [b]
map SimplePolygon p r -> [Point 2 r :+ p]
getVertices [SimplePolygon p r]
hs
                                   ]
      where
        getVertices :: SimplePolygon p r -> [Point 2 r :+ p]
getVertices = Getting [Point 2 r :+ p] (SimplePolygon p r) [Point 2 r :+ p]
-> SimplePolygon p r -> [Point 2 r :+ p]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CircularVector (Point 2 r :+ p)
 -> Const [Point 2 r :+ p] (CircularVector (Point 2 r :+ p)))
-> SimplePolygon p r -> Const [Point 2 r :+ p] (SimplePolygon p r)
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector((CircularVector (Point 2 r :+ p)
  -> Const [Point 2 r :+ p] (CircularVector (Point 2 r :+ p)))
 -> SimplePolygon p r -> Const [Point 2 r :+ p] (SimplePolygon p r))
-> (([Point 2 r :+ p] -> Const [Point 2 r :+ p] [Point 2 r :+ p])
    -> CircularVector (Point 2 r :+ p)
    -> Const [Point 2 r :+ p] (CircularVector (Point 2 r :+ p)))
-> Getting [Point 2 r :+ p] (SimplePolygon p r) [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CircularVector (Point 2 r :+ p) -> [Point 2 r :+ p])
-> ([Point 2 r :+ p] -> Const [Point 2 r :+ p] [Point 2 r :+ p])
-> CircularVector (Point 2 r :+ p)
-> Const [Point 2 r :+ p] (CircularVector (Point 2 r :+ p))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to CircularVector (Point 2 r :+ p) -> [Point 2 r :+ p]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList)

instance (FromJSON r, Eq r, Num r, FromJSON p) => FromJSON (Polygon Simple p r) where
  parseJSON :: Value -> Parser (Polygon 'Simple p r)
parseJSON = String
-> (Object -> Parser (Polygon 'Simple p r))
-> Value
-> Parser (Polygon 'Simple p r)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Polygon" ((Object -> Parser (Polygon 'Simple p r))
 -> Value -> Parser (Polygon 'Simple p r))
-> (Object -> Parser (Polygon 'Simple p r))
-> Value
-> Parser (Polygon 'Simple p r)
forall a b. (a -> b) -> a -> b
$ \Object
o -> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tag" Parser String
-> (String -> Parser (Polygon 'Simple p r))
-> Parser (Polygon 'Simple p r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                             String
"SimplePolygon" -> Object -> Parser (Polygon 'Simple p r)
forall r p.
(Eq r, Num r, FromJSON r, FromJSON p) =>
Object -> Parser (SimplePolygon p r)
pSimple Object
o
                                             (String
_ :: String)   -> String -> Parser (Polygon 'Simple p r)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a SimplePolygon"
    where
      pSimple :: Object -> Parser (SimplePolygon p r)
pSimple Object
o = [Point 2 r :+ p] -> SimplePolygon p r
forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
fromPoints ([Point 2 r :+ p] -> SimplePolygon p r)
-> Parser [Point 2 r :+ p] -> Parser (SimplePolygon p r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Point 2 r :+ p]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"vertices"

instance (FromJSON r, Eq r, Num r, FromJSON p) => FromJSON (Polygon Multi p r) where
  parseJSON :: Value -> Parser (Polygon 'Multi p r)
parseJSON = String
-> (Object -> Parser (Polygon 'Multi p r))
-> Value
-> Parser (Polygon 'Multi p r)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Polygon" ((Object -> Parser (Polygon 'Multi p r))
 -> Value -> Parser (Polygon 'Multi p r))
-> (Object -> Parser (Polygon 'Multi p r))
-> Value
-> Parser (Polygon 'Multi p r)
forall a b. (a -> b) -> a -> b
$ \Object
o -> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tag" Parser String
-> (String -> Parser (Polygon 'Multi p r))
-> Parser (Polygon 'Multi p r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                             String
"MultiPolygon"  -> Object -> Parser (Polygon 'Multi p r)
forall r p.
(Eq r, Num r, FromJSON r, FromJSON p) =>
Object -> Parser (MultiPolygon p r)
pMulti Object
o
                                             (String
_ :: String)   -> String -> Parser (Polygon 'Multi p r)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a MultiPolygon"
    where
      pMulti :: Object -> Parser (MultiPolygon p r)
pMulti  Object
o = (\[Point 2 r :+ p]
vs [[Point 2 r :+ p]]
hs -> SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon ([Point 2 r :+ p] -> SimplePolygon p r
forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
fromPoints [Point 2 r :+ p]
vs) (([Point 2 r :+ p] -> SimplePolygon p r)
-> [[Point 2 r :+ p]] -> [SimplePolygon p r]
forall a b. (a -> b) -> [a] -> [b]
map [Point 2 r :+ p] -> SimplePolygon p r
forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
fromPoints [[Point 2 r :+ p]]
hs))
               ([Point 2 r :+ p] -> [[Point 2 r :+ p]] -> MultiPolygon p r)
-> Parser [Point 2 r :+ p]
-> Parser ([[Point 2 r :+ p]] -> MultiPolygon p r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Point 2 r :+ p]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"outerBoundary" Parser ([[Point 2 r :+ p]] -> MultiPolygon p r)
-> Parser [[Point 2 r :+ p]] -> Parser (MultiPolygon p r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [[Point 2 r :+ p]]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"holes"



-- * Functions on Polygons

-- | Getter access to the outer boundary vector of a polygon.
--
-- >>> toList (simpleTriangle ^. outerBoundaryVector)
-- [Point2 0 0 :+ (),Point2 2 0 :+ (),Point2 1 1 :+ ()]
outerBoundaryVector :: forall t p r. Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector :: (CircularVector (Point 2 r :+ p)
 -> f (CircularVector (Point 2 r :+ p)))
-> Polygon t p r -> f (Polygon t p r)
outerBoundaryVector = (Polygon t p r -> CircularVector (Point 2 r :+ p))
-> (CircularVector (Point 2 r :+ p)
    -> f (CircularVector (Point 2 r :+ p)))
-> Polygon t p r
-> f (Polygon t p r)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Polygon t p r -> CircularVector (Point 2 r :+ p)
g
  where
    g                     :: Polygon t p r -> CircularVector (Point 2 r :+ p)
    g :: Polygon t p r -> CircularVector (Point 2 r :+ p)
g (SimplePolygon (Vertices CircularVector (Point 2 r :+ p)
vs))                  = CircularVector (Point 2 r :+ p)
vs
    g (MultiPolygon (SimplePolygon (Vertices CircularVector (Point 2 r :+ p)
vs)) [Polygon 'Simple p r]
_) = CircularVector (Point 2 r :+ p)
vs

-- | Unsafe lens access to the outer boundary vector of a polygon.
--
-- >>> toList (simpleTriangle ^. unsafeOuterBoundaryVector)
-- [Point2 0 0 :+ (),Point2 2 0 :+ (),Point2 1 1 :+ ()]
--
-- >>> simpleTriangle & unsafeOuterBoundaryVector .~ CV.singleton (Point2 0 0 :+ ())
-- SimplePolygon [Point2 0 0 :+ ()]
unsafeOuterBoundaryVector :: forall t p r. Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p))
unsafeOuterBoundaryVector :: (CircularVector (Point 2 r :+ p)
 -> f (CircularVector (Point 2 r :+ p)))
-> Polygon t p r -> f (Polygon t p r)
unsafeOuterBoundaryVector = (Polygon t p r -> CircularVector (Point 2 r :+ p))
-> (Polygon t p r
    -> CircularVector (Point 2 r :+ p) -> Polygon t p r)
-> Lens
     (Polygon t p r)
     (Polygon t p r)
     (CircularVector (Point 2 r :+ p))
     (CircularVector (Point 2 r :+ p))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Polygon t p r -> CircularVector (Point 2 r :+ p)
g Polygon t p r -> CircularVector (Point 2 r :+ p) -> Polygon t p r
s
  where
    g                     :: Polygon t p r -> CircularVector (Point 2 r :+ p)
    g :: Polygon t p r -> CircularVector (Point 2 r :+ p)
g (SimplePolygon (Vertices CircularVector (Point 2 r :+ p)
vs))                  = CircularVector (Point 2 r :+ p)
vs
    g (MultiPolygon (SimplePolygon (Vertices CircularVector (Point 2 r :+ p)
vs)) [Polygon 'Simple p r]
_) = CircularVector (Point 2 r :+ p)
vs

    s                           :: Polygon t p r -> CircularVector (Point 2 r :+ p)
                                -> Polygon t p r
    s :: Polygon t p r -> CircularVector (Point 2 r :+ p) -> Polygon t p r
s SimplePolygon{}     CircularVector (Point 2 r :+ p)
vs = Vertices (Point 2 r :+ p) -> Polygon 'Simple p r
forall r p. Vertices (Point 2 r :+ p) -> SimplePolygon p r
SimplePolygon (CircularVector (Point 2 r :+ p) -> Vertices (Point 2 r :+ p)
forall a. CircularVector a -> Vertices a
Vertices CircularVector (Point 2 r :+ p)
vs)
    s (MultiPolygon Polygon 'Simple p r
_ [Polygon 'Simple p r]
hs) CircularVector (Point 2 r :+ p)
vs = Polygon 'Simple p r -> [Polygon 'Simple p r] -> MultiPolygon p r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon (Vertices (Point 2 r :+ p) -> Polygon 'Simple p r
forall r p. Vertices (Point 2 r :+ p) -> SimplePolygon p r
SimplePolygon (CircularVector (Point 2 r :+ p) -> Vertices (Point 2 r :+ p)
forall a. CircularVector a -> Vertices a
Vertices CircularVector (Point 2 r :+ p)
vs)) [Polygon 'Simple p r]
hs


-- | \( O(1) \) Lens access to the outer boundary of a polygon.
outerBoundary :: forall t p r. Lens' (Polygon t p r) (SimplePolygon p r)
outerBoundary :: (SimplePolygon p r -> f (SimplePolygon p r))
-> Polygon t p r -> f (Polygon t p r)
outerBoundary = (Polygon t p r -> SimplePolygon p r)
-> (Polygon t p r -> SimplePolygon p r -> Polygon t p r)
-> Lens
     (Polygon t p r)
     (Polygon t p r)
     (SimplePolygon p r)
     (SimplePolygon p r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Polygon t p r -> SimplePolygon p r
g Polygon t p r -> SimplePolygon p r -> Polygon t p r
s
  where
    g                     :: Polygon t p r -> SimplePolygon p r
    g :: Polygon t p r -> SimplePolygon p r
g poly :: Polygon t p r
poly@SimplePolygon{}    = Polygon t p r
SimplePolygon p r
poly
    g (MultiPolygon SimplePolygon p r
simple [SimplePolygon p r]
_) = SimplePolygon p r
simple

    s                           :: Polygon t p r -> SimplePolygon p r
                                -> Polygon t p r
    s :: Polygon t p r -> SimplePolygon p r -> Polygon t p r
s SimplePolygon{} SimplePolygon p r
simple     = Polygon t p r
SimplePolygon p r
simple
    s (MultiPolygon SimplePolygon p r
_ [SimplePolygon p r]
hs) SimplePolygon p r
simple = SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon SimplePolygon p r
simple [SimplePolygon p r]
hs

-- | Lens access for polygon holes.
--
-- >>> multiPoly ^. polygonHoles
-- [SimplePolygon [Point2 0 0 :+ (),Point2 2 0 :+ (),Point2 1 1 :+ ()]]
polygonHoles :: forall p r. Lens' (Polygon Multi p r) [Polygon Simple p r]
polygonHoles :: ([Polygon 'Simple p r] -> f [Polygon 'Simple p r])
-> Polygon 'Multi p r -> f (Polygon 'Multi p r)
polygonHoles = (Polygon 'Multi p r -> [Polygon 'Simple p r])
-> (Polygon 'Multi p r
    -> [Polygon 'Simple p r] -> Polygon 'Multi p r)
-> Lens
     (Polygon 'Multi p r)
     (Polygon 'Multi p r)
     [Polygon 'Simple p r]
     [Polygon 'Simple p r]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Polygon 'Multi p r -> [Polygon 'Simple p r]
g Polygon 'Multi p r -> [Polygon 'Simple p r] -> Polygon 'Multi p r
s
  where
    g                     :: Polygon Multi p r -> [Polygon Simple p r]
    g :: Polygon 'Multi p r -> [Polygon 'Simple p r]
g (MultiPolygon Polygon 'Simple p r
_ [Polygon 'Simple p r]
hs) = [Polygon 'Simple p r]
hs
    s                     :: Polygon Multi p r -> [Polygon Simple p r]
                          -> Polygon Multi p r
    s :: Polygon 'Multi p r -> [Polygon 'Simple p r] -> Polygon 'Multi p r
s (MultiPolygon Polygon 'Simple p r
vs [Polygon 'Simple p r]
_) = Polygon 'Simple p r -> [Polygon 'Simple p r] -> Polygon 'Multi p r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon Polygon 'Simple p r
vs

{- HLINT ignore polygonHoles' -}
-- | \( O(1) \). Traversal lens for polygon holes. Does nothing for simple polygons.
polygonHoles' :: Traversal' (Polygon t p r) [Polygon Simple p r]
polygonHoles' :: ([Polygon 'Simple p r] -> f [Polygon 'Simple p r])
-> Polygon t p r -> f (Polygon t p r)
polygonHoles' = \[Polygon 'Simple p r] -> f [Polygon 'Simple p r]
f -> \case
  p :: Polygon t p r
p@SimplePolygon{}  -> Polygon t p r -> f (Polygon t p r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Polygon t p r
p
  MultiPolygon Polygon 'Simple p r
vs [Polygon 'Simple p r]
hs -> Polygon 'Simple p r -> [Polygon 'Simple p r] -> MultiPolygon p r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon Polygon 'Simple p r
vs ([Polygon 'Simple p r] -> MultiPolygon p r)
-> f [Polygon 'Simple p r] -> f (MultiPolygon p r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Polygon 'Simple p r] -> f [Polygon 'Simple p r]
f [Polygon 'Simple p r]
hs

-- | /O(1)/ Access the i^th vertex on the outer boundary. Indices are modulo \(n\).
--
-- >>> simplePoly ^. outerVertex 0
-- Point2 0 0 :+ ()
outerVertex   :: Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex :: Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
i = (CircularVector (Point 2 r :+ p)
 -> f (CircularVector (Point 2 r :+ p)))
-> Polygon t p r -> f (Polygon t p r)
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector ((CircularVector (Point 2 r :+ p)
  -> f (CircularVector (Point 2 r :+ p)))
 -> Polygon t p r -> f (Polygon t p r))
-> (((Point 2 r :+ p) -> f (Point 2 r :+ p))
    -> CircularVector (Point 2 r :+ p)
    -> f (CircularVector (Point 2 r :+ p)))
-> ((Point 2 r :+ p) -> f (Point 2 r :+ p))
-> Polygon t p r
-> f (Polygon t p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' (CircularVector (Point 2 r :+ p)) (Point 2 r :+ p)
forall a. Int -> Lens' (CircularVector a) a
CV.item Int
i

-- | \( O(1) \) read and \( O(n) \) write. Access the i^th vertex on the outer boundary
--
-- >>> simplePoly ^. unsafeOuterVertex 0
-- Point2 0 0 :+ ()
-- >>> simplePoly & unsafeOuterVertex 0 .~ (Point2 10 10 :+ ())
-- SimplePolygon [Point2 10 10 :+ (),Point2 10 0 :+ (),Point2 10 10 :+ (),Point2 5 15 :+ (),Point2 1 11 :+ ()]
unsafeOuterVertex   :: Int -> Lens' (Polygon t p r) (Point 2 r :+ p)
unsafeOuterVertex :: Int -> Lens' (Polygon t p r) (Point 2 r :+ p)
unsafeOuterVertex Int
i = (CircularVector (Point 2 r :+ p)
 -> f (CircularVector (Point 2 r :+ p)))
-> Polygon t p r -> f (Polygon t p r)
forall (t :: PolygonType) p r.
Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p))
unsafeOuterBoundaryVector ((CircularVector (Point 2 r :+ p)
  -> f (CircularVector (Point 2 r :+ p)))
 -> Polygon t p r -> f (Polygon t p r))
-> (((Point 2 r :+ p) -> f (Point 2 r :+ p))
    -> CircularVector (Point 2 r :+ p)
    -> f (CircularVector (Point 2 r :+ p)))
-> ((Point 2 r :+ p) -> f (Point 2 r :+ p))
-> Polygon t p r
-> f (Polygon t p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' (CircularVector (Point 2 r :+ p)) (Point 2 r :+ p)
forall a. Int -> Lens' (CircularVector a) a
CV.item Int
i

-- | \( O(1) \) Get the n^th edge along the outer boundary of the polygon. The edge is half open.
outerBoundaryEdge     :: Int -> Polygon t p r -> LineSegment 2 p r
outerBoundaryEdge :: Int -> Polygon t p r -> LineSegment 2 p r
outerBoundaryEdge Int
i Polygon t p r
p = let u :: Point 2 r :+ p
u = Polygon t p r
pPolygon t p r
-> Getting (Point 2 r :+ p) (Polygon t p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Int -> Getter (Polygon t p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
i
                            v :: Point 2 r :+ p
v = Polygon t p r
pPolygon t p r
-> Getting (Point 2 r :+ p) (Polygon t p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Int -> Getter (Polygon t p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                        in 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 ((Point 2 r :+ p) -> EndPoint (Point 2 r :+ p)
forall a. a -> EndPoint a
Closed Point 2 r :+ p
u) ((Point 2 r :+ p) -> EndPoint (Point 2 r :+ p)
forall a. a -> EndPoint a
Open Point 2 r :+ p
v)


-- | Get all holes in a polygon
holeList                     :: Polygon t p r -> [Polygon Simple p r]
holeList :: Polygon t p r -> [Polygon 'Simple p r]
holeList SimplePolygon{}     = []
holeList (MultiPolygon Polygon 'Simple p r
_ [Polygon 'Simple p r]
hs) = [Polygon 'Simple p r]
hs


-- | \( O(1) \) Vertex count. Includes the vertices of holes.
size :: Polygon t p r -> Int
size :: Polygon t p r -> Int
size (SimplePolygon (Vertices CircularVector (Point 2 r :+ p)
cv)) = CircularVector (Point 2 r :+ p) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length CircularVector (Point 2 r :+ p)
cv
size (MultiPolygon SimplePolygon p r
b [SimplePolygon p r]
hs)           = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((SimplePolygon p r -> Int) -> [SimplePolygon p r] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map SimplePolygon p r -> Int
forall (t :: PolygonType) p r. Polygon t p r -> Int
size (SimplePolygon p r
bSimplePolygon p r -> [SimplePolygon p r] -> [SimplePolygon p r]
forall a. a -> [a] -> [a]
:[SimplePolygon p r]
hs))

-- | \( O(n) \) The vertices in the polygon. No guarantees are given on the order in which
-- they appear!
polygonVertices                      :: Polygon t p r
                                     -> NonEmpty.NonEmpty (Point 2 r :+ p)
polygonVertices :: Polygon t p r -> NonEmpty (Point 2 r :+ p)
polygonVertices p :: Polygon t p r
p@SimplePolygon{}    = CircularVector (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty (CircularVector (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ Polygon t p r
pPolygon t p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (Polygon t p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^.Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector
polygonVertices (MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs) =
  NonEmpty (NonEmpty (Point 2 r :+ p)) -> NonEmpty (Point 2 r :+ p)
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (NonEmpty (Point 2 r :+ p)) -> NonEmpty (Point 2 r :+ p))
-> NonEmpty (NonEmpty (Point 2 r :+ p))
-> NonEmpty (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty (SimplePolygon p r -> NonEmpty (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Polygon t p r -> NonEmpty (Point 2 r :+ p)
polygonVertices SimplePolygon p r
vs) NonEmpty (Point 2 r :+ p)
-> [NonEmpty (Point 2 r :+ p)]
-> NonEmpty (NonEmpty (Point 2 r :+ p))
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| (SimplePolygon p r -> NonEmpty (Point 2 r :+ p))
-> [SimplePolygon p r] -> [NonEmpty (Point 2 r :+ p)]
forall a b. (a -> b) -> [a] -> [b]
map SimplePolygon p r -> NonEmpty (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Polygon t p r -> NonEmpty (Point 2 r :+ p)
polygonVertices [SimplePolygon p r]
hs

-- FIXME: Get rid of 'Fractional r' constraint.
-- | \( O(n \log n) \) Check if a polygon has any holes, duplicate points, or
--   self-intersections.
isSimple :: (Ord r, Fractional r) => Polygon p t r -> Bool
isSimple :: Polygon p t r -> Bool
isSimple p :: Polygon p t r
p@SimplePolygon{}   = Map (Point 2 r) (Associated t r) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map (Point 2 r) (Associated t r) -> Bool)
-> ([LineSegment 2 t r] -> Map (Point 2 r) (Associated t r))
-> [LineSegment 2 t r]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LineSegment 2 t r] -> Map (Point 2 r) (Associated t r)
forall r p.
(Ord r, Fractional r) =>
[LineSegment 2 p r] -> Intersections p r
BO.interiorIntersections ([LineSegment 2 t r] -> Bool) -> [LineSegment 2 t r] -> Bool
forall a b. (a -> b) -> a -> b
$ Polygon p t r -> [LineSegment 2 t r]
forall (t :: PolygonType) p r. Polygon t p r -> [LineSegment 2 p r]
listEdges Polygon p t r
p
isSimple (MultiPolygon SimplePolygon t r
b []) = SimplePolygon t r -> Bool
forall r (p :: PolygonType) t.
(Ord r, Fractional r) =>
Polygon p t r -> Bool
isSimple SimplePolygon t r
b
isSimple MultiPolygon{}      = Bool
False

requireThree :: String -> [a] -> [a]
requireThree :: String -> [a] -> [a]
requireThree String
_ lst :: [a]
lst@(a
_:a
_:a
_:[a]
_) = [a]
lst
requireThree String
label [a]
_ = String -> [a]
forall a. HasCallStack => String -> a
error (String -> [a]) -> String -> [a]
forall a b. (a -> b) -> a -> b
$
  String
"Data.Geometry.Polygon." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": Polygons must have at least three points."

-- | \( O(n) \) Creates a polygon from the given list of vertices.
--
-- The points are placed in CCW order if they are not already. Overlapping
-- edges and repeated vertices are allowed.
--
fromPoints :: forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
fromPoints :: [Point 2 r :+ p] -> SimplePolygon p r
fromPoints = CircularVector (Point 2 r :+ p) -> SimplePolygon p r
forall p r.
(Eq r, Num r) =>
CircularVector (Point 2 r :+ p) -> SimplePolygon p r
fromCircularVector (CircularVector (Point 2 r :+ p) -> SimplePolygon p r)
-> ([Point 2 r :+ p] -> CircularVector (Point 2 r :+ p))
-> [Point 2 r :+ p]
-> SimplePolygon p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ p] -> CircularVector (Point 2 r :+ p)
forall a. [a] -> CircularVector a
CV.unsafeFromList ([Point 2 r :+ p] -> CircularVector (Point 2 r :+ p))
-> ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> [Point 2 r :+ p]
-> CircularVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. String -> [a] -> [a]
requireThree String
"fromPoints"

-- | \( O(n) \) Creates a polygon from the given vector of vertices.
--
-- The points are placed in CCW order if they are not already. Overlapping
-- edges and repeated vertices are allowed.
--
fromCircularVector :: forall p r. (Eq r, Num r) => CircularVector (Point 2 r :+ p) -> SimplePolygon p r
fromCircularVector :: CircularVector (Point 2 r :+ p) -> SimplePolygon p r
fromCircularVector = SimplePolygon p r -> SimplePolygon p r
forall r (t :: PolygonType) p.
(Eq r, Num r) =>
Polygon t p r -> Polygon t p r
toCounterClockWiseOrder (SimplePolygon p r -> SimplePolygon p r)
-> (CircularVector (Point 2 r :+ p) -> SimplePolygon p r)
-> CircularVector (Point 2 r :+ p)
-> SimplePolygon p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector (Point 2 r :+ p) -> SimplePolygon p r
forall r p. CircularVector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromCircularVector

-- | \( O(n \log n) \) Creates a simple polygon from the given list of vertices.
--
-- The points are placed in CCW order if they are not already. Overlapping
-- edges and repeated vertices are /not/ allowed and will trigger an exception.
--
simpleFromPoints :: forall p r. (Ord r, Fractional r) => [Point 2 r :+ p] -> SimplePolygon p r
simpleFromPoints :: [Point 2 r :+ p] -> SimplePolygon p r
simpleFromPoints =
  CircularVector (Point 2 r :+ p) -> SimplePolygon p r
forall p r.
(Ord r, Fractional r) =>
CircularVector (Point 2 r :+ p) -> SimplePolygon p r
simpleFromCircularVector (CircularVector (Point 2 r :+ p) -> SimplePolygon p r)
-> ([Point 2 r :+ p] -> CircularVector (Point 2 r :+ p))
-> [Point 2 r :+ p]
-> SimplePolygon p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ p] -> CircularVector (Point 2 r :+ p)
forall a. [a] -> CircularVector a
CV.unsafeFromList ([Point 2 r :+ p] -> CircularVector (Point 2 r :+ p))
-> ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> [Point 2 r :+ p]
-> CircularVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. String -> [a] -> [a]
requireThree String
"simpleFromPoints"

-- | \( O(n \log n) \) Creates a simple polygon from the given vector of vertices.
--
-- The points are placed in CCW order if they are not already. Overlapping
-- edges and repeated vertices are /not/ allowed and will trigger an exception.
--
simpleFromCircularVector :: forall p r. (Ord r, Fractional r)
  => CircularVector (Point 2 r :+ p) -> SimplePolygon p r
simpleFromCircularVector :: CircularVector (Point 2 r :+ p) -> SimplePolygon p r
simpleFromCircularVector CircularVector (Point 2 r :+ p)
v =
  let p :: SimplePolygon p r
p = CircularVector (Point 2 r :+ p) -> SimplePolygon p r
forall p r.
(Eq r, Num r) =>
CircularVector (Point 2 r :+ p) -> SimplePolygon p r
fromCircularVector CircularVector (Point 2 r :+ p)
v
      hasInteriorIntersections :: [LineSegment 2 p r] -> Bool
hasInteriorIntersections = 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
. Map (Point 2 r) (Associated p r) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map (Point 2 r) (Associated p r) -> Bool)
-> ([LineSegment 2 p r] -> Map (Point 2 r) (Associated p r))
-> [LineSegment 2 p r]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LineSegment 2 p r] -> Map (Point 2 r) (Associated p r)
forall r p.
(Ord r, Fractional r) =>
[LineSegment 2 p r] -> Intersections p r
BO.interiorIntersections
  in if [LineSegment 2 p r] -> Bool
forall p. [LineSegment 2 p r] -> Bool
hasInteriorIntersections (SimplePolygon p r -> [LineSegment 2 p r]
forall (t :: PolygonType) p r. Polygon t p r -> [LineSegment 2 p r]
listEdges SimplePolygon p r
p)
      then String -> SimplePolygon p r
forall a. HasCallStack => String -> a
error String
"Data.Geometry.Polygon.simpleFromCircularVector: \
                 \Found self-intersections or repeated vertices."
      else SimplePolygon p r
p

-- | \( O(n) \) Creates a simple polygon from the given list of vertices.
--
-- pre: the input list constains no repeated vertices.
unsafeFromPoints :: [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints :: [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints = CircularVector (Point 2 r :+ p) -> SimplePolygon p r
forall r p. CircularVector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromCircularVector (CircularVector (Point 2 r :+ p) -> SimplePolygon p r)
-> ([Point 2 r :+ p] -> CircularVector (Point 2 r :+ p))
-> [Point 2 r :+ p]
-> SimplePolygon p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ p] -> CircularVector (Point 2 r :+ p)
forall a. [a] -> CircularVector a
CV.unsafeFromList

-- | \( O(1) \) Creates a simple polygon from the given vector of vertices.
--
-- pre: the input list constains no repeated vertices.
unsafeFromCircularVector :: CircularVector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromCircularVector :: CircularVector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromCircularVector = Vertices (Point 2 r :+ p) -> SimplePolygon p r
forall r p. Vertices (Point 2 r :+ p) -> SimplePolygon p r
SimplePolygon (Vertices (Point 2 r :+ p) -> SimplePolygon p r)
-> (CircularVector (Point 2 r :+ p) -> Vertices (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
-> SimplePolygon p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector (Point 2 r :+ p) -> Vertices (Point 2 r :+ p)
forall a. CircularVector a -> Vertices a
Vertices

-- | \( O(1) \) Creates a simple polygon from the given vector of vertices.
--
-- pre: the input list constains no repeated vertices.
unsafeFromVector :: Vector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromVector :: Vector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromVector = CircularVector (Point 2 r :+ p) -> SimplePolygon p r
forall r p. CircularVector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromCircularVector (CircularVector (Point 2 r :+ p) -> SimplePolygon p r)
-> (Vector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p))
-> Vector (Point 2 r :+ p)
-> SimplePolygon p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
forall a. Vector a -> CircularVector a
CV.unsafeFromVector

-- -- | Polygon points, from left to right.
-- toList :: Polygon t p r -> [Point 2 r :+ p]
-- toList (SimplePolygon c)   = F.toList c
-- toList (MultiPolygon s hs) = toList s ++ concatMap toList hs

-- | \( O(n) \)
--   Polygon points, from left to right.
toVector :: Polygon t p r -> Vector (Point 2 r :+ p)
toVector :: Polygon t p r -> Vector (Point 2 r :+ p)
toVector p :: Polygon t p r
p@SimplePolygon{}   = CircularVector (Point 2 r :+ p) -> Vector (Point 2 r :+ p)
forall a. CircularVector a -> Vector a
CV.toVector (CircularVector (Point 2 r :+ p) -> Vector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p) -> Vector (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ Polygon t p r
pPolygon t p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (Polygon t p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^.Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector
toVector (MultiPolygon SimplePolygon p r
s [SimplePolygon p r]
hs) = (Vector (Point 2 r :+ p)
 -> Vector (Point 2 r :+ p) -> Vector (Point 2 r :+ p))
-> Vector (Point 2 r :+ p)
-> [Vector (Point 2 r :+ p)]
-> Vector (Point 2 r :+ p)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Vector (Point 2 r :+ p)
-> Vector (Point 2 r :+ p) -> Vector (Point 2 r :+ p)
forall a. Semigroup a => a -> a -> a
(<>) (SimplePolygon p r -> Vector (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Polygon t p r -> Vector (Point 2 r :+ p)
toVector SimplePolygon p r
s) ((SimplePolygon p r -> Vector (Point 2 r :+ p))
-> [SimplePolygon p r] -> [Vector (Point 2 r :+ p)]
forall a b. (a -> b) -> [a] -> [b]
map SimplePolygon p r -> Vector (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Polygon t p r -> Vector (Point 2 r :+ p)
toVector [SimplePolygon p r]
hs)

-- | \( O(n) \)
--   Polygon points, from left to right.
toPoints :: Polygon t p r -> [Point 2 r :+ p]
toPoints :: Polygon t p r -> [Point 2 r :+ p]
toPoints = Vector (Point 2 r :+ p) -> [Point 2 r :+ p]
forall a. Vector a -> [a]
V.toList (Vector (Point 2 r :+ p) -> [Point 2 r :+ p])
-> (Polygon t p r -> Vector (Point 2 r :+ p))
-> Polygon t p r
-> [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Polygon t p r -> Vector (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Polygon t p r -> Vector (Point 2 r :+ p)
toVector

-- | \( O(n) \) The edges along the outer boundary of the polygon. The edges are half open.
outerBoundaryEdges :: Polygon t p r -> CircularVector (LineSegment 2 p r)
outerBoundaryEdges :: Polygon t p r -> CircularVector (LineSegment 2 p r)
outerBoundaryEdges = CircularVector (Point 2 r :+ p)
-> CircularVector (LineSegment 2 p r)
forall r p.
CircularVector (Point 2 r :+ p)
-> CircularVector (LineSegment 2 p r)
toEdges (CircularVector (Point 2 r :+ p)
 -> CircularVector (LineSegment 2 p r))
-> (Polygon t p r -> CircularVector (Point 2 r :+ p))
-> Polygon t p r
-> CircularVector (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Polygon t p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (Polygon t p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^.Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector)

-- | \( O(n) \) Lists all edges. The edges on the outer boundary are given before the ones
-- on the holes. However, no other guarantees are given on the order.
listEdges    :: Polygon t p r -> [LineSegment 2 p r]
listEdges :: Polygon t p r -> [LineSegment 2 p r]
listEdges Polygon t p r
pg = let f :: Polygon t p r -> [LineSegment 2 p r]
f = CircularVector (LineSegment 2 p r) -> [LineSegment 2 p r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (CircularVector (LineSegment 2 p r) -> [LineSegment 2 p r])
-> (Polygon t p r -> CircularVector (LineSegment 2 p r))
-> Polygon t p r
-> [LineSegment 2 p r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Polygon t p r -> CircularVector (LineSegment 2 p r)
forall (t :: PolygonType) p r.
Polygon t p r -> CircularVector (LineSegment 2 p r)
outerBoundaryEdges
               in  Polygon t p r -> [LineSegment 2 p r]
forall (t :: PolygonType) p r. Polygon t p r -> [LineSegment 2 p r]
f Polygon t p r
pg [LineSegment 2 p r] -> [LineSegment 2 p r] -> [LineSegment 2 p r]
forall a. Semigroup a => a -> a -> a
<> (Polygon 'Simple p r -> [LineSegment 2 p r])
-> [Polygon 'Simple p r] -> [LineSegment 2 p r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Polygon 'Simple p r -> [LineSegment 2 p r]
forall (t :: PolygonType) p r. Polygon t p r -> [LineSegment 2 p r]
f (Polygon t p r -> [Polygon 'Simple p r]
forall (t :: PolygonType) p r.
Polygon t p r -> [Polygon 'Simple p r]
holeList Polygon t p r
pg)

-- | Pairs every vertex with its incident edges. The first one is its
-- predecessor edge, the second one its successor edge (in terms of
-- the ordering along the boundary).
--
--
-- >>> mapM_ print . polygonVertices $ withIncidentEdges simplePoly
-- Point2 0 0 :+ V2 (ClosedLineSegment (Point2 1 11 :+ ()) (Point2 0 0 :+ ())) (ClosedLineSegment (Point2 0 0 :+ ()) (Point2 10 0 :+ ()))
-- Point2 10 0 :+ V2 (ClosedLineSegment (Point2 0 0 :+ ()) (Point2 10 0 :+ ())) (ClosedLineSegment (Point2 10 0 :+ ()) (Point2 10 10 :+ ()))
-- Point2 10 10 :+ V2 (ClosedLineSegment (Point2 10 0 :+ ()) (Point2 10 10 :+ ())) (ClosedLineSegment (Point2 10 10 :+ ()) (Point2 5 15 :+ ()))
-- Point2 5 15 :+ V2 (ClosedLineSegment (Point2 10 10 :+ ()) (Point2 5 15 :+ ())) (ClosedLineSegment (Point2 5 15 :+ ()) (Point2 1 11 :+ ()))
-- Point2 1 11 :+ V2 (ClosedLineSegment (Point2 5 15 :+ ()) (Point2 1 11 :+ ())) (ClosedLineSegment (Point2 1 11 :+ ()) (Point2 0 0 :+ ()))
withIncidentEdges                    :: Polygon t p r
                                     -> Polygon t (Two (LineSegment 2 p r)) r
withIncidentEdges :: Polygon t p r -> Polygon t (Two (LineSegment 2 p r)) r
withIncidentEdges poly :: Polygon t p r
poly@SimplePolygon{} =
      CircularVector (Point 2 r :+ Two (LineSegment 2 p r))
-> SimplePolygon (Two (LineSegment 2 p r)) r
forall r p. CircularVector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromCircularVector (CircularVector (Point 2 r :+ Two (LineSegment 2 p r))
 -> SimplePolygon (Two (LineSegment 2 p r)) r)
-> CircularVector (Point 2 r :+ Two (LineSegment 2 p r))
-> SimplePolygon (Two (LineSegment 2 p r)) r
forall a b. (a -> b) -> a -> b
$ ((Point 2 r :+ p)
 -> (Point 2 r :+ p)
 -> (Point 2 r :+ p)
 -> Point 2 r :+ Two (LineSegment 2 p r))
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ Two (LineSegment 2 p r))
forall a b c d.
(a -> b -> c -> d)
-> CircularVector a
-> CircularVector b
-> CircularVector c
-> CircularVector d
CV.zipWith3 (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> Point 2 r :+ Two (LineSegment 2 p r)
forall (d :: Nat) r a.
(Point d r :+ a)
-> (Point d r :+ a)
-> (Point d r :+ a)
-> Point d r :+ Two (LineSegment d a r)
f (Int
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateLeft Int
1 CircularVector (Point 2 r :+ p)
vs) CircularVector (Point 2 r :+ p)
vs (Int
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateRight Int
1 CircularVector (Point 2 r :+ p)
vs)
  where
    vs :: CircularVector (Point 2 r :+ p)
vs = Polygon t p r
poly Polygon t p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (Polygon t p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^. Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector
    f :: (Point d r :+ a)
-> (Point d r :+ a)
-> (Point d r :+ a)
-> Point d r :+ Two (LineSegment d a r)
f Point d r :+ a
p Point d r :+ a
c Point d r :+ a
n = Point d r :+ a
c(Point d r :+ a)
-> ((Point d r :+ a) -> Point d r :+ Two (LineSegment d a r))
-> Point d r :+ Two (LineSegment d a r)
forall a b. a -> (a -> b) -> b
&(a -> Identity (Two (LineSegment d a r)))
-> (Point d r :+ a)
-> Identity (Point d r :+ Two (LineSegment d a r))
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra ((a -> Identity (Two (LineSegment d a r)))
 -> (Point d r :+ a)
 -> Identity (Point d r :+ Two (LineSegment d a r)))
-> Two (LineSegment d a r)
-> (Point d r :+ a)
-> Point d r :+ Two (LineSegment d a r)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LineSegment d a r -> LineSegment d a r -> Two (LineSegment d a r)
forall a. a -> a -> Two a
Two ((Point d r :+ a) -> (Point d r :+ a) -> LineSegment d a r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point d r :+ a
p Point d r :+ a
c) ((Point d r :+ a) -> (Point d r :+ a) -> LineSegment d a r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point d r :+ a
c Point d r :+ a
n)
withIncidentEdges (MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs) = SimplePolygon (Two (LineSegment 2 p r)) r
-> [SimplePolygon (Two (LineSegment 2 p r)) r]
-> MultiPolygon (Two (LineSegment 2 p r)) r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon SimplePolygon (Two (LineSegment 2 p r)) r
vs' [SimplePolygon (Two (LineSegment 2 p r)) r]
hs'
  where
    vs' :: SimplePolygon (Two (LineSegment 2 p r)) r
vs' = SimplePolygon p r -> SimplePolygon (Two (LineSegment 2 p r)) r
forall (t :: PolygonType) p r.
Polygon t p r -> Polygon t (Two (LineSegment 2 p r)) r
withIncidentEdges SimplePolygon p r
vs
    hs' :: [SimplePolygon (Two (LineSegment 2 p r)) r]
hs' = (SimplePolygon p r -> SimplePolygon (Two (LineSegment 2 p r)) r)
-> [SimplePolygon p r]
-> [SimplePolygon (Two (LineSegment 2 p r)) r]
forall a b. (a -> b) -> [a] -> [b]
map SimplePolygon p r -> SimplePolygon (Two (LineSegment 2 p r)) r
forall (t :: PolygonType) p r.
Polygon t p r -> Polygon t (Two (LineSegment 2 p r)) r
withIncidentEdges [SimplePolygon p r]
hs

-- -- | Gets the i^th edge on the outer boundary of the polygon, that is the edge
---- with vertices i and i+1 with respect to the current focus. All indices
-- -- modulo n.
-- --

-- FIXME: Test that \poly -> fromEdges (toEdges poly) == poly
-- | Given the vertices of the polygon. Produce a list of edges. The edges are
-- half-open.
toEdges    :: CircularVector (Point 2 r :+ p) -> CircularVector (LineSegment 2 p r)
toEdges :: CircularVector (Point 2 r :+ p)
-> CircularVector (LineSegment 2 p r)
toEdges CircularVector (Point 2 r :+ p)
vs = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (LineSegment 2 p r)
forall a b c.
(a -> b -> c)
-> CircularVector a -> CircularVector b -> CircularVector c
CV.zipWith (\Point 2 r :+ p
p Point 2 r :+ p
q -> 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 ((Point 2 r :+ p) -> EndPoint (Point 2 r :+ p)
forall a. a -> EndPoint a
Closed Point 2 r :+ p
p) ((Point 2 r :+ p) -> EndPoint (Point 2 r :+ p)
forall a. a -> EndPoint a
Open Point 2 r :+ p
q)) CircularVector (Point 2 r :+ p)
vs (Int
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateRight Int
1 CircularVector (Point 2 r :+ p)
vs)

-- | Compute the area of a polygon
area                        :: Fractional r => Polygon t p r -> r
area :: Polygon t p r -> r
area poly :: Polygon t p r
poly@SimplePolygon{} = r -> r
forall a. Num a => a -> a
abs (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$ SimplePolygon p r -> r
forall r p. Fractional r => SimplePolygon p r -> r
signedArea Polygon t p r
SimplePolygon p r
poly
area (MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs) = SimplePolygon p r -> r
forall r (t :: PolygonType) p. Fractional r => Polygon t p r -> r
area SimplePolygon p r
vs r -> r -> r
forall a. Num a => a -> a -> a
- [r] -> r
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [SimplePolygon p r -> r
forall r (t :: PolygonType) p. Fractional r => Polygon t p r -> r
area SimplePolygon p r
h | SimplePolygon p r
h <- [SimplePolygon p r]
hs]


-- | Compute the signed area of a simple polygon. The the vertices are in
-- clockwise order, the signed area will be negative, if the verices are given
-- in counter clockwise order, the area will be positive.
signedArea      :: Fractional r => SimplePolygon p r -> r
signedArea :: SimplePolygon p r -> r
signedArea SimplePolygon p r
poly = SimplePolygon p r -> r
forall r p. Num r => SimplePolygon p r -> r
signedArea2X SimplePolygon p r
poly r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
2

-- | Compute the signed area times 2 of a simple polygon. The the vertices are in
-- clockwise order, the signed area will be negative, if the verices are given
-- in counter clockwise order, the area will be positive.
signedArea2X      :: Num r => SimplePolygon p r -> r
signedArea2X :: SimplePolygon p r -> r
signedArea2X SimplePolygon p r
poly = r
x
  where
    x :: r
x = [r] -> r
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Point 2 r :+ p
p(Point 2 r :+ p) -> Getting r (Point 2 r :+ p) r -> r
forall s a. s -> Getting a s a -> a
^.(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))
-> Getting r (Point 2 r :+ p) r
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.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord r -> r -> r
forall a. Num a => a -> a -> a
* Point 2 r :+ p
q(Point 2 r :+ p) -> Getting r (Point 2 r :+ p) r -> r
forall s a. s -> Getting a s a -> a
^.(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))
-> Getting r (Point 2 r :+ p) r
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 -> r
forall a. Num a => a -> a -> a
- Point 2 r :+ p
q(Point 2 r :+ p) -> Getting r (Point 2 r :+ p) r -> r
forall s a. s -> Getting a s a -> a
^.(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))
-> Getting r (Point 2 r :+ p) r
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.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord r -> r -> r
forall a. Num a => a -> a -> a
* Point 2 r :+ p
p(Point 2 r :+ p) -> Getting r (Point 2 r :+ p) r -> r
forall s a. s -> Getting a s a -> a
^.(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))
-> Getting r (Point 2 r :+ p) r
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
            | LineSegment' Point 2 r :+ p
p Point 2 r :+ p
q <- CircularVector (LineSegment 2 p r) -> [LineSegment 2 p r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (CircularVector (LineSegment 2 p r) -> [LineSegment 2 p r])
-> CircularVector (LineSegment 2 p r) -> [LineSegment 2 p r]
forall a b. (a -> b) -> a -> b
$ SimplePolygon p r -> CircularVector (LineSegment 2 p r)
forall (t :: PolygonType) p r.
Polygon t p r -> CircularVector (LineSegment 2 p r)
outerBoundaryEdges SimplePolygon p r
poly  ]

-- | Compute the centroid of a simple polygon.
centroid      :: Fractional r => SimplePolygon p r -> Point 2 r
centroid :: SimplePolygon p r -> Point 2 r
centroid SimplePolygon p r
poly = Vector 2 r -> Point 2 r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector 2 r -> Point 2 r) -> Vector 2 r -> Point 2 r
forall a b. (a -> b) -> a -> b
$ [Vector 2 r] -> Vector 2 r
sum' [Vector 2 r]
xs Vector 2 r -> r -> Vector 2 r
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ (r
6 r -> r -> r
forall a. Num a => a -> a -> a
* SimplePolygon p r -> r
forall r p. Fractional r => SimplePolygon p r -> r
signedArea SimplePolygon p r
poly)
  where
    xs :: [Vector 2 r]
xs = [ (Point 2 r -> Vector 2 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point 2 r
p Vector 2 r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point 2 r -> Vector 2 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point 2 r
q) Vector 2 r -> r -> Vector 2 r
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (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 r -> r -> r
forall a. Num a => a -> a -> a
* Point 2 r
qPoint 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.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord r -> r -> r
forall a. Num a => a -> a -> a
- Point 2 r
qPoint 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 -> r
forall a. Num a => a -> a -> a
* 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.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord)
         | LineSegment' (Point 2 r
p :+ p
_) (Point 2 r
q :+ p
_) <- CircularVector (LineSegment 2 p r) -> [LineSegment 2 p r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (CircularVector (LineSegment 2 p r) -> [LineSegment 2 p r])
-> CircularVector (LineSegment 2 p r) -> [LineSegment 2 p r]
forall a b. (a -> b) -> a -> b
$ SimplePolygon p r -> CircularVector (LineSegment 2 p r)
forall (t :: PolygonType) p r.
Polygon t p r -> CircularVector (LineSegment 2 p r)
outerBoundaryEdges SimplePolygon p r
poly  ]

    sum' :: [Vector 2 r] -> Vector 2 r
sum' = (Vector 2 r -> Vector 2 r -> Vector 2 r)
-> Vector 2 r -> [Vector 2 r] -> Vector 2 r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Vector 2 r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
(^+^) Vector 2 r
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero


-- | \( O(n) \) Pick a  point that is inside the polygon.
--
-- (note: if the polygon is degenerate; i.e. has <3 vertices, we report a
-- vertex of the polygon instead.)
--
-- pre: the polygon is given in CCW order
pickPoint    :: (Ord r, Fractional r) => Polygon p t r -> Point 2 r
pickPoint :: Polygon p t r -> Point 2 r
pickPoint Polygon p t r
pg | Polygon p t r -> Bool
forall (p :: PolygonType) t r. Polygon p t r -> Bool
isTriangle Polygon p t r
pg = SimplePolygon t r -> Point 2 r
forall r p. Fractional r => SimplePolygon p r -> Point 2 r
centroid (SimplePolygon t r -> Point 2 r) -> SimplePolygon t r -> Point 2 r
forall a b. (a -> b) -> a -> b
$ Polygon p t r
pgPolygon p t r
-> Getting (SimplePolygon t r) (Polygon p t r) (SimplePolygon t r)
-> SimplePolygon t r
forall s a. s -> Getting a s a -> a
^.Getting (SimplePolygon t r) (Polygon p t r) (SimplePolygon t r)
forall (t :: PolygonType) p r.
Lens' (Polygon t p r) (SimplePolygon p r)
outerBoundary
             | Bool
otherwise     = let LineSegment' (Point 2 r
p :+ t
_) (Point 2 r
q :+ t
_) = Polygon p t r -> LineSegment 2 t r
forall r (t :: PolygonType) p.
(Ord r, Fractional r) =>
Polygon t p r -> LineSegment 2 p r
findDiagonal Polygon p t r
pg
                               in Point 2 r
p Point 2 r -> Diff (Point 2) r -> Point 2 r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (r
0.5 r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ (Point 2 r
q Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
p))

-- | \( O(1) \) Test if the polygon is a triangle
isTriangle :: Polygon p t r -> Bool
isTriangle :: Polygon p t r -> Bool
isTriangle = \case
    p :: Polygon p t r
p@SimplePolygon{}  -> CircularVector (Point 2 r :+ t) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length (Polygon p t r
pPolygon p t r
-> Getting
     (CircularVector (Point 2 r :+ t))
     (Polygon p t r)
     (CircularVector (Point 2 r :+ t))
-> CircularVector (Point 2 r :+ t)
forall s a. s -> Getting a s a -> a
^.Getting
  (CircularVector (Point 2 r :+ t))
  (Polygon p t r)
  (CircularVector (Point 2 r :+ t))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
    MultiPolygon SimplePolygon t r
vs [] -> SimplePolygon t r -> Bool
forall (p :: PolygonType) t r. Polygon p t r -> Bool
isTriangle SimplePolygon t r
vs
    MultiPolygon SimplePolygon t r
_  [SimplePolygon t r]
_  -> Bool
False

-- | \( O(n) \) Find a diagonal of the polygon.
--
-- pre: the polygon is given in CCW order
findDiagonal    :: (Ord r, Fractional r) => Polygon t p r -> LineSegment 2 p r
findDiagonal :: Polygon t p r -> LineSegment 2 p r
findDiagonal Polygon t p r
pg = [LineSegment 2 p r] -> LineSegment 2 p r
forall a. [a] -> a
List.head ([LineSegment 2 p r] -> LineSegment 2 p r)
-> (CircularVector (Maybe (LineSegment 2 p r))
    -> [LineSegment 2 p r])
-> CircularVector (Maybe (LineSegment 2 p r))
-> LineSegment 2 p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (LineSegment 2 p r)] -> [LineSegment 2 p r]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (LineSegment 2 p r)] -> [LineSegment 2 p r])
-> (CircularVector (Maybe (LineSegment 2 p r))
    -> [Maybe (LineSegment 2 p r)])
-> CircularVector (Maybe (LineSegment 2 p r))
-> [LineSegment 2 p r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector (Maybe (LineSegment 2 p r))
-> [Maybe (LineSegment 2 p r)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (CircularVector (Maybe (LineSegment 2 p r)) -> LineSegment 2 p r)
-> CircularVector (Maybe (LineSegment 2 p r)) -> LineSegment 2 p r
forall a b. (a -> b) -> a -> b
$ CircularVector (Maybe (LineSegment 2 p r))
diags
     -- note that a diagonal is guaranteed to exist, so the usage of head is safe.
  where
    vs :: CircularVector (Point 2 r :+ p)
vs      = Polygon t p r
pgPolygon t p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (Polygon t p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^.Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector
    diags :: CircularVector (Maybe (LineSegment 2 p r))
diags   = ((Point 2 r :+ p)
 -> (Point 2 r :+ p)
 -> (Point 2 r :+ p)
 -> Maybe (LineSegment 2 p r))
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Maybe (LineSegment 2 p r))
forall a b c d.
(a -> b -> c -> d)
-> CircularVector a
-> CircularVector b
-> CircularVector c
-> CircularVector d
CV.zipWith3 (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> Maybe (LineSegment 2 p r)
f (Int
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateLeft Int
1 CircularVector (Point 2 r :+ p)
vs) CircularVector (Point 2 r :+ p)
vs (Int
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateRight Int
1 CircularVector (Point 2 r :+ p)
vs)
    f :: (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> Maybe (LineSegment 2 p r)
f Point 2 r :+ p
u Point 2 r :+ p
v Point 2 r :+ p
w = 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 :+ p
u(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ p
v(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ p
w(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) of
                CCW
CCW      -> LineSegment 2 p r -> Maybe (LineSegment 2 p r)
forall a. a -> Maybe a
Just (LineSegment 2 p r -> Maybe (LineSegment 2 p r))
-> LineSegment 2 p r -> Maybe (LineSegment 2 p r)
forall a b. (a -> b) -> a -> b
$ (Point 2 r :+ p)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
findDiag Point 2 r :+ p
u Point 2 r :+ p
v Point 2 r :+ p
w
                            -- v is a convex vertex, so find a diagonal
                            -- (either uw) or from v to a point inside the
                            -- triangle
                CCW
CW       -> Maybe (LineSegment 2 p r)
forall a. Maybe a
Nothing -- v is a reflex vertex
                CCW
CoLinear -> Maybe (LineSegment 2 p r)
forall a. Maybe a
Nothing -- colinear vertex!?

    -- we test if uw is a diagonal by figuring out if there is a vertex
    -- strictly inside the triangle t. If there is no such vertex then uw must
    -- be a diagonal (i.e. uw intersects the polygon boundary iff there is a
    -- vtx inside t).  If there are vertices inside the triangle, we find the
    -- one z furthest from the line(segment) uw. It then follows that vz is a
    -- diagonal. Indeed this is pretty much the argument used to prove that any
    -- polygon can be triangulated. See BKOS Chapter 3 for details.
    findDiag :: (Point 2 r :+ p)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
findDiag Point 2 r :+ p
u Point 2 r :+ p
v Point 2 r :+ p
w = let t :: Triangle 2 p r
t  = (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 Point 2 r :+ p
u Point 2 r :+ p
v Point 2 r :+ p
w
                         uw :: LineSegment 2 p r
uw = (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
u Point 2 r :+ p
w
                     in LineSegment 2 p r
-> ((Point 2 r :+ p) -> LineSegment 2 p r)
-> Maybe (Point 2 r :+ p)
-> LineSegment 2 p r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LineSegment 2 p r
uw ((Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
v)
                      (Maybe (Point 2 r :+ p) -> LineSegment 2 p r)
-> (Polygon t p r -> Maybe (Point 2 r :+ p))
-> Polygon t p r
-> LineSegment 2 p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ p) -> r)
-> [Point 2 r :+ p] -> Maybe (Point 2 r :+ p)
forall b a. Ord b => (a -> b) -> [a] -> Maybe a
safeMaximumOn (Line 2 r -> (Point 2 r :+ p) -> r
forall (d :: Nat) r extra.
(ImplicitPeano (Peano d), Fractional r,
 ArityPeano (Peano (FromPeano (Peano d))),
 KnownNat (FromPeano (Peano d)), KnownNat d,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
Line d r -> (Point d r :+ extra) -> r
distTo (Line 2 r -> (Point 2 r :+ p) -> r)
-> Line 2 r -> (Point 2 r :+ p) -> 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
uw)
                      ([Point 2 r :+ p] -> Maybe (Point 2 r :+ p))
-> (Polygon t p r -> [Point 2 r :+ p])
-> Polygon t p r
-> Maybe (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ p) -> Bool) -> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Point 2 r
z :+ p
_) -> Point 2 r
z Point 2 r -> Triangle 2 p r -> PointLocationResult
forall r p.
(Ord r, Fractional r) =>
Point 2 r -> Triangle 2 p r -> PointLocationResult
`inTriangle` Triangle 2 p r
t PointLocationResult -> PointLocationResult -> Bool
forall a. Eq a => a -> a -> Bool
== PointLocationResult
Inside)
                      ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> (Polygon t p r -> [Point 2 r :+ p])
-> Polygon t p r
-> [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p])
-> (Polygon t p r -> NonEmpty (Point 2 r :+ p))
-> Polygon t p r
-> [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Polygon t p r -> NonEmpty (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Polygon t p r -> NonEmpty (Point 2 r :+ p)
polygonVertices
                      (Polygon t p r -> LineSegment 2 p r)
-> Polygon t p r -> LineSegment 2 p r
forall a b. (a -> b) -> a -> b
$ Polygon t p r
pg

    distTo :: Line d r -> (Point d r :+ extra) -> r
distTo Line d r
l (Point d r
z :+ extra
_) = Point d r -> Line d r -> r
forall r (d :: Nat).
(Fractional r, Arity d) =>
Point d r -> Line d r -> r
sqDistanceTo Point d r
z Line d r
l


safeMaximumOn   :: Ord b => (a -> b) -> [a] -> Maybe a
safeMaximumOn :: (a -> b) -> [a] -> Maybe a
safeMaximumOn a -> b
f = \case
  [] -> Maybe a
forall a. Maybe a
Nothing
  [a]
xs -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.maximumBy ((a -> b) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> b
f) [a]
xs


-- | \( O(n) \) Test if the outer boundary of the polygon is in clockwise or counter
-- clockwise order.
isCounterClockwise :: (Eq r, Num r) => Polygon t p r -> Bool
isCounterClockwise :: Polygon t p r -> Bool
isCounterClockwise = (\r
x -> r
x r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r -> r
forall a. Num a => a -> a
abs r
x) (r -> Bool) -> (Polygon t p r -> r) -> Polygon t p r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimplePolygon p r -> r
forall r p. Num r => SimplePolygon p r -> r
signedArea2X (SimplePolygon p r -> r)
-> (Polygon t p r -> SimplePolygon p r) -> Polygon t p r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (SimplePolygon p r) (Polygon t p r) (SimplePolygon p r)
-> Polygon t p r -> SimplePolygon p r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (SimplePolygon p r) (Polygon t p r) (SimplePolygon p r)
forall (t :: PolygonType) p r.
Lens' (Polygon t p r) (SimplePolygon p r)
outerBoundary


-- | \( O(n) \) Make sure that every edge has the polygon's interior on its
-- right, by orienting the outer boundary into clockwise order, and
-- the inner borders (i.e. any holes, if they exist) into
-- counter-clockwise order.
toClockwiseOrder   :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
toClockwiseOrder :: Polygon t p r -> Polygon t p r
toClockwiseOrder Polygon t p r
p = Polygon t p r -> Polygon t p r
forall r (t :: PolygonType) p.
(Eq r, Num r) =>
Polygon t p r -> Polygon t p r
toClockwiseOrder' Polygon t p r
p Polygon t p r -> (Polygon t p r -> Polygon t p r) -> Polygon t p r
forall a b. a -> (a -> b) -> b
& ([Polygon 'Simple p r] -> Identity [Polygon 'Simple p r])
-> Polygon t p r -> Identity (Polygon t p r)
forall (t :: PolygonType) p r.
Traversal' (Polygon t p r) [Polygon 'Simple p r]
polygonHoles'(([Polygon 'Simple p r] -> Identity [Polygon 'Simple p r])
 -> Polygon t p r -> Identity (Polygon t p r))
-> ((Polygon 'Simple p r -> Identity (Polygon 'Simple p r))
    -> [Polygon 'Simple p r] -> Identity [Polygon 'Simple p r])
-> (Polygon 'Simple p r -> Identity (Polygon 'Simple p r))
-> Polygon t p r
-> Identity (Polygon t p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Polygon 'Simple p r -> Identity (Polygon 'Simple p r))
-> [Polygon 'Simple p r] -> Identity [Polygon 'Simple p r]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Polygon 'Simple p r -> Identity (Polygon 'Simple p r))
 -> Polygon t p r -> Identity (Polygon t p r))
-> (Polygon 'Simple p r -> Polygon 'Simple p r)
-> Polygon t p r
-> Polygon t p r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Polygon 'Simple p r -> Polygon 'Simple p r
forall r (t :: PolygonType) p.
(Eq r, Num r) =>
Polygon t p r -> Polygon t p r
toCounterClockWiseOrder'

-- | \( O(n) \) Orient the outer boundary into clockwise order. Leaves any holes
-- as they are.
--
toClockwiseOrder'   :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
toClockwiseOrder' :: Polygon t p r -> Polygon t p r
toClockwiseOrder' Polygon t p r
pg
      | Polygon t p r -> Bool
forall r (t :: PolygonType) p.
(Eq r, Num r) =>
Polygon t p r -> Bool
isCounterClockwise Polygon t p r
pg = Polygon t p r -> Polygon t p r
forall (t :: PolygonType) p r. Polygon t p r -> Polygon t p r
reverseOuterBoundary Polygon t p r
pg
      | Bool
otherwise             = Polygon t p r
pg

-- | \( O(n) \) Make sure that every edge has the polygon's interior on its left,
-- by orienting the outer boundary into counter-clockwise order, and
-- the inner borders (i.e. any holes, if they exist) into clockwise order.
toCounterClockWiseOrder   :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
toCounterClockWiseOrder :: Polygon t p r -> Polygon t p r
toCounterClockWiseOrder Polygon t p r
p =
  Polygon t p r -> Polygon t p r
forall r (t :: PolygonType) p.
(Eq r, Num r) =>
Polygon t p r -> Polygon t p r
toCounterClockWiseOrder' Polygon t p r
p Polygon t p r -> (Polygon t p r -> Polygon t p r) -> Polygon t p r
forall a b. a -> (a -> b) -> b
& ([Polygon 'Simple p r] -> Identity [Polygon 'Simple p r])
-> Polygon t p r -> Identity (Polygon t p r)
forall (t :: PolygonType) p r.
Traversal' (Polygon t p r) [Polygon 'Simple p r]
polygonHoles'(([Polygon 'Simple p r] -> Identity [Polygon 'Simple p r])
 -> Polygon t p r -> Identity (Polygon t p r))
-> ((Polygon 'Simple p r -> Identity (Polygon 'Simple p r))
    -> [Polygon 'Simple p r] -> Identity [Polygon 'Simple p r])
-> (Polygon 'Simple p r -> Identity (Polygon 'Simple p r))
-> Polygon t p r
-> Identity (Polygon t p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Polygon 'Simple p r -> Identity (Polygon 'Simple p r))
-> [Polygon 'Simple p r] -> Identity [Polygon 'Simple p r]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Polygon 'Simple p r -> Identity (Polygon 'Simple p r))
 -> Polygon t p r -> Identity (Polygon t p r))
-> (Polygon 'Simple p r -> Polygon 'Simple p r)
-> Polygon t p r
-> Polygon t p r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Polygon 'Simple p r -> Polygon 'Simple p r
forall r (t :: PolygonType) p.
(Eq r, Num r) =>
Polygon t p r -> Polygon t p r
toClockwiseOrder'

-- | \( O(n) \) Orient the outer boundary into counter-clockwise order. Leaves
-- any holes as they are.
toCounterClockWiseOrder'   :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
toCounterClockWiseOrder' :: Polygon t p r -> Polygon t p r
toCounterClockWiseOrder' Polygon t p r
p
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Polygon t p r -> Bool
forall r (t :: PolygonType) p.
(Eq r, Num r) =>
Polygon t p r -> Bool
isCounterClockwise Polygon t p r
p = Polygon t p r -> Polygon t p r
forall (t :: PolygonType) p r. Polygon t p r -> Polygon t p r
reverseOuterBoundary Polygon t p r
p
      | Bool
otherwise                  = Polygon t p r
p

-- FIXME: Delete this function.
-- | Reorient the outer boundary from clockwise order to counter-clockwise order or
--   from counter-clockwise order to clockwise order. Leaves
--   any holes as they are.
--
reverseOuterBoundary   :: Polygon t p r -> Polygon t p r
reverseOuterBoundary :: Polygon t p r -> Polygon t p r
reverseOuterBoundary Polygon t p r
p = Polygon t p r
pPolygon t p r -> (Polygon t p r -> Polygon t p r) -> Polygon t p r
forall a b. a -> (a -> b) -> b
&(CircularVector (Point 2 r :+ p)
 -> Identity (CircularVector (Point 2 r :+ p)))
-> Polygon t p r -> Identity (Polygon t p r)
forall (t :: PolygonType) p r.
Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p))
unsafeOuterBoundaryVector ((CircularVector (Point 2 r :+ p)
  -> Identity (CircularVector (Point 2 r :+ p)))
 -> Polygon t p r -> Identity (Polygon t p r))
-> (CircularVector (Point 2 r :+ p)
    -> CircularVector (Point 2 r :+ p))
-> Polygon t p r
-> Polygon t p r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
forall a. CircularVector a -> CircularVector a
CV.reverse


-- | assigns unique integer numbers to all vertices. Numbers start from 0, and
-- are increasing along the outer boundary. The vertices of holes
-- will be numbered last, in the same order.
--
-- >>> numberVertices simplePoly
-- SimplePolygon [Point2 0 0 :+ SP 0 (),Point2 10 0 :+ SP 1 (),Point2 10 10 :+ SP 2 (),Point2 5 15 :+ SP 3 (),Point2 1 11 :+ SP 4 ()]
numberVertices :: Polygon t p r -> Polygon t (SP Int p) r
numberVertices :: Polygon t p r -> Polygon t (SP Int p) r
numberVertices = (Int, Polygon t (SP Int p) r) -> Polygon t (SP Int p) r
forall a b. (a, b) -> b
snd ((Int, Polygon t (SP Int p) r) -> Polygon t (SP Int p) r)
-> (Polygon t p r -> (Int, Polygon t (SP Int p) r))
-> Polygon t p r
-> Polygon t (SP Int p) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> p -> (Int, SP Int p))
-> (Int -> r -> (Int, r))
-> Int
-> Polygon t p r
-> (Int, Polygon t (SP Int p) r)
forall (t :: * -> * -> *) a b c d e.
Bitraversable t =>
(a -> b -> (a, c))
-> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e)
bimapAccumL (\Int
a p
p -> (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int -> p -> SP Int p
forall a b. a -> b -> SP a b
SP Int
a p
p)) (,) Int
0
  -- TODO: Make sure that this does not have the same issues as foldl vs foldl'

--------------------------------------------------------------------------------
-- Specialized folds

-- maximum and minimum probably aren't useful. Disabled for now. Lemmih, 2020-12-26.

-- | \( O(n) \) Yield the maximum point of the polygon. Points are compared first by x-coordinate
--   and then by y-coordinate. The maximum point will therefore be the right-most point in
--   the polygon (and top-most if multiple points share the largest x-coordinate).
--
--   Hole vertices are ignored since they cannot be the maximum.
_maximum :: Ord r => Polygon t p r -> Point 2 r :+ p
_maximum :: Polygon t p r -> Point 2 r :+ p
_maximum = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> CircularVector (Point 2 r :+ p) -> Point 2 r :+ p
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.maximumBy (((Point 2 r :+ p) -> Point 2 r)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Point 2 r :+ p) -> Point 2 r
forall core extra. (core :+ extra) -> core
_core) (CircularVector (Point 2 r :+ p) -> Point 2 r :+ p)
-> (Polygon t p r -> CircularVector (Point 2 r :+ p))
-> Polygon t p r
-> Point 2 r :+ p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
-> Polygon t p r -> CircularVector (Point 2 r :+ p)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector

-- | \( O(n) \) Yield the maximum point of a polygon according to the given comparison function.
maximumVertexBy :: (Point 2 r :+ p -> Point 2 r :+ p -> Ordering) -> Polygon t p r -> Point 2 r :+ p
maximumVertexBy :: ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> Polygon t p r -> Point 2 r :+ p
maximumVertexBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn (SimplePolygon Vertices (Point 2 r :+ p)
vs)  = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> Vertices (Point 2 r :+ p) -> Point 2 r :+ p
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.maximumBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn Vertices (Point 2 r :+ p)
vs
maximumVertexBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn (MultiPolygon SimplePolygon p r
b [SimplePolygon p r]
hs) = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> [Point 2 r :+ p] -> Point 2 r :+ p
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.maximumBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn ([Point 2 r :+ p] -> Point 2 r :+ p)
-> [Point 2 r :+ p] -> Point 2 r :+ p
forall a b. (a -> b) -> a -> b
$ (SimplePolygon p r -> Point 2 r :+ p)
-> [SimplePolygon p r] -> [Point 2 r :+ p]
forall a b. (a -> b) -> [a] -> [b]
map (((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> SimplePolygon p r -> Point 2 r :+ p
forall r p (t :: PolygonType).
((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> Polygon t p r -> Point 2 r :+ p
maximumVertexBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn) (SimplePolygon p r
bSimplePolygon p r -> [SimplePolygon p r] -> [SimplePolygon p r]
forall a. a -> [a] -> [a]
:[SimplePolygon p r]
hs)

-- | \( O(n) \) Yield the maximum point of the polygon. Points are compared first by x-coordinate
--   and then by y-coordinate. The minimum point will therefore be the left-most point in
--   the polygon (and bottom-most if multiple points share the smallest x-coordinate).
--
--   Hole vertices are ignored since they cannot be the minimum.
_minimum :: Ord r => Polygon t p r -> Point 2 r :+ p
_minimum :: Polygon t p r -> Point 2 r :+ p
_minimum = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> CircularVector (Point 2 r :+ p) -> Point 2 r :+ p
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.minimumBy (((Point 2 r :+ p) -> Point 2 r)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Point 2 r :+ p) -> Point 2 r
forall core extra. (core :+ extra) -> core
_core) (CircularVector (Point 2 r :+ p) -> Point 2 r :+ p)
-> (Polygon t p r -> CircularVector (Point 2 r :+ p))
-> Polygon t p r
-> Point 2 r :+ p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
-> Polygon t p r -> CircularVector (Point 2 r :+ p)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector

-- | \( O(n) \) Yield the maximum point of a polygon according to the given comparison function.
minimumVertexBy :: (Point 2 r :+ p -> Point 2 r :+ p -> Ordering) -> Polygon t p r -> Point 2 r :+ p
minimumVertexBy :: ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> Polygon t p r -> Point 2 r :+ p
minimumVertexBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn (SimplePolygon Vertices (Point 2 r :+ p)
vs)  = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> Vertices (Point 2 r :+ p) -> Point 2 r :+ p
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.minimumBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn Vertices (Point 2 r :+ p)
vs
minimumVertexBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn (MultiPolygon SimplePolygon p r
b [SimplePolygon p r]
hs) = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> [Point 2 r :+ p] -> Point 2 r :+ p
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.minimumBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn ([Point 2 r :+ p] -> Point 2 r :+ p)
-> [Point 2 r :+ p] -> Point 2 r :+ p
forall a b. (a -> b) -> a -> b
$ (SimplePolygon p r -> Point 2 r :+ p)
-> [SimplePolygon p r] -> [Point 2 r :+ p]
forall a b. (a -> b) -> [a] -> [b]
map (((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> SimplePolygon p r -> Point 2 r :+ p
forall r p (t :: PolygonType).
((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> Polygon t p r -> Point 2 r :+ p
minimumVertexBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
fn) (SimplePolygon p r
bSimplePolygon p r -> [SimplePolygon p r] -> [SimplePolygon p r]
forall a. a -> [a] -> [a]
:[SimplePolygon p r]
hs)

-- | Rotate to the first point that matches the given condition.
--
-- >>> toVector <$> findRotateTo (== (Point2 1 0 :+ ())) (unsafeFromPoints [Point2 0 0 :+ (), Point2 1 0 :+ (), Point2 1 1 :+ ()])
-- Just [Point2 1 0 :+ (),Point2 1 1 :+ (),Point2 0 0 :+ ()]
-- >>> findRotateTo (== (Point2 7 0 :+ ())) $ unsafeFromPoints [Point2 0 0 :+ (), Point2 1 0 :+ (), Point2 1 1 :+ ()]
-- Nothing
findRotateTo :: (Point 2 r :+ p -> Bool) -> SimplePolygon p r -> Maybe (SimplePolygon p r)
findRotateTo :: ((Point 2 r :+ p) -> Bool)
-> SimplePolygon p r -> Maybe (SimplePolygon p r)
findRotateTo (Point 2 r :+ p) -> Bool
fn = (CircularVector (Point 2 r :+ p) -> SimplePolygon p r)
-> Maybe (CircularVector (Point 2 r :+ p))
-> Maybe (SimplePolygon p r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CircularVector (Point 2 r :+ p) -> SimplePolygon p r
forall r p. CircularVector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromCircularVector (Maybe (CircularVector (Point 2 r :+ p))
 -> Maybe (SimplePolygon p r))
-> (SimplePolygon p r -> Maybe (CircularVector (Point 2 r :+ p)))
-> SimplePolygon p r
-> Maybe (SimplePolygon p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ p) -> Bool)
-> CircularVector (Point 2 r :+ p)
-> Maybe (CircularVector (Point 2 r :+ p))
forall a.
(a -> Bool) -> CircularVector a -> Maybe (CircularVector a)
CV.findRotateTo (Point 2 r :+ p) -> Bool
fn (CircularVector (Point 2 r :+ p)
 -> Maybe (CircularVector (Point 2 r :+ p)))
-> (SimplePolygon p r -> CircularVector (Point 2 r :+ p))
-> SimplePolygon p r
-> Maybe (CircularVector (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (CircularVector (Point 2 r :+ p))
  (SimplePolygon p r)
  (CircularVector (Point 2 r :+ p))
-> SimplePolygon p r -> CircularVector (Point 2 r :+ p)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (CircularVector (Point 2 r :+ p))
  (SimplePolygon p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector

--------------------------------------------------------------------------------
-- Rotation

-- | \( O(1) \) Rotate the polygon to the left by n number of points.
rotateLeft :: Int -> SimplePolygon p r -> SimplePolygon p r
rotateLeft :: Int -> SimplePolygon p r -> SimplePolygon p r
rotateLeft Int
n = ASetter
  (SimplePolygon p r)
  (SimplePolygon p r)
  (CircularVector (Point 2 r :+ p))
  (CircularVector (Point 2 r :+ p))
-> (CircularVector (Point 2 r :+ p)
    -> CircularVector (Point 2 r :+ p))
-> SimplePolygon p r
-> SimplePolygon p r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (SimplePolygon p r)
  (SimplePolygon p r)
  (CircularVector (Point 2 r :+ p))
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p))
unsafeOuterBoundaryVector (Int
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateLeft Int
n)

-- | \( O(1) \) Rotate the polygon to the right by n number of points.
rotateRight :: Int -> SimplePolygon p r -> SimplePolygon p r
rotateRight :: Int -> SimplePolygon p r -> SimplePolygon p r
rotateRight Int
n = ASetter
  (SimplePolygon p r)
  (SimplePolygon p r)
  (CircularVector (Point 2 r :+ p))
  (CircularVector (Point 2 r :+ p))
-> (CircularVector (Point 2 r :+ p)
    -> CircularVector (Point 2 r :+ p))
-> SimplePolygon p r
-> SimplePolygon p r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (SimplePolygon p r)
  (SimplePolygon p r)
  (CircularVector (Point 2 r :+ p))
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p))
unsafeOuterBoundaryVector (Int
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateRight Int
n)

--------------------------------------------------------------------------------
-- Testing for reflex or convex

-- | Test if a given vertex is a reflex vertex.
--
-- \(O(1)\)
isReflexVertex      :: (Ord r, Num r) => Int -> Polygon Simple p r -> Bool
isReflexVertex :: Int -> Polygon 'Simple p r -> Bool
isReflexVertex Int
i Polygon 'Simple p r
pg = (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' Point 2 r :+ p
u  Point 2 r :+ p
v Point 2 r :+ p
w CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CW
  where
    u :: Point 2 r :+ p
u = Polygon 'Simple p r
pgPolygon 'Simple p r
-> Getting (Point 2 r :+ p) (Polygon 'Simple p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Int -> Getter (Polygon 'Simple p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    v :: Point 2 r :+ p
v = Polygon 'Simple p r
pgPolygon 'Simple p r
-> Getting (Point 2 r :+ p) (Polygon 'Simple p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Int -> Getter (Polygon 'Simple p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
i
    w :: Point 2 r :+ p
w = Polygon 'Simple p r
pgPolygon 'Simple p r
-> Getting (Point 2 r :+ p) (Polygon 'Simple p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Int -> Getter (Polygon 'Simple p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Test if a given vertex is a convex vertex (i.e. not a reflex vertex).
--
-- \(O(1)\)
isConvexVertex   :: (Ord r, Num r) => Int -> Polygon Simple p r -> Bool
isConvexVertex :: Int -> Polygon 'Simple p r -> Bool
isConvexVertex Int
i = Bool -> Bool
not (Bool -> Bool)
-> (Polygon 'Simple p r -> Bool) -> Polygon 'Simple p r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Polygon 'Simple p r -> Bool
forall r p. (Ord r, Num r) => Int -> Polygon 'Simple p r -> Bool
isReflexVertex Int
i

-- | Test if a given vertex is a strictly convex vertex.
--
-- \(O(1)\)
isStrictlyConvexVertex      :: (Ord r, Num r) => Int -> Polygon t p r -> Bool
isStrictlyConvexVertex :: Int -> Polygon t p r -> Bool
isStrictlyConvexVertex Int
i Polygon t p r
pg = (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' Point 2 r :+ p
u  Point 2 r :+ p
v Point 2 r :+ p
w CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CCW
  where
    u :: Point 2 r :+ p
u = Polygon t p r
pgPolygon t p r
-> Getting (Point 2 r :+ p) (Polygon t p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Int -> Getter (Polygon t p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    v :: Point 2 r :+ p
v = Polygon t p r
pgPolygon t p r
-> Getting (Point 2 r :+ p) (Polygon t p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Int -> Getter (Polygon t p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
i
    w :: Point 2 r :+ p
w = Polygon t p r
pgPolygon t p r
-> Getting (Point 2 r :+ p) (Polygon t p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Int -> Getter (Polygon t p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)


-- | Computes all reflex vertices of the polygon.
--
-- \(O(n)\)
reflexVertices  :: (Ord r, Num r) => Polygon t p r -> [Int :+ (Point 2 r :+ p)]
reflexVertices :: Polygon t p r -> [Int :+ (Point 2 r :+ p)]
reflexVertices p :: Polygon t p r
p@(SimplePolygon Vertices (Point 2 r :+ p)
_)                    = SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
forall r p.
(Ord r, Num r) =>
SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
reflexVertices' Polygon t p r
SimplePolygon p r
p
reflexVertices (Polygon t p r -> Polygon t (SP Int p) r
forall (t :: PolygonType) p r.
Polygon t p r -> Polygon t (SP Int p) r
numberVertices -> MultiPolygon SimplePolygon (SP Int p) r
vs [SimplePolygon (SP Int p) r]
hs) =
  ((Int :+ (Point 2 r :+ SP Int p)) -> Int :+ (Point 2 r :+ p))
-> [Int :+ (Point 2 r :+ SP Int p)] -> [Int :+ (Point 2 r :+ p)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_ :+ (Point 2 r
p :+ SP Int
i p
e)) -> Int
i Int -> (Point 2 r :+ p) -> Int :+ (Point 2 r :+ p)
forall core extra. core -> extra -> core :+ extra
:+ (Point 2 r
p Point 2 r -> p -> Point 2 r :+ p
forall core extra. core -> extra -> core :+ extra
:+ p
e)) ([Int :+ (Point 2 r :+ SP Int p)] -> [Int :+ (Point 2 r :+ p)])
-> [Int :+ (Point 2 r :+ SP Int p)] -> [Int :+ (Point 2 r :+ p)]
forall a b. (a -> b) -> a -> b
$
    SimplePolygon (SP Int p) r -> [Int :+ (Point 2 r :+ SP Int p)]
forall r p.
(Ord r, Num r) =>
SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
reflexVertices' SimplePolygon (SP Int p) r
vs [Int :+ (Point 2 r :+ SP Int p)]
-> [Int :+ (Point 2 r :+ SP Int p)]
-> [Int :+ (Point 2 r :+ SP Int p)]
forall a. Semigroup a => a -> a -> a
<> (SimplePolygon (SP Int p) r -> [Int :+ (Point 2 r :+ SP Int p)])
-> [SimplePolygon (SP Int p) r] -> [Int :+ (Point 2 r :+ SP Int p)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SimplePolygon (SP Int p) r -> [Int :+ (Point 2 r :+ SP Int p)]
forall r p.
(Ord r, Num r) =>
SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
strictlyConvexVertices' [SimplePolygon (SP Int p) r]
hs

-- | Computes all convex (i.e. non-reflex) vertices of the polygon.
--
-- \(O(n)\)
convexVertices :: (Ord r, Num r) => Polygon t p r -> [Int :+ (Point 2 r :+ p)]
convexVertices :: Polygon t p r -> [Int :+ (Point 2 r :+ p)]
convexVertices = \case
  p :: Polygon t p r
p@(SimplePolygon Vertices (Point 2 r :+ p)
_)                    -> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
forall r p.
(Ord r, Num r) =>
SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
convexVertices' Polygon t p r
SimplePolygon p r
p
  (Polygon t p r -> Polygon t (SP Int p) r
forall (t :: PolygonType) p r.
Polygon t p r -> Polygon t (SP Int p) r
numberVertices -> MultiPolygon SimplePolygon (SP Int p) r
vs [SimplePolygon (SP Int p) r]
hs) ->
    ((Int :+ (Point 2 r :+ SP Int p)) -> Int :+ (Point 2 r :+ p))
-> [Int :+ (Point 2 r :+ SP Int p)] -> [Int :+ (Point 2 r :+ p)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_ :+ (Point 2 r
p :+ SP Int
i p
e)) -> Int
i Int -> (Point 2 r :+ p) -> Int :+ (Point 2 r :+ p)
forall core extra. core -> extra -> core :+ extra
:+ (Point 2 r
p Point 2 r -> p -> Point 2 r :+ p
forall core extra. core -> extra -> core :+ extra
:+ p
e)) ([Int :+ (Point 2 r :+ SP Int p)] -> [Int :+ (Point 2 r :+ p)])
-> [Int :+ (Point 2 r :+ SP Int p)] -> [Int :+ (Point 2 r :+ p)]
forall a b. (a -> b) -> a -> b
$
      SimplePolygon (SP Int p) r -> [Int :+ (Point 2 r :+ SP Int p)]
forall r p.
(Ord r, Num r) =>
SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
convexVertices' SimplePolygon (SP Int p) r
vs [Int :+ (Point 2 r :+ SP Int p)]
-> [Int :+ (Point 2 r :+ SP Int p)]
-> [Int :+ (Point 2 r :+ SP Int p)]
forall a. Semigroup a => a -> a -> a
<> (SimplePolygon (SP Int p) r -> [Int :+ (Point 2 r :+ SP Int p)])
-> [SimplePolygon (SP Int p) r] -> [Int :+ (Point 2 r :+ SP Int p)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SimplePolygon (SP Int p) r -> [Int :+ (Point 2 r :+ SP Int p)]
forall r p.
(Ord r, Num r) =>
SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
reflexVertices' [SimplePolygon (SP Int p) r]
hs

-- | Computes all strictly convex vertices of the polygon.
--
-- \(O(n)\)
strictlyConvexVertices :: (Ord r, Num r) => Polygon t p r -> [Int :+ (Point 2 r :+ p)]
strictlyConvexVertices :: Polygon t p r -> [Int :+ (Point 2 r :+ p)]
strictlyConvexVertices = \case
  p :: Polygon t p r
p@(SimplePolygon Vertices (Point 2 r :+ p)
_)                    -> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
forall r p.
(Ord r, Num r) =>
SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
convexVertices' Polygon t p r
SimplePolygon p r
p
  (Polygon t p r -> Polygon t (SP Int p) r
forall (t :: PolygonType) p r.
Polygon t p r -> Polygon t (SP Int p) r
numberVertices -> MultiPolygon SimplePolygon (SP Int p) r
vs [SimplePolygon (SP Int p) r]
hs) ->
    ((Int :+ (Point 2 r :+ SP Int p)) -> Int :+ (Point 2 r :+ p))
-> [Int :+ (Point 2 r :+ SP Int p)] -> [Int :+ (Point 2 r :+ p)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_ :+ (Point 2 r
p :+ SP Int
i p
e)) -> Int
i Int -> (Point 2 r :+ p) -> Int :+ (Point 2 r :+ p)
forall core extra. core -> extra -> core :+ extra
:+ (Point 2 r
p Point 2 r -> p -> Point 2 r :+ p
forall core extra. core -> extra -> core :+ extra
:+ p
e)) ([Int :+ (Point 2 r :+ SP Int p)] -> [Int :+ (Point 2 r :+ p)])
-> [Int :+ (Point 2 r :+ SP Int p)] -> [Int :+ (Point 2 r :+ p)]
forall a b. (a -> b) -> a -> b
$
      SimplePolygon (SP Int p) r -> [Int :+ (Point 2 r :+ SP Int p)]
forall r p.
(Ord r, Num r) =>
SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
strictlyConvexVertices' SimplePolygon (SP Int p) r
vs [Int :+ (Point 2 r :+ SP Int p)]
-> [Int :+ (Point 2 r :+ SP Int p)]
-> [Int :+ (Point 2 r :+ SP Int p)]
forall a. Semigroup a => a -> a -> a
<> (SimplePolygon (SP Int p) r -> [Int :+ (Point 2 r :+ SP Int p)])
-> [SimplePolygon (SP Int p) r] -> [Int :+ (Point 2 r :+ SP Int p)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SimplePolygon (SP Int p) r -> [Int :+ (Point 2 r :+ SP Int p)]
forall r p.
(Ord r, Num r) =>
SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
reflexVertices' [SimplePolygon (SP Int p) r]
hs

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

-- | Return (the indices of) all reflex vertices, in increasing order
-- along the boundary.
--
-- \(O(n)\)
reflexVertices' :: (Ord r, Num r) => SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
reflexVertices' :: SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
reflexVertices' = ((Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> Maybe (Int :+ (Point 2 r :+ p)))
-> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
forall r p.
(Ord r, Num r) =>
((Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> Maybe (Int :+ (Point 2 r :+ p)))
-> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
filterReflexConvexWorker (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> Maybe (Int :+ (Point 2 r :+ p))
forall r core a core b core c.
(Ord r, Num r) =>
(core :+ (Point 2 r :+ a))
-> (core :+ (Point 2 r :+ b))
-> (core :+ (Point 2 r :+ c))
-> Maybe (core :+ (Point 2 r :+ b))
asReflex
  where
    asReflex :: (core :+ (Point 2 r :+ a))
-> (core :+ (Point 2 r :+ b))
-> (core :+ (Point 2 r :+ c))
-> Maybe (core :+ (Point 2 r :+ b))
asReflex core :+ (Point 2 r :+ a)
u core :+ (Point 2 r :+ b)
v core :+ (Point 2 r :+ c)
w | (Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' (core :+ (Point 2 r :+ a)
u(core :+ (Point 2 r :+ a))
-> Getting
     (Point 2 r :+ a) (core :+ (Point 2 r :+ a)) (Point 2 r :+ a)
-> Point 2 r :+ a
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ a) (core :+ (Point 2 r :+ a)) (Point 2 r :+ a)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) (core :+ (Point 2 r :+ b)
v(core :+ (Point 2 r :+ b))
-> Getting
     (Point 2 r :+ b) (core :+ (Point 2 r :+ b)) (Point 2 r :+ b)
-> Point 2 r :+ b
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ b) (core :+ (Point 2 r :+ b)) (Point 2 r :+ b)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) (core :+ (Point 2 r :+ c)
w(core :+ (Point 2 r :+ c))
-> Getting
     (Point 2 r :+ c) (core :+ (Point 2 r :+ c)) (Point 2 r :+ c)
-> Point 2 r :+ c
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ c) (core :+ (Point 2 r :+ c)) (Point 2 r :+ c)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CW = (core :+ (Point 2 r :+ b)) -> Maybe (core :+ (Point 2 r :+ b))
forall a. a -> Maybe a
Just core :+ (Point 2 r :+ b)
v
                   | Bool
otherwise                                   = Maybe (core :+ (Point 2 r :+ b))
forall a. Maybe a
Nothing

-- | Return (the indices of) all strictly convex vertices, in
-- increasing order along the boundary.
--
-- \(O(n)\)
strictlyConvexVertices' :: (Ord r, Num r) => SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
strictlyConvexVertices' :: SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
strictlyConvexVertices' = ((Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> Maybe (Int :+ (Point 2 r :+ p)))
-> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
forall r p.
(Ord r, Num r) =>
((Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> Maybe (Int :+ (Point 2 r :+ p)))
-> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
filterReflexConvexWorker (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> Maybe (Int :+ (Point 2 r :+ p))
forall r core a core b core c.
(Ord r, Num r) =>
(core :+ (Point 2 r :+ a))
-> (core :+ (Point 2 r :+ b))
-> (core :+ (Point 2 r :+ c))
-> Maybe (core :+ (Point 2 r :+ b))
asStrictlyConvex
  where
    asStrictlyConvex :: (core :+ (Point 2 r :+ a))
-> (core :+ (Point 2 r :+ b))
-> (core :+ (Point 2 r :+ c))
-> Maybe (core :+ (Point 2 r :+ b))
asStrictlyConvex core :+ (Point 2 r :+ a)
u core :+ (Point 2 r :+ b)
v core :+ (Point 2 r :+ c)
w | (Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' (core :+ (Point 2 r :+ a)
u(core :+ (Point 2 r :+ a))
-> Getting
     (Point 2 r :+ a) (core :+ (Point 2 r :+ a)) (Point 2 r :+ a)
-> Point 2 r :+ a
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ a) (core :+ (Point 2 r :+ a)) (Point 2 r :+ a)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) (core :+ (Point 2 r :+ b)
v(core :+ (Point 2 r :+ b))
-> Getting
     (Point 2 r :+ b) (core :+ (Point 2 r :+ b)) (Point 2 r :+ b)
-> Point 2 r :+ b
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ b) (core :+ (Point 2 r :+ b)) (Point 2 r :+ b)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) (core :+ (Point 2 r :+ c)
w(core :+ (Point 2 r :+ c))
-> Getting
     (Point 2 r :+ c) (core :+ (Point 2 r :+ c)) (Point 2 r :+ c)
-> Point 2 r :+ c
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ c) (core :+ (Point 2 r :+ c)) (Point 2 r :+ c)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CCW = (core :+ (Point 2 r :+ b)) -> Maybe (core :+ (Point 2 r :+ b))
forall a. a -> Maybe a
Just core :+ (Point 2 r :+ b)
v
                           | Bool
otherwise                                    = Maybe (core :+ (Point 2 r :+ b))
forall a. Maybe a
Nothing

-- | Return (the indices of) all convex (= non-reflex) vertices, in increasing order
-- along the boundary.
--
-- \(O(n)\)
convexVertices' :: (Ord r, Num r) => SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
convexVertices' :: SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
convexVertices' = ((Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> Maybe (Int :+ (Point 2 r :+ p)))
-> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
forall r p.
(Ord r, Num r) =>
((Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> Maybe (Int :+ (Point 2 r :+ p)))
-> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
filterReflexConvexWorker (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> Maybe (Int :+ (Point 2 r :+ p))
forall r core a core b core c.
(Ord r, Num r) =>
(core :+ (Point 2 r :+ a))
-> (core :+ (Point 2 r :+ b))
-> (core :+ (Point 2 r :+ c))
-> Maybe (core :+ (Point 2 r :+ b))
asConvex
  where
    asConvex :: (core :+ (Point 2 r :+ a))
-> (core :+ (Point 2 r :+ b))
-> (core :+ (Point 2 r :+ c))
-> Maybe (core :+ (Point 2 r :+ b))
asConvex core :+ (Point 2 r :+ a)
u core :+ (Point 2 r :+ b)
v core :+ (Point 2 r :+ c)
w | (Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' (core :+ (Point 2 r :+ a)
u(core :+ (Point 2 r :+ a))
-> Getting
     (Point 2 r :+ a) (core :+ (Point 2 r :+ a)) (Point 2 r :+ a)
-> Point 2 r :+ a
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ a) (core :+ (Point 2 r :+ a)) (Point 2 r :+ a)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) (core :+ (Point 2 r :+ b)
v(core :+ (Point 2 r :+ b))
-> Getting
     (Point 2 r :+ b) (core :+ (Point 2 r :+ b)) (Point 2 r :+ b)
-> Point 2 r :+ b
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ b) (core :+ (Point 2 r :+ b)) (Point 2 r :+ b)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) (core :+ (Point 2 r :+ c)
w(core :+ (Point 2 r :+ c))
-> Getting
     (Point 2 r :+ c) (core :+ (Point 2 r :+ c)) (Point 2 r :+ c)
-> Point 2 r :+ c
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ c) (core :+ (Point 2 r :+ c)) (Point 2 r :+ c)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
/= CCW
CW = (core :+ (Point 2 r :+ b)) -> Maybe (core :+ (Point 2 r :+ b))
forall a. a -> Maybe a
Just core :+ (Point 2 r :+ b)
v
                   | Bool
otherwise                                   = Maybe (core :+ (Point 2 r :+ b))
forall a. Maybe a
Nothing

-- | Helper function to implement convexVertices, reflexVertices, and
-- strictlyConvexVertices
filterReflexConvexWorker      :: (Ord r, Num r)
                              => (    Int :+ (Point 2 r :+ p)
                                   -> Int :+ (Point 2 r :+ p)
                                   -> Int :+ (Point 2 r :+ p)
                                   -> Maybe (Int :+ (Point 2 r :+ p))
                                 )
                              -> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
filterReflexConvexWorker :: ((Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> Maybe (Int :+ (Point 2 r :+ p)))
-> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]
filterReflexConvexWorker (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> Maybe (Int :+ (Point 2 r :+ p))
g SimplePolygon p r
pg =
    [Maybe (Int :+ (Point 2 r :+ p))] -> [Int :+ (Point 2 r :+ p)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Int :+ (Point 2 r :+ p))] -> [Int :+ (Point 2 r :+ p)])
-> [Maybe (Int :+ (Point 2 r :+ p))] -> [Int :+ (Point 2 r :+ p)]
forall a b. (a -> b) -> a -> b
$ ((Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> (Int :+ (Point 2 r :+ p))
 -> Maybe (Int :+ (Point 2 r :+ p)))
-> CircularVector (Int :+ (Point 2 r :+ p))
-> CircularVector (Int :+ (Point 2 r :+ p))
-> CircularVector (Int :+ (Point 2 r :+ p))
-> [Maybe (Int :+ (Point 2 r :+ p))]
forall (t :: * -> *) (t :: * -> *) (t :: * -> *) a b c d.
(Foldable t, Foldable t, Foldable t) =>
(a -> b -> c -> d) -> t a -> t b -> t c -> [d]
zip3RWith (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> (Int :+ (Point 2 r :+ p))
-> Maybe (Int :+ (Point 2 r :+ p))
g (Int
-> CircularVector (Int :+ (Point 2 r :+ p))
-> CircularVector (Int :+ (Point 2 r :+ p))
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateLeft Int
1 CircularVector (Int :+ (Point 2 r :+ p))
vs) CircularVector (Int :+ (Point 2 r :+ p))
vs (Int
-> CircularVector (Int :+ (Point 2 r :+ p))
-> CircularVector (Int :+ (Point 2 r :+ p))
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateRight Int
1 CircularVector (Int :+ (Point 2 r :+ p))
vs)
  where
    vs :: CircularVector (Int :+ (Point 2 r :+ p))
vs = CircularVector (Point 2 r :+ p)
-> CircularVector (Int :+ (Point 2 r :+ p))
forall a. CircularVector a -> CircularVector (Int :+ a)
CV.withIndicesRight (CircularVector (Point 2 r :+ p)
 -> CircularVector (Int :+ (Point 2 r :+ p)))
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Int :+ (Point 2 r :+ p))
forall a b. (a -> b) -> a -> b
$ SimplePolygon p r
pgSimplePolygon p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (SimplePolygon p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^.Getting
  (CircularVector (Point 2 r :+ p))
  (SimplePolygon p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector
    zip3RWith :: (a -> b -> c -> d) -> t a -> t b -> t c -> [d]
zip3RWith a -> b -> c -> d
f t a
us' t b
vs' t c
ws' = (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 a -> b -> c -> d
f (t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t a
us') (t b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t b
vs') (t c -> [c]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t c
ws')