{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Polygon.Convex.Internal
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A Simple polygon and some basic functions to interact with them.
--
--------------------------------------------------------------------------------
module HGeometry.Polygon.Convex.Internal
  ( ConvexPolygon
  , ConvexPolygonF(..)
  , fromSimplePolygon
  , _ConvexPolygon
  , _UncheckedConvexPolygon
  , isStrictlyConvex, isConvex
  , verifyConvex
  , maxInDirection
  , findMaxWith
  , inConvex
  , HalfPlaneConvexPolygonIntersection
  ) where

import           Control.DeepSeq (NFData)
import           Control.Lens hiding (holes)
import           Data.Bifunctor
import           Data.Foldable1
import           Data.Functor.Contravariant (phantom)
import           Data.Kind (Type)
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe (mapMaybe)
import           Data.Vector.NonEmpty (NonEmptyVector)
import           HGeometry.Boundary
import           HGeometry.Box
import qualified HGeometry.Box as Box
import           HGeometry.Cyclic
import           HGeometry.Ext
import           HGeometry.Foldable.Util
import           HGeometry.HalfSpace
import           HGeometry.HyperPlane.Class
import           HGeometry.Intersection
import           HGeometry.Line
import           HGeometry.LineSegment
import           HGeometry.LineSegment.PossiblyDegenerate
import           HGeometry.Point
import           HGeometry.Point.Either
import           HGeometry.Polygon.Class
import           HGeometry.Polygon.Convex.Class
import           HGeometry.Polygon.Simple
import           HGeometry.Polygon.Simple.Implementation
import           HGeometry.Polygon.Simple.PossiblyDegenerate
import           HGeometry.Properties
import           HGeometry.Transformation
import           HGeometry.Triangle
import qualified HGeometry.Triangle as Triangle
import           HGeometry.Vector
import           HGeometry.Vector.NonEmpty.Util ()
import           Data.Functor.Classes

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

-- | Convex polygons
newtype ConvexPolygonF f point =
  ConvexPolygon { forall {k} (f :: k -> *) (point :: k).
ConvexPolygonF f point -> SimplePolygonF f point
toSimplePolygon :: SimplePolygonF f point
                -- ^ Convert to a simple polygon, i.e. forget the polygon is convex.
                }
  deriving newtype (ConvexPolygonF f point -> ()
(ConvexPolygonF f point -> ()) -> NFData (ConvexPolygonF f point)
forall a. (a -> ()) -> NFData a
forall k (f :: k -> *) (point :: k).
NFData (f point) =>
ConvexPolygonF f point -> ()
$crnf :: forall k (f :: k -> *) (point :: k).
NFData (f point) =>
ConvexPolygonF f point -> ()
rnf :: ConvexPolygonF f point -> ()
NFData, ConvexPolygonF f point -> ConvexPolygonF f point -> Bool
(ConvexPolygonF f point -> ConvexPolygonF f point -> Bool)
-> (ConvexPolygonF f point -> ConvexPolygonF f point -> Bool)
-> Eq (ConvexPolygonF f point)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (point :: k).
Eq (f point) =>
ConvexPolygonF f point -> ConvexPolygonF f point -> Bool
$c== :: forall k (f :: k -> *) (point :: k).
Eq (f point) =>
ConvexPolygonF f point -> ConvexPolygonF f point -> Bool
== :: ConvexPolygonF f point -> ConvexPolygonF f point -> Bool
$c/= :: forall k (f :: k -> *) (point :: k).
Eq (f point) =>
ConvexPolygonF f point -> ConvexPolygonF f point -> Bool
/= :: ConvexPolygonF f point -> ConvexPolygonF f point -> Bool
Eq, (forall a b. (a -> b) -> ConvexPolygonF f a -> ConvexPolygonF f b)
-> (forall a b. a -> ConvexPolygonF f b -> ConvexPolygonF f a)
-> Functor (ConvexPolygonF f)
forall a b. a -> ConvexPolygonF f b -> ConvexPolygonF f a
forall a b. (a -> b) -> ConvexPolygonF f a -> ConvexPolygonF f b
forall (f :: * -> *) a b.
Functor f =>
a -> ConvexPolygonF f b -> ConvexPolygonF f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> ConvexPolygonF f a -> ConvexPolygonF f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> ConvexPolygonF f a -> ConvexPolygonF f b
fmap :: forall a b. (a -> b) -> ConvexPolygonF f a -> ConvexPolygonF f b
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> ConvexPolygonF f b -> ConvexPolygonF f a
<$ :: forall a b. a -> ConvexPolygonF f b -> ConvexPolygonF f a
Functor, (forall m. Monoid m => ConvexPolygonF f m -> m)
-> (forall m a. Monoid m => (a -> m) -> ConvexPolygonF f a -> m)
-> (forall m a. Monoid m => (a -> m) -> ConvexPolygonF f a -> m)
-> (forall a b. (a -> b -> b) -> b -> ConvexPolygonF f a -> b)
-> (forall a b. (a -> b -> b) -> b -> ConvexPolygonF f a -> b)
-> (forall b a. (b -> a -> b) -> b -> ConvexPolygonF f a -> b)
-> (forall b a. (b -> a -> b) -> b -> ConvexPolygonF f a -> b)
-> (forall a. (a -> a -> a) -> ConvexPolygonF f a -> a)
-> (forall a. (a -> a -> a) -> ConvexPolygonF f a -> a)
-> (forall a. ConvexPolygonF f a -> [a])
-> (forall a. ConvexPolygonF f a -> Bool)
-> (forall a. ConvexPolygonF f a -> Int)
-> (forall a. Eq a => a -> ConvexPolygonF f a -> Bool)
-> (forall a. Ord a => ConvexPolygonF f a -> a)
-> (forall a. Ord a => ConvexPolygonF f a -> a)
-> (forall a. Num a => ConvexPolygonF f a -> a)
-> (forall a. Num a => ConvexPolygonF f a -> a)
-> Foldable (ConvexPolygonF f)
forall a. Eq a => a -> ConvexPolygonF f a -> Bool
forall a. Num a => ConvexPolygonF f a -> a
forall a. Ord a => ConvexPolygonF f a -> a
forall m. Monoid m => ConvexPolygonF f m -> m
forall a. ConvexPolygonF f a -> Bool
forall a. ConvexPolygonF f a -> Int
forall a. ConvexPolygonF f a -> [a]
forall a. (a -> a -> a) -> ConvexPolygonF f a -> a
forall m a. Monoid m => (a -> m) -> ConvexPolygonF f a -> m
forall b a. (b -> a -> b) -> b -> ConvexPolygonF f a -> b
forall a b. (a -> b -> b) -> b -> ConvexPolygonF f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> ConvexPolygonF f a -> Bool
forall (f :: * -> *) a.
(Foldable f, Num a) =>
ConvexPolygonF f a -> a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
ConvexPolygonF f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
ConvexPolygonF f m -> m
forall (f :: * -> *) a. Foldable f => ConvexPolygonF f a -> Bool
forall (f :: * -> *) a. Foldable f => ConvexPolygonF f a -> Int
forall (f :: * -> *) a. Foldable f => ConvexPolygonF f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> ConvexPolygonF f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> ConvexPolygonF f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> ConvexPolygonF f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> ConvexPolygonF f 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
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
ConvexPolygonF f m -> m
fold :: forall m. Monoid m => ConvexPolygonF f m -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> ConvexPolygonF f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ConvexPolygonF f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> ConvexPolygonF f a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ConvexPolygonF f a -> m
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> ConvexPolygonF f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ConvexPolygonF f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> ConvexPolygonF f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ConvexPolygonF f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> ConvexPolygonF f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ConvexPolygonF f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> ConvexPolygonF f a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ConvexPolygonF f a -> b
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> ConvexPolygonF f a -> a
foldr1 :: forall a. (a -> a -> a) -> ConvexPolygonF f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> ConvexPolygonF f a -> a
foldl1 :: forall a. (a -> a -> a) -> ConvexPolygonF f a -> a
$ctoList :: forall (f :: * -> *) a. Foldable f => ConvexPolygonF f a -> [a]
toList :: forall a. ConvexPolygonF f a -> [a]
$cnull :: forall (f :: * -> *) a. Foldable f => ConvexPolygonF f a -> Bool
null :: forall a. ConvexPolygonF f a -> Bool
$clength :: forall (f :: * -> *) a. Foldable f => ConvexPolygonF f a -> Int
length :: forall a. ConvexPolygonF f a -> Int
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> ConvexPolygonF f a -> Bool
elem :: forall a. Eq a => a -> ConvexPolygonF f a -> Bool
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
ConvexPolygonF f a -> a
maximum :: forall a. Ord a => ConvexPolygonF f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
ConvexPolygonF f a -> a
minimum :: forall a. Ord a => ConvexPolygonF f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
ConvexPolygonF f a -> a
sum :: forall a. Num a => ConvexPolygonF f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
ConvexPolygonF f a -> a
product :: forall a. Num a => ConvexPolygonF f a -> a
Foldable, Foldable (ConvexPolygonF f)
Foldable (ConvexPolygonF f) =>
(forall m. Semigroup m => ConvexPolygonF f m -> m)
-> (forall m a. Semigroup m => (a -> m) -> ConvexPolygonF f a -> m)
-> (forall m a. Semigroup m => (a -> m) -> ConvexPolygonF f a -> m)
-> (forall a. ConvexPolygonF f a -> NonEmpty a)
-> (forall a. Ord a => ConvexPolygonF f a -> a)
-> (forall a. Ord a => ConvexPolygonF f a -> a)
-> (forall a. ConvexPolygonF f a -> a)
-> (forall a. ConvexPolygonF f a -> a)
-> (forall a b.
    (a -> b) -> (a -> b -> b) -> ConvexPolygonF f a -> b)
-> (forall a b.
    (a -> b) -> (b -> a -> b) -> ConvexPolygonF f a -> b)
-> (forall a b.
    (a -> b) -> (b -> a -> b) -> ConvexPolygonF f a -> b)
-> (forall a b.
    (a -> b) -> (a -> b -> b) -> ConvexPolygonF f a -> b)
-> Foldable1 (ConvexPolygonF f)
forall a. Ord a => ConvexPolygonF f a -> a
forall m. Semigroup m => ConvexPolygonF f m -> m
forall a. ConvexPolygonF f a -> a
forall a. ConvexPolygonF f a -> NonEmpty a
forall m a. Semigroup m => (a -> m) -> ConvexPolygonF f a -> m
forall a b. (a -> b) -> (a -> b -> b) -> ConvexPolygonF f a -> b
forall a b. (a -> b) -> (b -> a -> b) -> ConvexPolygonF f a -> b
forall (t :: * -> *).
Foldable t =>
(forall m. Semigroup m => t m -> m)
-> (forall m a. Semigroup m => (a -> m) -> t a -> m)
-> (forall m a. Semigroup m => (a -> m) -> t a -> m)
-> (forall a. t a -> NonEmpty a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. t a -> a)
-> (forall a. t a -> a)
-> (forall a b. (a -> b) -> (a -> b -> b) -> t a -> b)
-> (forall a b. (a -> b) -> (b -> a -> b) -> t a -> b)
-> (forall a b. (a -> b) -> (b -> a -> b) -> t a -> b)
-> (forall a b. (a -> b) -> (a -> b -> b) -> t a -> b)
-> Foldable1 t
forall (f :: * -> *). Foldable1 f => Foldable (ConvexPolygonF f)
forall (f :: * -> *) a.
(Foldable1 f, Ord a) =>
ConvexPolygonF f a -> a
forall (f :: * -> *) m.
(Foldable1 f, Semigroup m) =>
ConvexPolygonF f m -> m
forall (f :: * -> *) a. Foldable1 f => ConvexPolygonF f a -> a
forall (f :: * -> *) a.
Foldable1 f =>
ConvexPolygonF f a -> NonEmpty a
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> ConvexPolygonF f a -> m
forall (f :: * -> *) a b.
Foldable1 f =>
(a -> b) -> (a -> b -> b) -> ConvexPolygonF f a -> b
forall (f :: * -> *) a b.
Foldable1 f =>
(a -> b) -> (b -> a -> b) -> ConvexPolygonF f a -> b
$cfold1 :: forall (f :: * -> *) m.
(Foldable1 f, Semigroup m) =>
ConvexPolygonF f m -> m
fold1 :: forall m. Semigroup m => ConvexPolygonF f m -> m
$cfoldMap1 :: forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> ConvexPolygonF f a -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> ConvexPolygonF f a -> m
$cfoldMap1' :: forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> ConvexPolygonF f a -> m
foldMap1' :: forall m a. Semigroup m => (a -> m) -> ConvexPolygonF f a -> m
$ctoNonEmpty :: forall (f :: * -> *) a.
Foldable1 f =>
ConvexPolygonF f a -> NonEmpty a
toNonEmpty :: forall a. ConvexPolygonF f a -> NonEmpty a
$cmaximum :: forall (f :: * -> *) a.
(Foldable1 f, Ord a) =>
ConvexPolygonF f a -> a
maximum :: forall a. Ord a => ConvexPolygonF f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable1 f, Ord a) =>
ConvexPolygonF f a -> a
minimum :: forall a. Ord a => ConvexPolygonF f a -> a
$chead :: forall (f :: * -> *) a. Foldable1 f => ConvexPolygonF f a -> a
head :: forall a. ConvexPolygonF f a -> a
$clast :: forall (f :: * -> *) a. Foldable1 f => ConvexPolygonF f a -> a
last :: forall a. ConvexPolygonF f a -> a
$cfoldrMap1 :: forall (f :: * -> *) a b.
Foldable1 f =>
(a -> b) -> (a -> b -> b) -> ConvexPolygonF f a -> b
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> ConvexPolygonF f a -> b
$cfoldlMap1' :: forall (f :: * -> *) a b.
Foldable1 f =>
(a -> b) -> (b -> a -> b) -> ConvexPolygonF f a -> b
foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> ConvexPolygonF f a -> b
$cfoldlMap1 :: forall (f :: * -> *) a b.
Foldable1 f =>
(a -> b) -> (b -> a -> b) -> ConvexPolygonF f a -> b
foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> ConvexPolygonF f a -> b
$cfoldrMap1' :: forall (f :: * -> *) a b.
Foldable1 f =>
(a -> b) -> (a -> b -> b) -> ConvexPolygonF f a -> b
foldrMap1' :: forall a b. (a -> b) -> (a -> b -> b) -> ConvexPolygonF f a -> b
Foldable1, (forall a. Eq a => Eq (ConvexPolygonF f a)) =>
(forall a b.
 (a -> b -> Bool)
 -> ConvexPolygonF f a -> ConvexPolygonF f b -> Bool)
-> Eq1 (ConvexPolygonF f)
forall a. Eq a => Eq (ConvexPolygonF f a)
forall a b.
(a -> b -> Bool)
-> ConvexPolygonF f a -> ConvexPolygonF f b -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => Eq (ConvexPolygonF f a)
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool)
-> ConvexPolygonF f a -> ConvexPolygonF f b -> Bool
forall (f :: * -> *).
(forall a. Eq a => Eq (f a)) =>
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
$cliftEq :: forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool)
-> ConvexPolygonF f a -> ConvexPolygonF f b -> Bool
liftEq :: forall a b.
(a -> b -> Bool)
-> ConvexPolygonF f a -> ConvexPolygonF f b -> Bool
Eq1)
  deriving stock (Functor (ConvexPolygonF f)
Foldable (ConvexPolygonF f)
(Functor (ConvexPolygonF f), Foldable (ConvexPolygonF f)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ConvexPolygonF f a -> f (ConvexPolygonF f b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ConvexPolygonF f (f a) -> f (ConvexPolygonF f a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ConvexPolygonF f a -> m (ConvexPolygonF f b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ConvexPolygonF f (m a) -> m (ConvexPolygonF f a))
-> Traversable (ConvexPolygonF f)
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 (f :: * -> *). Traversable f => Functor (ConvexPolygonF f)
forall (f :: * -> *). Traversable f => Foldable (ConvexPolygonF f)
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
ConvexPolygonF f (m a) -> m (ConvexPolygonF f a)
forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
ConvexPolygonF f (f a) -> f (ConvexPolygonF f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> ConvexPolygonF f a -> m (ConvexPolygonF f b)
forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> ConvexPolygonF f a -> f (ConvexPolygonF f b)
forall (m :: * -> *) a.
Monad m =>
ConvexPolygonF f (m a) -> m (ConvexPolygonF f a)
forall (f :: * -> *) a.
Applicative f =>
ConvexPolygonF f (f a) -> f (ConvexPolygonF f a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConvexPolygonF f a -> m (ConvexPolygonF f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConvexPolygonF f a -> f (ConvexPolygonF f b)
$ctraverse :: forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> ConvexPolygonF f a -> f (ConvexPolygonF f b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConvexPolygonF f a -> f (ConvexPolygonF f b)
$csequenceA :: forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
ConvexPolygonF f (f a) -> f (ConvexPolygonF f a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ConvexPolygonF f (f a) -> f (ConvexPolygonF f a)
$cmapM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> ConvexPolygonF f a -> m (ConvexPolygonF f b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConvexPolygonF f a -> m (ConvexPolygonF f b)
$csequence :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
ConvexPolygonF f (m a) -> m (ConvexPolygonF f a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ConvexPolygonF f (m a) -> m (ConvexPolygonF f a)
Traversable)


-- | By default we use a cyclic non-empty vector to represent convex polygons.
type ConvexPolygon :: Type -> Type
type ConvexPolygon = ConvexPolygonF (Cyclic NonEmptyVector)

-- | ConvexPolygons are isomorphic to SimplePolygons with the added
--   constraint that all vertices are strictly convex.
--
-- Note that this is unchecked; i.e. one can turn an arbitrary simple polygon
-- into a suposedly convex one.
_UncheckedConvexPolygon :: Iso (ConvexPolygonF f point) (ConvexPolygonF f' point')
                               (SimplePolygonF f point) (SimplePolygonF f' point')
_UncheckedConvexPolygon :: forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon = (ConvexPolygonF f point -> SimplePolygonF f point)
-> (SimplePolygonF f' point' -> ConvexPolygonF f' point')
-> Iso
     (ConvexPolygonF f point)
     (ConvexPolygonF f' point')
     (SimplePolygonF f point)
     (SimplePolygonF f' point')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ConvexPolygonF f point -> SimplePolygonF f point
forall {k} (f :: k -> *) (point :: k).
ConvexPolygonF f point -> SimplePolygonF f point
toSimplePolygon SimplePolygonF f' point' -> ConvexPolygonF f' point'
forall {k} (f :: k -> *) (point :: k).
SimplePolygonF f point -> ConvexPolygonF f point
ConvexPolygon

-- | Prism that can forget that the polygon is convex
--
_ConvexPolygon :: forall f point r. (Num r, Ord r, Point_ point 2 r
                                    , VertexContainer f point
               ) => Prism' (SimplePolygonF f point) (ConvexPolygonF f point)
_ConvexPolygon :: forall (f :: * -> *) point r.
(Num r, Ord r, Point_ point 2 r, VertexContainer f point) =>
Prism' (SimplePolygonF f point) (ConvexPolygonF f point)
_ConvexPolygon = (ConvexPolygonF f point -> SimplePolygonF f point)
-> (SimplePolygonF f point -> Maybe (ConvexPolygonF f point))
-> Prism
     (SimplePolygonF f point)
     (SimplePolygonF f point)
     (ConvexPolygonF f point)
     (ConvexPolygonF f point)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ConvexPolygonF f point -> SimplePolygonF f point
forall {k} (f :: k -> *) (point :: k).
ConvexPolygonF f point -> SimplePolygonF f point
toSimplePolygon SimplePolygonF f point -> Maybe (ConvexPolygonF f point)
forall r point (f :: * -> *).
(Ord r, Num r, Point_ point 2 r, VertexContainer f point) =>
SimplePolygonF f point -> Maybe (ConvexPolygonF f point)
fromSimplePolygon

-- deriving instance Eq (ConvexPolygonF f point r)
-- | Polygons are per definition 2 dimensional
type instance Dimension (ConvexPolygonF f point) = 2
type instance NumType   (ConvexPolygonF f point) = NumType point


instance Traversable1 f => Traversable1 (ConvexPolygonF f) where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> ConvexPolygonF f a -> f (ConvexPolygonF f b)
traverse1 a -> f b
f (ConvexPolygon SimplePolygonF f a
vs) = SimplePolygonF f b -> ConvexPolygonF f b
forall {k} (f :: k -> *) (point :: k).
SimplePolygonF f point -> ConvexPolygonF f point
ConvexPolygon (SimplePolygonF f b -> ConvexPolygonF f b)
-> f (SimplePolygonF f b) -> f (ConvexPolygonF f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> SimplePolygonF f a -> f (SimplePolygonF f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> SimplePolygonF f a -> f (SimplePolygonF f b)
traverse1 a -> f b
f SimplePolygonF f a
vs

instance (ShiftedEq (f point), ElemCyclic (f point) ~ point
         ) => ShiftedEq (ConvexPolygonF f point) where
  type ElemCyclic (ConvexPolygonF f point) = point
  isShiftOf :: Eq (ElemCyclic (ConvexPolygonF f point)) =>
ConvexPolygonF f point -> ConvexPolygonF f point -> Bool
isShiftOf ConvexPolygonF f point
p ConvexPolygonF f point
q = SimplePolygonF f point -> SimplePolygonF f point -> Bool
forall t. (ShiftedEq t, Eq (ElemCyclic t)) => t -> t -> Bool
isShiftOf (ConvexPolygonF f point
pConvexPolygonF f point
-> Getting
     (SimplePolygonF f point)
     (ConvexPolygonF f point)
     (SimplePolygonF f point)
-> SimplePolygonF f point
forall s a. s -> Getting a s a -> a
^.Getting
  (SimplePolygonF f point)
  (ConvexPolygonF f point)
  (SimplePolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon) (ConvexPolygonF f point
qConvexPolygonF f point
-> Getting
     (SimplePolygonF f point)
     (ConvexPolygonF f point)
     (SimplePolygonF f point)
-> SimplePolygonF f point
forall s a. s -> Getting a s a -> a
^.Getting
  (SimplePolygonF f point)
  (ConvexPolygonF f point)
  (SimplePolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon)

instance ( HasVertices (SimplePolygonF f point) (SimplePolygonF f point')
         ) => HasVertices (ConvexPolygonF f point) (ConvexPolygonF f point') where
  vertices :: IndexedTraversal1
  (VertexIx (ConvexPolygonF f point))
  (ConvexPolygonF f point)
  (ConvexPolygonF f point')
  (Vertex (ConvexPolygonF f point))
  (Vertex (ConvexPolygonF f point'))
vertices = (SimplePolygonF f point -> f (SimplePolygonF f point'))
-> ConvexPolygonF f point -> f (ConvexPolygonF f point')
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon ((SimplePolygonF f point -> f (SimplePolygonF f point'))
 -> ConvexPolygonF f point -> f (ConvexPolygonF f point'))
-> (p (Vertex (SimplePolygonF f point))
      (f (Vertex (SimplePolygonF f point')))
    -> SimplePolygonF f point -> f (SimplePolygonF f point'))
-> p (Vertex (SimplePolygonF f point))
     (f (Vertex (SimplePolygonF f point')))
-> ConvexPolygonF f point
-> f (ConvexPolygonF f point')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Vertex (SimplePolygonF f point))
  (f (Vertex (SimplePolygonF f point')))
-> SimplePolygonF f point -> f (SimplePolygonF f point')
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (SimplePolygonF f point))
  (SimplePolygonF f point)
  (SimplePolygonF f point')
  (Vertex (SimplePolygonF f point))
  (Vertex (SimplePolygonF f point'))
vertices

instance ( VertexContainer f point
         ) => HasPoints (ConvexPolygonF f point) (ConvexPolygonF f point') point point' where
  allPoints :: forall (d :: Nat) r r'.
(Point_ point d r, Point_ point' d r',
 NumType (ConvexPolygonF f point) ~ r,
 NumType (ConvexPolygonF f point') ~ r',
 Dimension (ConvexPolygonF f point) ~ d,
 Dimension (ConvexPolygonF f point') ~ d) =>
Traversal1
  (ConvexPolygonF f point) (ConvexPolygonF f point') point point'
allPoints = (SimplePolygonF f point -> f (SimplePolygonF f point'))
-> ConvexPolygonF f point -> f (ConvexPolygonF f point')
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon ((SimplePolygonF f point -> f (SimplePolygonF f point'))
 -> ConvexPolygonF f point -> f (ConvexPolygonF f point'))
-> ((point -> f point')
    -> SimplePolygonF f point -> f (SimplePolygonF f point'))
-> (point -> f point')
-> ConvexPolygonF f point
-> f (ConvexPolygonF f point')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (point -> f point')
-> SimplePolygonF f point -> f (SimplePolygonF f point')
forall (d :: Nat) r r'.
(Point_ point d r, Point_ point' d r',
 NumType (SimplePolygonF f point) ~ r,
 NumType (SimplePolygonF f point') ~ r',
 Dimension (SimplePolygonF f point) ~ d,
 Dimension (SimplePolygonF f point') ~ d) =>
Traversal1
  (SimplePolygonF f point) (SimplePolygonF f point') point point'
forall s t point point' (d :: Nat) r r'.
(HasPoints s t point point', Point_ point d r, Point_ point' d r',
 NumType s ~ r, NumType t ~ r', Dimension s ~ d, Dimension t ~ d) =>
Traversal1 s t point point'
Traversal1
  (SimplePolygonF f point) (SimplePolygonF f point') point point'
allPoints

instance HasVertices' (SimplePolygonF f point) => HasVertices' (ConvexPolygonF f point) where
  type Vertex   (ConvexPolygonF f point) = Vertex   (SimplePolygonF f point)
  type VertexIx (ConvexPolygonF f point) = VertexIx (SimplePolygonF f point)
  vertexAt :: VertexIx (ConvexPolygonF f point)
-> IndexedTraversal'
     (VertexIx (ConvexPolygonF f point))
     (ConvexPolygonF f point)
     (Vertex (ConvexPolygonF f point))
vertexAt VertexIx (ConvexPolygonF f point)
i = (SimplePolygonF f point -> f (SimplePolygonF f point))
-> ConvexPolygonF f point -> f (ConvexPolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon ((SimplePolygonF f point -> f (SimplePolygonF f point))
 -> ConvexPolygonF f point -> f (ConvexPolygonF f point))
-> (p (Vertex (SimplePolygonF f point))
      (f (Vertex (SimplePolygonF f point)))
    -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> p (Vertex (SimplePolygonF f point))
     (f (Vertex (SimplePolygonF f point)))
-> ConvexPolygonF f point
-> f (ConvexPolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexIx (SimplePolygonF f point)
-> IndexedTraversal'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
forall graph.
HasVertices' graph =>
VertexIx graph
-> IndexedTraversal' (VertexIx graph) graph (Vertex graph)
vertexAt VertexIx (SimplePolygonF f point)
VertexIx (ConvexPolygonF f point)
i
  numVertices :: ConvexPolygonF f point -> Int
numVertices = SimplePolygonF f point -> Int
forall graph. HasVertices' graph => graph -> Int
numVertices (SimplePolygonF f point -> Int)
-> (ConvexPolygonF f point -> SimplePolygonF f point)
-> ConvexPolygonF f point
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (SimplePolygonF f point)
  (ConvexPolygonF f point)
  (SimplePolygonF f point)
-> ConvexPolygonF f point -> SimplePolygonF f point
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (SimplePolygonF f point)
  (ConvexPolygonF f point)
  (SimplePolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon

instance ( HasOuterBoundary (SimplePolygonF f point)
         , VertexIx (SimplePolygonF f point) ~ Int
         ) =>
         HasOuterBoundary (ConvexPolygonF f point) where
  outerBoundary :: IndexedTraversal1'
  (VertexIx (ConvexPolygonF f point))
  (ConvexPolygonF f point)
  (Vertex (ConvexPolygonF f point))
outerBoundary = (SimplePolygonF f point -> f (SimplePolygonF f point))
-> ConvexPolygonF f point -> f (ConvexPolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon ((SimplePolygonF f point -> f (SimplePolygonF f point))
 -> ConvexPolygonF f point -> f (ConvexPolygonF f point))
-> (p (Vertex (SimplePolygonF f point))
      (f (Vertex (SimplePolygonF f point)))
    -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> p (Vertex (SimplePolygonF f point))
     (f (Vertex (SimplePolygonF f point)))
-> ConvexPolygonF f point
-> f (ConvexPolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Vertex (SimplePolygonF f point))
  (f (Vertex (SimplePolygonF f point)))
-> SimplePolygonF f point -> f (SimplePolygonF f point)
forall polygon.
HasOuterBoundary polygon =>
IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
IndexedTraversal1'
  (VertexIx (SimplePolygonF f point))
  (SimplePolygonF f point)
  (Vertex (SimplePolygonF f point))
outerBoundary
  outerBoundaryVertexAt :: VertexIx (ConvexPolygonF f point)
-> IndexedGetter
     (VertexIx (ConvexPolygonF f point))
     (ConvexPolygonF f point)
     (Vertex (ConvexPolygonF f point))
outerBoundaryVertexAt VertexIx (ConvexPolygonF f point)
i = (SimplePolygonF f point -> f (SimplePolygonF f point))
-> ConvexPolygonF f point -> f (ConvexPolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon ((SimplePolygonF f point -> f (SimplePolygonF f point))
 -> ConvexPolygonF f point -> f (ConvexPolygonF f point))
-> (p (Vertex (SimplePolygonF f point))
      (f (Vertex (SimplePolygonF f point)))
    -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> p (Vertex (SimplePolygonF f point))
     (f (Vertex (SimplePolygonF f point)))
-> ConvexPolygonF f point
-> f (ConvexPolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexIx (SimplePolygonF f point)
-> IndexedGetter
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
forall polygon.
HasOuterBoundary polygon =>
VertexIx polygon
-> IndexedGetter (VertexIx polygon) polygon (Vertex polygon)
outerBoundaryVertexAt VertexIx (SimplePolygonF f point)
VertexIx (ConvexPolygonF f point)
i
  ccwOuterBoundaryFrom :: VertexIx (ConvexPolygonF f point)
-> IndexedTraversal1'
     (VertexIx (ConvexPolygonF f point))
     (ConvexPolygonF f point)
     (Vertex (ConvexPolygonF f point))
ccwOuterBoundaryFrom VertexIx (ConvexPolygonF f point)
i = (SimplePolygonF f point -> f (SimplePolygonF f point))
-> ConvexPolygonF f point -> f (ConvexPolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon((SimplePolygonF f point -> f (SimplePolygonF f point))
 -> ConvexPolygonF f point -> f (ConvexPolygonF f point))
-> (p (Vertex (SimplePolygonF f point))
      (f (Vertex (SimplePolygonF f point)))
    -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> p (Vertex (SimplePolygonF f point))
     (f (Vertex (SimplePolygonF f point)))
-> ConvexPolygonF f point
-> f (ConvexPolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.VertexIx (SimplePolygonF f point)
-> IndexedTraversal1'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
forall polygon.
HasOuterBoundary polygon =>
VertexIx polygon
-> IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
ccwOuterBoundaryFrom VertexIx (SimplePolygonF f point)
VertexIx (ConvexPolygonF f point)
i
  cwOuterBoundaryFrom :: VertexIx (ConvexPolygonF f point)
-> IndexedTraversal1'
     (VertexIx (ConvexPolygonF f point))
     (ConvexPolygonF f point)
     (Vertex (ConvexPolygonF f point))
cwOuterBoundaryFrom VertexIx (ConvexPolygonF f point)
i = (SimplePolygonF f point -> f (SimplePolygonF f point))
-> ConvexPolygonF f point -> f (ConvexPolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon((SimplePolygonF f point -> f (SimplePolygonF f point))
 -> ConvexPolygonF f point -> f (ConvexPolygonF f point))
-> (p (Vertex (SimplePolygonF f point))
      (f (Vertex (SimplePolygonF f point)))
    -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> p (Vertex (SimplePolygonF f point))
     (f (Vertex (SimplePolygonF f point)))
-> ConvexPolygonF f point
-> f (ConvexPolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.VertexIx (SimplePolygonF f point)
-> IndexedTraversal1'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
forall polygon.
HasOuterBoundary polygon =>
VertexIx polygon
-> IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
cwOuterBoundaryFrom VertexIx (SimplePolygonF f point)
VertexIx (ConvexPolygonF f point)
i

instance HasHoles (ConvexPolygonF f point)

instance ( SimplePolygon_ (SimplePolygonF f point) point r
         , Point_ point 2 r
         ) => Polygon_ (ConvexPolygonF f point) point r where
  extremes :: (Num r, Ord r, Point_ point 2 r) =>
Vector 2 r -> ConvexPolygonF f point -> (point, point)
extremes Vector 2 r
u ConvexPolygonF f point
p = (Vector 2 r -> ConvexPolygonF f point -> point
forall r convexPolygon point.
(Num r, Ord r, ConvexPolygon_ convexPolygon point r) =>
Vector 2 r -> convexPolygon -> point
maxInDirection ((-r
1) r -> Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ Vector 2 r
u) ConvexPolygonF f point
p, Vector 2 r -> ConvexPolygonF f point -> point
forall r convexPolygon point.
(Num r, Ord r, ConvexPolygon_ convexPolygon point r) =>
Vector 2 r -> convexPolygon -> point
maxInDirection Vector 2 r
u ConvexPolygonF f point
p)
  ccwPredecessorOf :: VertexIx (ConvexPolygonF f point)
-> IndexedLens'
     (VertexIx (ConvexPolygonF f point))
     (ConvexPolygonF f point)
     (Vertex (ConvexPolygonF f point))
ccwPredecessorOf VertexIx (ConvexPolygonF f point)
u = (SimplePolygonF f point -> f (SimplePolygonF f point))
-> ConvexPolygonF f point -> f (ConvexPolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon((SimplePolygonF f point -> f (SimplePolygonF f point))
 -> ConvexPolygonF f point -> f (ConvexPolygonF f point))
-> (p point (f point)
    -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> p point (f point)
-> ConvexPolygonF f point
-> f (ConvexPolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.VertexIx (SimplePolygonF f point)
-> IndexedLens'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
forall polygon point r.
Polygon_ polygon point r =>
VertexIx polygon
-> IndexedLens' (VertexIx polygon) polygon (Vertex polygon)
ccwPredecessorOf VertexIx (SimplePolygonF f point)
VertexIx (ConvexPolygonF f point)
u
  ccwSuccessorOf :: VertexIx (ConvexPolygonF f point)
-> IndexedLens'
     (VertexIx (ConvexPolygonF f point))
     (ConvexPolygonF f point)
     (Vertex (ConvexPolygonF f point))
ccwSuccessorOf   VertexIx (ConvexPolygonF f point)
u = (SimplePolygonF f point -> f (SimplePolygonF f point))
-> ConvexPolygonF f point -> f (ConvexPolygonF f point)
forall {k} {k} (f :: k -> *) (point :: k) (f' :: k -> *)
       (point' :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (SimplePolygonF f point) (f (SimplePolygonF f' point'))
-> p (ConvexPolygonF f point) (f (ConvexPolygonF f' point'))
_UncheckedConvexPolygon((SimplePolygonF f point -> f (SimplePolygonF f point))
 -> ConvexPolygonF f point -> f (ConvexPolygonF f point))
-> (p point (f point)
    -> SimplePolygonF f point -> f (SimplePolygonF f point))
-> p point (f point)
-> ConvexPolygonF f point
-> f (ConvexPolygonF f point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.VertexIx (SimplePolygonF f point)
-> IndexedLens'
     (VertexIx (SimplePolygonF f point))
     (SimplePolygonF f point)
     (Vertex (SimplePolygonF f point))
forall polygon point r.
Polygon_ polygon point r =>
VertexIx polygon
-> IndexedLens' (VertexIx polygon) polygon (Vertex polygon)
ccwSuccessorOf VertexIx (SimplePolygonF f point)
VertexIx (ConvexPolygonF f point)
u


instance ( SimplePolygon_ (SimplePolygonF f point) point r
         , Point_ point 2 r
         ) => SimplePolygon_ (ConvexPolygonF f point) point r where
  type ConstructableSimplePolygon (ConvexPolygonF f point) point r =
    ( VertexContainer f point
    , Ord r
    , Num r
    )
  -- | Additional precondition: the points actually form a convex polygon
  uncheckedFromCCWPoints :: forall (f :: * -> *).
Foldable1 f =>
f point -> ConvexPolygonF f point
uncheckedFromCCWPoints = SimplePolygonF f point -> ConvexPolygonF f point
forall {k} (f :: k -> *) (point :: k).
SimplePolygonF f point -> ConvexPolygonF f point
ConvexPolygon (SimplePolygonF f point -> ConvexPolygonF f point)
-> (f point -> SimplePolygonF f point)
-> f point
-> ConvexPolygonF f point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f point -> SimplePolygonF f point
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f point -> SimplePolygonF f point
uncheckedFromCCWPoints
  fromPoints :: forall (f :: * -> *).
(Foldable f,
 ConstructableSimplePolygon (ConvexPolygonF f point) point r) =>
f point -> Maybe (ConvexPolygonF f point)
fromPoints f point
pts = f point -> Maybe (SimplePolygonF f point)
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable f,
 ConstructableSimplePolygon simplePolygon point r) =>
f point -> Maybe simplePolygon
forall (f :: * -> *).
(Foldable f,
 ConstructableSimplePolygon (SimplePolygonF f point) point r) =>
f point -> Maybe (SimplePolygonF f point)
fromPoints f point
pts Maybe (SimplePolygonF f point)
-> (SimplePolygonF f point -> Maybe (ConvexPolygonF f point))
-> Maybe (ConvexPolygonF f point)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SimplePolygonF f point -> Maybe (ConvexPolygonF f point)
forall r point (f :: * -> *).
(Ord r, Num r, Point_ point 2 r, VertexContainer f point) =>
SimplePolygonF f point -> Maybe (ConvexPolygonF f point)
fromSimplePolygon

instance ( SimplePolygon_ (SimplePolygonF f point) point r
         , Point_ point 2 r
         ) => ConvexPolygon_ (ConvexPolygonF f point) point r where


-- | Smart constructor to construct a strictly convex polygon from a
-- simple polygon.
fromSimplePolygon :: (Ord r, Num r, Point_ point 2 r, VertexContainer f point)
                  => SimplePolygonF f point -> Maybe (ConvexPolygonF f point)
fromSimplePolygon :: forall r point (f :: * -> *).
(Ord r, Num r, Point_ point 2 r, VertexContainer f point) =>
SimplePolygonF f point -> Maybe (ConvexPolygonF f point)
fromSimplePolygon SimplePolygonF f point
pg
  | SimplePolygonF f point -> Bool
forall r point (f :: * -> *).
(Ord r, Num r, Point_ point 2 r, VertexContainer f point) =>
SimplePolygonF f point -> Bool
isStrictlyConvex SimplePolygonF f point
pg = ConvexPolygonF f point -> Maybe (ConvexPolygonF f point)
forall a. a -> Maybe a
Just (SimplePolygonF f point -> ConvexPolygonF f point
forall {k} (f :: k -> *) (point :: k).
SimplePolygonF f point -> ConvexPolygonF f point
ConvexPolygon SimplePolygonF f point
pg)
  | Bool
otherwise           = Maybe (ConvexPolygonF f point)
forall a. Maybe a
Nothing


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

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





{-
instance ( SimplePolygon_ (ConvexPolygonF f point) point r
         , SimplePolygon_ (SimplePolygonF f point) point r
         , Ord r, Fractional r)
       => HasSquaredEuclideanDistance (ConvexPolygonF f point) where
  pointClosestToWithDistance q = pointClosestToWithDistance q . toSimplePolygon
  -- TODO: we should be able to implement this in O(log n) time instead!!
-}

instance ( VertexContainer f point
         , DefaultTransformByConstraints (ConvexPolygonF f point) 2 r
         , Point_ point 2 r
         ) => IsTransformable (ConvexPolygonF f point)

instance ( VertexContainer f point
         , Point_ point 2 r, Num r, HasFromFoldable1 f
         ) => IsBoxable (ConvexPolygonF f point) where
  boundingBox :: forall (d :: Nat) r.
(d ~ Dimension (ConvexPolygonF f point),
 r ~ NumType (ConvexPolygonF f point), Ord r) =>
ConvexPolygonF f point -> Box (Point d r)
boundingBox ConvexPolygonF f point
pg = Point d r -> Point d r -> Box (Point d r)
forall point. point -> point -> Box point
Box (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
xMin r
yMin) (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
xMax r
yMax)
    where
      xMin :: r
xMin = Getting r point r -> point -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (r -> Const r r) -> point -> Const r point
Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord (point -> r) -> point -> r
forall a b. (a -> b) -> a -> b
$ Vector 2 r -> ConvexPolygonF f point -> point
forall r convexPolygon point.
(Num r, Ord r, ConvexPolygon_ convexPolygon point r) =>
Vector 2 r -> convexPolygon -> point
maxInDirection (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (-r
1) r
0   ) ConvexPolygonF f point
pg
      xMax :: r
xMax = Getting r point r -> point -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (r -> Const r r) -> point -> Const r point
Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord (point -> r) -> point -> r
forall a b. (a -> b) -> a -> b
$ Vector 2 r -> ConvexPolygonF f point -> point
forall r convexPolygon point.
(Num r, Ord r, ConvexPolygon_ convexPolygon point r) =>
Vector 2 r -> convexPolygon -> point
maxInDirection (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
1    r
0   ) ConvexPolygonF f point
pg
      yMin :: r
yMin = Getting r point r -> point -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (r -> Const r r) -> point -> Const r point
Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord (point -> r) -> point -> r
forall a b. (a -> b) -> a -> b
$ Vector 2 r -> ConvexPolygonF f point -> point
forall r convexPolygon point.
(Num r, Ord r, ConvexPolygon_ convexPolygon point r) =>
Vector 2 r -> convexPolygon -> point
maxInDirection (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
0    (-r
1)) ConvexPolygonF f point
pg
      yMax :: r
yMax = Getting r point r -> point -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (r -> Const r r) -> point -> Const r point
Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord (point -> r) -> point -> r
forall a b. (a -> b) -> a -> b
$ Vector 2 r -> ConvexPolygonF f point -> point
forall r convexPolygon point.
(Num r, Ord r, ConvexPolygon_ convexPolygon point r) =>
Vector 2 r -> convexPolygon -> point
maxInDirection (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
0    r
1   ) ConvexPolygonF f point
pg


instance ( Point_ point 2 r, Num r, Ord r, VertexContainer f point
         , HyperPlane_ line 2 r
         ) => HasIntersectionWith (HalfSpaceF line) (ConvexPolygonF f point) where
  HalfSpaceF line
halfPlane intersects :: HalfSpaceF line -> ConvexPolygonF f point -> Bool
`intersects` ConvexPolygonF f point
poly = HalfSpaceF line
halfPlane HalfSpaceF line -> SimplePolygonF f point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` (ConvexPolygonF f point -> SimplePolygonF f point
forall {k} (f :: k -> *) (point :: k).
ConvexPolygonF f point -> SimplePolygonF f point
toSimplePolygon ConvexPolygonF f point
poly)
    -- TODO there is a better, O(log n) time implementation. use that instead ...

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


-- | Verify that a convex polygon is strictly convex.
--
-- running time \( O(n) \)
verifyConvex :: (Ord r, Num r, Point_ point 2 r, VertexContainer f point)
              => ConvexPolygonF f point -> Bool
verifyConvex :: forall r point (f :: * -> *).
(Ord r, Num r, Point_ point 2 r, VertexContainer f point) =>
ConvexPolygonF f point -> Bool
verifyConvex = SimplePolygonF f point -> Bool
forall r point (f :: * -> *).
(Ord r, Num r, Point_ point 2 r, VertexContainer f point) =>
SimplePolygonF f point -> Bool
isStrictlyConvex (SimplePolygonF f point -> Bool)
-> (ConvexPolygonF f point -> SimplePolygonF f point)
-> ConvexPolygonF f point
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygonF f point -> SimplePolygonF f point
forall {k} (f :: k -> *) (point :: k).
ConvexPolygonF f point -> SimplePolygonF f point
toSimplePolygon

-- | \( O(n) \) Check if a polygon is strictly convex.
isStrictlyConvex :: (Ord r, Num r, Point_ point 2 r, VertexContainer f point)
                 => SimplePolygonF f point -> Bool
isStrictlyConvex :: forall r point (f :: * -> *).
(Ord r, Num r, Point_ point 2 r, VertexContainer f point) =>
SimplePolygonF f point -> Bool
isStrictlyConvex = Getting All (SimplePolygonF f point) (point, (point, point))
-> ((point, (point, point)) -> Bool)
-> SimplePolygonF f point
-> Bool
forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf Getting All (SimplePolygonF f point) (point, (point, point))
((Vertex (SimplePolygonF f point),
  (Vertex (SimplePolygonF f point), Vertex (SimplePolygonF f point)))
 -> Const
      All
      (Vertex (SimplePolygonF f point),
       (Vertex (SimplePolygonF f point),
        Vertex (SimplePolygonF f point))))
-> SimplePolygonF f point -> Const All (SimplePolygonF f point)
forall polygon.
(HasOuterBoundary polygon, VertexIx polygon ~ Int) =>
IndexedFold1
  (VertexIx polygon, (VertexIx polygon, VertexIx polygon))
  polygon
  (Vertex polygon, (Vertex polygon, Vertex polygon))
IndexedFold1
  (VertexIx (SimplePolygonF f point),
   (VertexIx (SimplePolygonF f point),
    VertexIx (SimplePolygonF f point)))
  (SimplePolygonF f point)
  (Vertex (SimplePolygonF f point),
   (Vertex (SimplePolygonF f point), Vertex (SimplePolygonF f point)))
outerBoundaryWithNeighbours (point, (point, point)) -> Bool
forall {point} {point'} {point''}.
(Dimension point ~ 2, Dimension point' ~ 2, Dimension point'' ~ 2,
 NumType point'' ~ NumType point', NumType point' ~ NumType point,
 Point_ point 2 (NumType point), Point_ point' 2 (NumType point),
 Point_ point'' 2 (NumType point), Num (NumType point),
 Ord (NumType point)) =>
(point', (point, point'')) -> Bool
isStrictlyConvexVertex
  where
    isStrictlyConvexVertex :: (point', (point, point'')) -> Bool
isStrictlyConvexVertex (point'
v,(point
u,point''
w)) = point -> point' -> point'' -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw point
u point'
v point''
w CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CCW

-- | \( O(n) \) Check if a polygon is convex.
isConvex   :: (Ord r, Num r, Point_ point 2 r, VertexContainer f point)
           => SimplePolygonF f point -> Bool
isConvex :: forall r point (f :: * -> *).
(Ord r, Num r, Point_ point 2 r, VertexContainer f point) =>
SimplePolygonF f point -> Bool
isConvex = Getting All (SimplePolygonF f point) (point, (point, point))
-> ((point, (point, point)) -> Bool)
-> SimplePolygonF f point
-> Bool
forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf Getting All (SimplePolygonF f point) (point, (point, point))
((Vertex (SimplePolygonF f point),
  (Vertex (SimplePolygonF f point), Vertex (SimplePolygonF f point)))
 -> Const
      All
      (Vertex (SimplePolygonF f point),
       (Vertex (SimplePolygonF f point),
        Vertex (SimplePolygonF f point))))
-> SimplePolygonF f point -> Const All (SimplePolygonF f point)
forall polygon.
(HasOuterBoundary polygon, VertexIx polygon ~ Int) =>
IndexedFold1
  (VertexIx polygon, (VertexIx polygon, VertexIx polygon))
  polygon
  (Vertex polygon, (Vertex polygon, Vertex polygon))
IndexedFold1
  (VertexIx (SimplePolygonF f point),
   (VertexIx (SimplePolygonF f point),
    VertexIx (SimplePolygonF f point)))
  (SimplePolygonF f point)
  (Vertex (SimplePolygonF f point),
   (Vertex (SimplePolygonF f point), Vertex (SimplePolygonF f point)))
outerBoundaryWithNeighbours (point, (point, point)) -> Bool
forall {point} {point'} {point''}.
(Dimension point ~ 2, Dimension point' ~ 2, Dimension point'' ~ 2,
 NumType point'' ~ NumType point', NumType point' ~ NumType point,
 Point_ point 2 (NumType point), Point_ point' 2 (NumType point),
 Point_ point'' 2 (NumType point), Num (NumType point),
 Ord (NumType point)) =>
(point', (point, point'')) -> Bool
isConvexVertex
  where
    isConvexVertex :: (point', (point, point'')) -> Bool
isConvexVertex (point'
v,(point
u,point''
w)) = point -> point' -> point'' -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw point
u point'
v point''
w CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
/= CCW
CW


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

-- | Finds the extreme maximum point in the given direction. Based on
-- http://geomalgorithms.com/a14-_extreme_pts.html
--
--
-- pre: The input polygon is strictly convex.
--
-- running time: \(O(\log n)\)
maxInDirection   :: (Num r, Ord r, ConvexPolygon_ convexPolygon point r)
                 => Vector 2 r -> convexPolygon -> point
maxInDirection :: forall r convexPolygon point.
(Num r, Ord r, ConvexPolygon_ convexPolygon point r) =>
Vector 2 r -> convexPolygon -> point
maxInDirection Vector 2 r
u = (point -> point -> Ordering) -> convexPolygon -> point
forall convexPolygon point r.
ConvexPolygon_ convexPolygon point r =>
(point -> point -> Ordering) -> convexPolygon -> point
findMaxWith (Vector 2 r -> point -> point -> Ordering
forall r point.
(Num r, Ord r, Point_ point 2 r) =>
Vector 2 r -> point -> point -> Ordering
cmpInDirection2 Vector 2 r
u)

-- | Find the maximum vertex in a convex polygon using a binary search.
-- \( O(\log n) \)
findMaxWith        :: (ConvexPolygon_ convexPolygon point r)
                   => (point -> point -> Ordering)
                   -> convexPolygon -> point
findMaxWith :: forall convexPolygon point r.
ConvexPolygon_ convexPolygon point r =>
(point -> point -> Ordering) -> convexPolygon -> point
findMaxWith point -> point -> Ordering
cmp convexPolygon
pg = convexPolygon
pgconvexPolygon -> Getting point convexPolygon point -> point
forall s a. s -> Getting a s a -> a
^.VertexIx convexPolygon
-> IndexedGetter
     (VertexIx convexPolygon) convexPolygon (Vertex convexPolygon)
forall polygon.
HasOuterBoundary polygon =>
VertexIx polygon
-> IndexedGetter (VertexIx polygon) polygon (Vertex polygon)
outerBoundaryVertexAt (Int -> Int -> Int
worker Int
0 Int
n)
  where
    n :: Int
n = convexPolygon -> Int
forall graph. HasVertices' graph => graph -> Int
numVertices convexPolygon
pg
    Int
a icmp :: Int -> Int -> Ordering
`icmp` Int
b = (convexPolygon
pgconvexPolygon -> Getting point convexPolygon point -> point
forall s a. s -> Getting a s a -> a
^.VertexIx convexPolygon
-> IndexedGetter
     (VertexIx convexPolygon) convexPolygon (Vertex convexPolygon)
forall polygon.
HasOuterBoundary polygon =>
VertexIx polygon
-> IndexedGetter (VertexIx polygon) polygon (Vertex polygon)
outerBoundaryVertexAt Int
VertexIx convexPolygon
a) point -> point -> Ordering
`cmp` (convexPolygon
pgconvexPolygon -> Getting point convexPolygon point -> point
forall s a. s -> Getting a s a -> a
^.VertexIx convexPolygon
-> IndexedGetter
     (VertexIx convexPolygon) convexPolygon (Vertex convexPolygon)
forall polygon.
HasOuterBoundary polygon =>
VertexIx polygon
-> IndexedGetter (VertexIx polygon) polygon (Vertex polygon)
outerBoundaryVertexAt Int
VertexIx convexPolygon
b)
    worker :: Int -> Int -> Int
worker Int
a Int
b
      | Int -> Bool
localMaximum Int
c = Int
c
      | Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b         = Int
b
      | Bool
otherwise      =
        case  (Int -> Bool
isUpwards Int
a, Int -> Bool
isUpwards Int
c, Int
c Int -> Int -> Ordering
`icmp` Int
a Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) of
          (Bool
True, Bool
False, Bool
_)      -> Int -> Int -> Int
worker Int
a Int
c -- A is up, C is down, pick [a,c]
          (Bool
True, Bool
True, Bool
True)    -> Int -> Int -> Int
worker Int
c Int
b -- A is up, C is up, C is GTE A, pick [c,b]
          (Bool
True, Bool
True, Bool
False)   -> Int -> Int -> Int
worker Int
a Int
c -- A is up, C is LT A, pick [a,c]
          (Bool
False, Bool
True, Bool
_)      -> Int -> Int -> Int
worker Int
c Int
b -- A is down, C is up, pick [c,b]
          (Bool
False, Bool
False, Bool
False) -> Int -> Int -> Int
worker Int
c Int
b -- A is down, C is down, C is LT A, pick [c,b]
          (Bool
False, Bool
_, Bool
True)      -> Int -> Int -> Int
worker Int
a Int
c -- A is down, C is GTE A, pick [a,c]
      where
        c :: Int
c = (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        localMaximum :: Int -> Bool
localMaximum Int
idx = Int
idx Int -> Int -> Ordering
`icmp` (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Ordering
`icmp` (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
    isUpwards :: Int -> Bool
isUpwards Int
idx = Int
idx Int -> Int -> Ordering
`icmp` (Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT


--------------------------------------------------------------------------------
-- * inConvex

-- 1. Check if p is on left edge or right edge.
-- 2. Do binary search:
--       Find the largest n where p is on the right of 0 to n.
-- 3. Check if p is on segment n,n+1
-- 4. Check if p is in triangle 0,n,n+1

-- | Check if a point lies inside a convex polygon, on the boundary, or outside of the
--   convex polygon.
--
-- \( O(\log n) \)
inConvex :: ( ConvexPolygon_ convexPolygon point r
            , Point_ queryPoint 2 r, Num r, Ord r)
         => queryPoint -> convexPolygon
         -> PointLocationResultWith (VertexIx convexPolygon)
inConvex :: forall convexPolygon point r queryPoint.
(ConvexPolygon_ convexPolygon point r, Point_ queryPoint 2 r,
 Num r, Ord r) =>
queryPoint
-> convexPolygon
-> PointLocationResultWith (VertexIx convexPolygon)
inConvex (Getting (Point 2 r) queryPoint (Point 2 r)
-> queryPoint -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) queryPoint (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' queryPoint (Point 2 r)
asPoint -> Point 2 r
q) convexPolygon
poly
  | Point 2 r
q Point 2 r -> ClosedLineSegment (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` ClosedLineSegment (Point 2 r)
leftEdge  = Int -> PointLocationResultWith Int
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge Int
n
  | Point 2 r
q Point 2 r -> ClosedLineSegment (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` ClosedLineSegment (Point 2 r)
rightEdge = Int -> PointLocationResultWith Int
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge Int
0
  | Bool
otherwise                = Int -> Int -> PointLocationResultWith Int
worker Int
1 Int
n
  where
    n :: Int
n         = convexPolygon -> Int
forall graph. HasVertices' graph => graph -> Int
numVertices convexPolygon
poly Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    point0 :: Point 2 r
point0    = Int -> Point 2 r
point Int
0
    leftEdge :: ClosedLineSegment (Point 2 r)
leftEdge  = Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment Point 2 r
point0 (Int -> Point 2 r
point Int
n)
    rightEdge :: ClosedLineSegment (Point 2 r)
rightEdge = Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment Point 2 r
point0 (Int -> Point 2 r
point Int
1)
    worker :: Int -> Int -> PointLocationResultWith Int
worker Int
a Int
b
      | Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b                        =
        if Point 2 r
q Point 2 r -> ClosedLineSegment (Point 2 r) -> Bool
forall lineSegment (d :: Nat) r point.
(HasOnSegment lineSegment d, Ord r, Point_ point d r,
 r ~ NumType lineSegment, d ~ Dimension lineSegment) =>
point -> lineSegment -> Bool
forall r point.
(Ord r, Point_ point 2 r,
 r ~ NumType (ClosedLineSegment (Point 2 r)),
 2 ~ Dimension (ClosedLineSegment (Point 2 r))) =>
point -> ClosedLineSegment (Point 2 r) -> Bool
`onSegment` Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment (Int -> Point 2 r
point Int
a) (Int -> Point 2 r
point Int
b)
          then Int -> PointLocationResultWith Int
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge Int
a
          else
            if Point 2 r
q Point 2 r -> Triangle (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Point 2 r -> Point 2 r -> Point 2 r -> Triangle (Point 2 r)
forall point. point -> point -> point -> Triangle point
Triangle Point 2 r
point0 (Int -> Point 2 r
point Int
a) (Int -> Point 2 r
point Int
b)
              then PointLocationResultWith Int
forall edge. PointLocationResultWith edge
StrictlyInside
              else PointLocationResultWith Int
forall edge. PointLocationResultWith edge
StrictlyOutside
      | Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw Point 2 r
point0 (Int -> Point 2 r
point Int
c) Point 2 r
q CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CCW = Int -> Int -> PointLocationResultWith Int
worker Int
c Int
b
      | Bool
otherwise                     = Int -> Int -> PointLocationResultWith Int
worker Int
a Int
c
      where c :: Int
c = (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

    point :: Int -> Point 2 r
point Int
x = convexPolygon
polyconvexPolygon
-> Getting (Point 2 r) convexPolygon (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.VertexIx convexPolygon
-> IndexedGetter
     (VertexIx convexPolygon) convexPolygon (Vertex convexPolygon)
forall polygon.
HasOuterBoundary polygon =>
VertexIx polygon
-> IndexedGetter (VertexIx polygon) polygon (Vertex polygon)
outerBoundaryVertexAt Int
VertexIx convexPolygon
x((point -> Const (Point 2 r) point)
 -> convexPolygon -> Const (Point 2 r) convexPolygon)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) convexPolygon (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint

instance ConvexPolygon_ (ConvexPolygonF f point) point r
         => HasInPolygon (ConvexPolygonF f point) point r where
  inPolygon :: forall queryPoint.
(Num r, Ord r, Point_ queryPoint 2 r) =>
queryPoint
-> ConvexPolygonF f point
-> PointLocationResultWith (VertexIx (ConvexPolygonF f point))
inPolygon = queryPoint
-> ConvexPolygonF f point
-> PointLocationResultWith (VertexIx (ConvexPolygonF f point))
forall convexPolygon point r queryPoint.
(ConvexPolygon_ convexPolygon point r, Point_ queryPoint 2 r,
 Num r, Ord r) =>
queryPoint
-> convexPolygon
-> PointLocationResultWith (VertexIx convexPolygon)
inConvex

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

instance ( HasInPolygon (ConvexPolygonF f point) point r, Num r, Ord r)
         => Point 2 r `HasIntersectionWith` ConvexPolygonF f point where
  Point 2 r
q intersects :: Point 2 r -> ConvexPolygonF f point -> Bool
`intersects` ConvexPolygonF f point
poly = Point 2 r
q Point 2 r
-> ConvexPolygonF f point
-> PointLocationResultWith (VertexIx (ConvexPolygonF f point))
forall queryPoint.
(Num r, Ord r, Point_ queryPoint 2 r) =>
queryPoint
-> ConvexPolygonF f point
-> PointLocationResultWith (VertexIx (ConvexPolygonF f point))
forall polygon point r queryPoint.
(HasInPolygon polygon point r, Num r, Ord r,
 Point_ queryPoint 2 r) =>
queryPoint -> polygon -> PointLocationResultWith (VertexIx polygon)
`inPolygon` ConvexPolygonF f point
poly PointLocationResultWith Int -> PointLocationResultWith Int -> Bool
forall a. Eq a => a -> a -> Bool
/= PointLocationResultWith Int
forall edge. PointLocationResultWith edge
StrictlyOutside

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

instance ( HasInPolygon (ConvexPolygonF f point) point r, Num r, Ord r
         ) => Point 2 r `IsIntersectableWith` ConvexPolygonF f point where
  Point 2 r
q intersect :: Point 2 r
-> ConvexPolygonF f point
-> Intersection (Point 2 r) (ConvexPolygonF f point)
`intersect` ConvexPolygonF f point
poly | Point 2 r
q Point 2 r -> ConvexPolygonF f point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` ConvexPolygonF f point
poly = Point 2 r -> Maybe (Point 2 r)
forall a. a -> Maybe a
Just Point 2 r
q
                     | Bool
otherwise           = Maybe (Point 2 r)
Intersection (Point 2 r) (ConvexPolygonF f point)
forall a. Maybe a
Nothing

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

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


type instance Intersection (LinePV 2 r) (ConvexPolygonF nonEmpty vertex) =
  Maybe (PossiblyDegenerateSegment (Point 2 r) (ClosedLineSegment (Point 2 r)))

type instance Intersection (LinePV 2 r)
                           (PossiblyDegenerateSimplePolygon vertex
                              (ConvexPolygonF nonEmpty vertex)) =
  Maybe (PossiblyDegenerateSegment (Point 2 r) (ClosedLineSegment (Point 2 r)))

instance ( Fractional r, Ord r
         , ConvexPolygon_ (ConvexPolygonF nonEmpty vertex) vertex r
         )
         => LinePV 2 r `IsIntersectableWith` ConvexPolygonF nonEmpty vertex where
  LinePV 2 r
l intersect :: LinePV 2 r
-> ConvexPolygonF nonEmpty vertex
-> Intersection (LinePV 2 r) (ConvexPolygonF nonEmpty vertex)
`intersect` ConvexPolygonF nonEmpty vertex
poly = case (LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
 -> Maybe
      (LineLineSegmentIntersection
         (LineSegment
            AnEndPoint (Point (Dimension vertex) (NumType vertex)))))
-> [LineSegment
      AnEndPoint (Point (Dimension vertex) (NumType vertex))]
-> [LineLineSegmentIntersection
      (LineSegment
         AnEndPoint (Point (Dimension vertex) (NumType vertex)))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LinePV 2 r
l LinePV 2 r
-> LineSegment
     AnEndPoint (Point (Dimension vertex) (NumType vertex))
-> Intersection
     (LinePV 2 r)
     (LineSegment
        AnEndPoint (Point (Dimension vertex) (NumType vertex)))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect`) [LineSegment
   AnEndPoint (Point (Dimension vertex) (NumType vertex))]
edgeSegs of
      []      -> Maybe
  (PossiblyDegenerateSegment
     (Point 2 r) (ClosedLineSegment (Point 2 r)))
Intersection (LinePV 2 r) (ConvexPolygonF nonEmpty vertex)
forall a. Maybe a
Nothing
      [LineLineSegmentIntersection
  (LineSegment
     AnEndPoint (Point (Dimension vertex) (NumType vertex)))
ex]    -> PossiblyDegenerateSegment
  (Point 2 (NumType vertex)) (ClosedLineSegment (Point 2 r))
-> Maybe
     (PossiblyDegenerateSegment
        (Point 2 (NumType vertex)) (ClosedLineSegment (Point 2 r)))
forall a. a -> Maybe a
Just (PossiblyDegenerateSegment
   (Point 2 (NumType vertex)) (ClosedLineSegment (Point 2 r))
 -> Maybe
      (PossiblyDegenerateSegment
         (Point 2 (NumType vertex)) (ClosedLineSegment (Point 2 r))))
-> PossiblyDegenerateSegment
     (Point 2 (NumType vertex)) (ClosedLineSegment (Point 2 r))
-> Maybe
     (PossiblyDegenerateSegment
        (Point 2 (NumType vertex)) (ClosedLineSegment (Point 2 r)))
forall a b. (a -> b) -> a -> b
$ case LineLineSegmentIntersection
  (LineSegment
     AnEndPoint (Point (Dimension vertex) (NumType vertex)))
ex of
        Line_x_LineSegment_Point Point
  2
  (NumType
     (LineSegment
        AnEndPoint (Point (Dimension vertex) (NumType vertex))))
p -> Point 2 (NumType vertex)
-> PossiblyDegenerateSegment
     (Point 2 (NumType vertex)) (ClosedLineSegment (Point 2 r))
forall point segment.
point -> PossiblyDegenerateSegment point segment
SinglePoint Point 2 (NumType vertex)
Point
  2
  (NumType
     (LineSegment
        AnEndPoint (Point (Dimension vertex) (NumType vertex))))
p
        Line_x_LineSegment_LineSegment LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
e -> ClosedLineSegment (Point 2 r)
-> PossiblyDegenerateSegment
     (Point 2 (NumType vertex)) (ClosedLineSegment (Point 2 r))
forall point segment.
segment -> PossiblyDegenerateSegment point segment
ActualSegment (LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
-> ClosedLineSegment (Point 2 r)
forall {s} {point}.
(HasStart s point, HasEnd s point) =>
s -> ClosedLineSegment point
asClosed LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
e)
      [LineLineSegmentIntersection
  (LineSegment
     AnEndPoint (Point (Dimension vertex) (NumType vertex)))
e1,LineLineSegmentIntersection
  (LineSegment
     AnEndPoint (Point (Dimension vertex) (NumType vertex)))
e2] -> PossiblyDegenerateSegment
  (Point 2 r) (ClosedLineSegment (Point 2 r))
-> Maybe
     (PossiblyDegenerateSegment
        (Point 2 r) (ClosedLineSegment (Point 2 r)))
forall a. a -> Maybe a
Just (PossiblyDegenerateSegment
   (Point 2 r) (ClosedLineSegment (Point 2 r))
 -> Maybe
      (PossiblyDegenerateSegment
         (Point 2 r) (ClosedLineSegment (Point 2 r))))
-> PossiblyDegenerateSegment
     (Point 2 r) (ClosedLineSegment (Point 2 r))
-> Maybe
     (PossiblyDegenerateSegment
        (Point 2 r) (ClosedLineSegment (Point 2 r)))
forall a b. (a -> b) -> a -> b
$ case LineLineSegmentIntersection
  (LineSegment
     AnEndPoint (Point (Dimension vertex) (NumType vertex)))
e1 of
        Line_x_LineSegment_LineSegment LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
e -> ClosedLineSegment (Point 2 r)
-> PossiblyDegenerateSegment
     (Point 2 r) (ClosedLineSegment (Point 2 r))
forall point segment.
segment -> PossiblyDegenerateSegment point segment
ActualSegment (LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
-> ClosedLineSegment (Point 2 r)
forall {s} {point}.
(HasStart s point, HasEnd s point) =>
s -> ClosedLineSegment point
asClosed LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
e)
        Line_x_LineSegment_Point Point
  2
  (NumType
     (LineSegment
        AnEndPoint (Point (Dimension vertex) (NumType vertex))))
p       -> case LineLineSegmentIntersection
  (LineSegment
     AnEndPoint (Point (Dimension vertex) (NumType vertex)))
e2 of
          Line_x_LineSegment_Point Point
  2
  (NumType
     (LineSegment
        AnEndPoint (Point (Dimension vertex) (NumType vertex))))
q       -> ClosedLineSegment (Point 2 r)
-> PossiblyDegenerateSegment
     (Point 2 r) (ClosedLineSegment (Point 2 r))
forall point segment.
segment -> PossiblyDegenerateSegment point segment
ActualSegment (Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment Point 2 r
Point
  2
  (NumType
     (LineSegment
        AnEndPoint (Point (Dimension vertex) (NumType vertex))))
p Point 2 r
Point
  2
  (NumType
     (LineSegment
        AnEndPoint (Point (Dimension vertex) (NumType vertex))))
q)
          Line_x_LineSegment_LineSegment LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
e -> ClosedLineSegment (Point 2 r)
-> PossiblyDegenerateSegment
     (Point 2 r) (ClosedLineSegment (Point 2 r))
forall point segment.
segment -> PossiblyDegenerateSegment point segment
ActualSegment (LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
-> ClosedLineSegment (Point 2 r)
forall {s} {point}.
(HasStart s point, HasEnd s point) =>
s -> ClosedLineSegment point
asClosed LineSegment AnEndPoint (Point (Dimension vertex) (NumType vertex))
e)
      [LineLineSegmentIntersection
   (LineSegment
      AnEndPoint (Point (Dimension vertex) (NumType vertex)))]
_       -> String
-> Maybe
     (PossiblyDegenerateSegment
        (Point 2 r) (ClosedLineSegment (Point 2 r)))
forall a. HasCallStack => String -> a
error String
"line x convexPolygon intersection. absurd"
    where
      edgeSegs :: [LineSegment
   AnEndPoint (Point (Dimension vertex) (NumType vertex))]
edgeSegs = ClosedLineSegment vertex
-> LineSegment
     AnEndPoint (Point (Dimension vertex) (NumType vertex))
forall {p} {p} {s}.
(Dimension p ~ Dimension p, NumType p ~ NumType p, HasStart s p,
 HasEnd s p, Point_ p (Dimension p) (NumType p),
 Point_ p (Dimension p) (NumType p)) =>
s -> LineSegment AnEndPoint (Point (Dimension p) (NumType p))
asHalfOpen (ClosedLineSegment vertex
 -> LineSegment
      AnEndPoint (Point (Dimension vertex) (NumType vertex)))
-> [ClosedLineSegment vertex]
-> [LineSegment
      AnEndPoint (Point (Dimension vertex) (NumType vertex))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConvexPolygonF nonEmpty vertex
polyConvexPolygonF nonEmpty vertex
-> Getting
     (Endo [ClosedLineSegment vertex])
     (ConvexPolygonF nonEmpty vertex)
     (ClosedLineSegment vertex)
-> [ClosedLineSegment vertex]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting
  (Endo [ClosedLineSegment vertex])
  (ConvexPolygonF nonEmpty vertex)
  (ClosedLineSegment vertex)
forall polygon point r.
(HasOuterBoundary polygon, Vertex polygon ~ point,
 Point_ point 2 r) =>
IndexedFold1
  (VertexIx polygon, VertexIx polygon)
  polygon
  (ClosedLineSegment point)
IndexedFold1
  (VertexIx (ConvexPolygonF nonEmpty vertex),
   VertexIx (ConvexPolygonF nonEmpty vertex))
  (ConvexPolygonF nonEmpty vertex)
  (ClosedLineSegment vertex)
outerBoundaryEdgeSegments
      asHalfOpen :: s -> LineSegment AnEndPoint (Point (Dimension p) (NumType p))
asHalfOpen s
s = AnEndPoint (Point (Dimension p) (NumType p))
-> AnEndPoint (Point (Dimension p) (NumType p))
-> LineSegment AnEndPoint (Point (Dimension p) (NumType p))
forall (endPoint :: * -> *) point.
endPoint point -> endPoint point -> LineSegment endPoint point
LineSegment (Point (Dimension p) (NumType p)
-> AnEndPoint (Point (Dimension p) (NumType p))
forall r. r -> AnEndPoint r
AnOpenE (s
ss
-> Getting
     (Point (Dimension p) (NumType p))
     s
     (Point (Dimension p) (NumType p))
-> Point (Dimension p) (NumType p)
forall s a. s -> Getting a s a -> a
^.(p -> Const (Point (Dimension p) (NumType p)) p)
-> s -> Const (Point (Dimension p) (NumType p)) s
forall seg p. HasStart seg p => Lens' seg p
Lens' s p
start((p -> Const (Point (Dimension p) (NumType p)) p)
 -> s -> Const (Point (Dimension p) (NumType p)) s)
-> ((Point (Dimension p) (NumType p)
     -> Const
          (Point (Dimension p) (NumType p))
          (Point (Dimension p) (NumType p)))
    -> p -> Const (Point (Dimension p) (NumType p)) p)
-> Getting
     (Point (Dimension p) (NumType p))
     s
     (Point (Dimension p) (NumType p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point (Dimension p) (NumType p)
 -> Const
      (Point (Dimension p) (NumType p))
      (Point (Dimension p) (NumType p)))
-> p -> Const (Point (Dimension p) (NumType p)) p
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' p (Point (Dimension p) (NumType p))
asPoint)) (Point (Dimension p) (NumType p)
-> AnEndPoint (Point (Dimension p) (NumType p))
forall r. r -> AnEndPoint r
AnClosedE (s
ss
-> Getting
     (Point (Dimension p) (NumType p))
     s
     (Point (Dimension p) (NumType p))
-> Point (Dimension p) (NumType p)
forall s a. s -> Getting a s a -> a
^.(p -> Const (Point (Dimension p) (NumType p)) p)
-> s -> Const (Point (Dimension p) (NumType p)) s
forall seg p. HasEnd seg p => Lens' seg p
Lens' s p
end((p -> Const (Point (Dimension p) (NumType p)) p)
 -> s -> Const (Point (Dimension p) (NumType p)) s)
-> ((Point (Dimension p) (NumType p)
     -> Const
          (Point (Dimension p) (NumType p))
          (Point (Dimension p) (NumType p)))
    -> p -> Const (Point (Dimension p) (NumType p)) p)
-> Getting
     (Point (Dimension p) (NumType p))
     s
     (Point (Dimension p) (NumType p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point (Dimension p) (NumType p)
 -> Const
      (Point (Dimension p) (NumType p))
      (Point (Dimension p) (NumType p)))
-> p -> Const (Point (Dimension p) (NumType p)) p
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' p (Point (Dimension p) (NumType p))
asPoint))
      asClosed :: s -> ClosedLineSegment point
asClosed s
s   = point -> point -> ClosedLineSegment point
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment (s
ss -> Getting point s point -> point
forall s a. s -> Getting a s a -> a
^.Getting point s point
forall seg p. HasStart seg p => Lens' seg p
Lens' s point
start) (s
ss -> Getting point s point -> point
forall s a. s -> Getting a s a -> a
^.Getting point s point
forall seg p. HasEnd seg p => Lens' seg p
Lens' s point
end)


instance ( Fractional r, Ord r
         , ConvexPolygon_ (ConvexPolygonF nonEmpty vertex) vertex r
         )
          => LinePV 2 r `IsIntersectableWith`
               PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF nonEmpty vertex) where
  intersect :: LinePV 2 r
-> PossiblyDegenerateSimplePolygon
     vertex (ConvexPolygonF nonEmpty vertex)
-> Intersection
     (LinePV 2 r)
     (PossiblyDegenerateSimplePolygon
        vertex (ConvexPolygonF nonEmpty vertex))
intersect LinePV 2 r
l = \case
    DegenerateVertex vertex
v
     | vertex
v vertex -> LinePV 2 r -> Bool
forall line (d :: Nat) point r.
(HasOnLine line d, Point_ point d r, Num r, Eq r, r ~ NumType line,
 d ~ Dimension line) =>
point -> line -> Bool
forall point r.
(Point_ point 2 r, Num r, Eq r, r ~ NumType (LinePV 2 r),
 2 ~ Dimension (LinePV 2 r)) =>
point -> LinePV 2 r -> Bool
`onLine` LinePV 2 r
l    -> PossiblyDegenerateSegment
  (Point 2 r) (LineSegment (EndPoint 'Closed) (Point 2 r))
-> Maybe
     (PossiblyDegenerateSegment
        (Point 2 r) (LineSegment (EndPoint 'Closed) (Point 2 r)))
forall a. a -> Maybe a
Just (PossiblyDegenerateSegment
   (Point 2 r) (LineSegment (EndPoint 'Closed) (Point 2 r))
 -> Maybe
      (PossiblyDegenerateSegment
         (Point 2 r) (LineSegment (EndPoint 'Closed) (Point 2 r))))
-> PossiblyDegenerateSegment
     (Point 2 r) (LineSegment (EndPoint 'Closed) (Point 2 r))
-> Maybe
     (PossiblyDegenerateSegment
        (Point 2 r) (LineSegment (EndPoint 'Closed) (Point 2 r)))
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> PossiblyDegenerateSegment
     (Point 2 r) (LineSegment (EndPoint 'Closed) (Point 2 r))
forall point segment.
point -> PossiblyDegenerateSegment point segment
SinglePoint (vertex
vvertex -> Getting (Point 2 r) vertex (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) vertex (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' vertex (Point 2 r)
asPoint)
     | Bool
otherwise       -> Maybe
  (PossiblyDegenerateSegment
     (Point 2 r) (LineSegment (EndPoint 'Closed) (Point 2 r)))
Intersection
  (LinePV 2 r)
  (PossiblyDegenerateSimplePolygon
     vertex (ConvexPolygonF nonEmpty vertex))
forall a. Maybe a
Nothing
    DegenerateEdge ClosedLineSegment vertex
e   -> (LineLineSegmentIntersection
   (LineSegment (EndPoint 'Closed) (Point 2 r))
 -> PossiblyDegenerateSegment
      (Point 2 (NumType (LineSegment (EndPoint 'Closed) (Point 2 r))))
      (LineSegment (EndPoint 'Closed) (Point 2 r)))
-> Maybe
     (LineLineSegmentIntersection
        (LineSegment (EndPoint 'Closed) (Point 2 r)))
-> Maybe
     (PossiblyDegenerateSegment
        (Point 2 (NumType (LineSegment (EndPoint 'Closed) (Point 2 r))))
        (LineSegment (EndPoint 'Closed) (Point 2 r)))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LineLineSegmentIntersection
  (LineSegment (EndPoint 'Closed) (Point 2 r))
-> PossiblyDegenerateSegment
     (Point 2 (NumType (LineSegment (EndPoint 'Closed) (Point 2 r))))
     (LineSegment (EndPoint 'Closed) (Point 2 r))
forall seg.
LineLineSegmentIntersection seg
-> PossiblyDegenerateSegment (Point 2 (NumType seg)) seg
wrap (Maybe
   (LineLineSegmentIntersection
      (LineSegment (EndPoint 'Closed) (Point 2 r)))
 -> Maybe
      (PossiblyDegenerateSegment
         (Point 2 (NumType (LineSegment (EndPoint 'Closed) (Point 2 r))))
         (LineSegment (EndPoint 'Closed) (Point 2 r))))
-> Maybe
     (LineLineSegmentIntersection
        (LineSegment (EndPoint 'Closed) (Point 2 r)))
-> Maybe
     (PossiblyDegenerateSegment
        (Point 2 (NumType (LineSegment (EndPoint 'Closed) (Point 2 r))))
        (LineSegment (EndPoint 'Closed) (Point 2 r)))
forall a b. (a -> b) -> a -> b
$ LinePV 2 r
l LinePV 2 r
-> LineSegment (EndPoint 'Closed) (Point 2 r)
-> Intersection
     (LinePV 2 r) (LineSegment (EndPoint 'Closed) (Point 2 r))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` (Getting (Point 2 r) vertex (Point 2 r) -> vertex -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) vertex (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' vertex (Point 2 r)
asPoint (vertex -> Point 2 r)
-> ClosedLineSegment vertex
-> LineSegment (EndPoint 'Closed) (Point 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClosedLineSegment vertex
e)
    ActualPolygon ConvexPolygonF nonEmpty vertex
poly -> LinePV 2 r
l LinePV 2 r
-> ConvexPolygonF nonEmpty vertex
-> Intersection (LinePV 2 r) (ConvexPolygonF nonEmpty vertex)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` ConvexPolygonF nonEmpty vertex
poly

wrap :: LineLineSegmentIntersection seg
     -> PossiblyDegenerateSegment (Point 2 (NumType seg)) seg
wrap :: forall seg.
LineLineSegmentIntersection seg
-> PossiblyDegenerateSegment (Point 2 (NumType seg)) seg
wrap = \case
  Line_x_LineSegment_Point Point 2 (NumType seg)
p         -> Point 2 (NumType seg)
-> PossiblyDegenerateSegment (Point 2 (NumType seg)) seg
forall point segment.
point -> PossiblyDegenerateSegment point segment
SinglePoint Point 2 (NumType seg)
p
  Line_x_LineSegment_LineSegment seg
seg -> seg -> PossiblyDegenerateSegment (Point 2 (NumType seg)) seg
forall point segment.
segment -> PossiblyDegenerateSegment point segment
ActualSegment seg
seg
-- TODO: Unify these types

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

-- | A HalfPlane and a Convex polygon intersect in a single component, which is a
-- possiblyDegenerate convex polygon.
type instance Intersection (HalfSpaceF line) (ConvexPolygonF f point) =
  Maybe (HalfPlaneConvexPolygonIntersection f (NumType point) point)

-- | A single Component of a HalfPlane x ConvexPolygon intersection.
type HalfPlaneConvexPolygonIntersection f r vertex =
  PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))

-- | If we drag along extra information in the halfplane polygon intersection we lose it
type instance Intersection (HalfSpaceF line :+ extra) (ConvexPolygonF f point :+ extra') =
  Intersection (HalfSpaceF line) (ConvexPolygonF f point)


--------------------------------------------------------------------------------
-- * Intersection between Points  and possibly degenerate convex polygons

instance ( Point_ vertex 2 r, Num r, Ord r, VertexContainer f vertex
         , HyperPlane_ line 2 r
         ) => HalfSpaceF line `HasIntersectionWith`
              PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex) where
  HalfSpaceF line
halfSpace intersects :: HalfSpaceF line
-> PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex)
-> Bool
`intersects` PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex)
degenPoly = case PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex)
degenPoly of
    DegenerateVertex vertex
v -> (vertex
vvertex -> Getting (Point 2 r) vertex (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) vertex (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' vertex (Point 2 r)
asPoint) Point 2 r -> HalfSpaceF line -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfSpaceF line
halfSpace
    DegenerateEdge ClosedLineSegment vertex
e   -> ClosedLineSegment vertex
e ClosedLineSegment vertex -> HalfSpaceF line -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfSpaceF line
halfSpace
    ActualPolygon ConvexPolygonF f vertex
poly -> HalfSpaceF line
halfSpace HalfSpaceF line -> ConvexPolygonF f vertex -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` ConvexPolygonF f vertex
poly

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

instance ( IsIntersectableWith (HalfSpaceF line) (ConvexPolygonF f vertex)
         , HasIntersectionWith (HalfSpaceF line :+ extra) (ConvexPolygonF f vertex :+ extra')
         ) => IsIntersectableWith (HalfSpaceF line :+ extra)
                                  (ConvexPolygonF f vertex :+ extra') where
  (HalfSpaceF line
halfPlane :+ extra
_) intersect :: (HalfSpaceF line :+ extra)
-> (ConvexPolygonF f vertex :+ extra')
-> Intersection
     (HalfSpaceF line :+ extra) (ConvexPolygonF f vertex :+ extra')
`intersect` (ConvexPolygonF f vertex
poly :+ extra'
_) = HalfSpaceF line
halfPlane HalfSpaceF line
-> ConvexPolygonF f vertex
-> Intersection (HalfSpaceF line) (ConvexPolygonF f vertex)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` ConvexPolygonF f vertex
poly

instance ( Point_ vertex 2 r, Fractional r, Ord r, VertexContainer f vertex
         , VertexContainer f (OriginalOrExtra vertex (Point 2 r))
         , HasFromFoldable1 f
         ) => IsIntersectableWith (HalfSpaceF (LinePV 2 r)) (ConvexPolygonF f vertex) where
  HalfSpaceF (LinePV 2 r)
halfPlane intersect :: HalfSpaceF (LinePV 2 r)
-> ConvexPolygonF f vertex
-> Intersection (HalfSpaceF (LinePV 2 r)) (ConvexPolygonF f vertex)
`intersect` ConvexPolygonF f vertex
poly = case [HalfPlaneConvexPolygonIntersection f r vertex]
comps of
      []  -> Maybe (HalfPlaneConvexPolygonIntersection f r vertex)
Intersection (HalfSpaceF (LinePV 2 r)) (ConvexPolygonF f vertex)
forall a. Maybe a
Nothing
      [HalfPlaneConvexPolygonIntersection f r vertex
c] -> HalfPlaneConvexPolygonIntersection f r vertex
-> Maybe (HalfPlaneConvexPolygonIntersection f r vertex)
forall a. a -> Maybe a
Just HalfPlaneConvexPolygonIntersection f r vertex
c
      [HalfPlaneConvexPolygonIntersection f r vertex]
_   -> String -> Maybe (HalfPlaneConvexPolygonIntersection f r vertex)
forall a. HasCallStack => String -> a
error String
"halfplane x convexPolygon intersection: absurd."
    where
      comps :: [HalfPlaneConvexPolygonIntersection f r vertex]
comps = LinePV 2 r
-> Cyclic NonEmpty (Bool, NonEmpty vertex)
-> [HalfPlaneConvexPolygonIntersection f r vertex]
forall (cyclic :: * -> *) (f :: * -> *) vertex r.
(Point_ vertex 2 r, Ord r, Fractional r,
 VertexContainer f (OriginalOrExtra vertex (Point 2 r)),
 Traversable1 cyclic, HasFromFoldable1 f) =>
LinePV 2 r
-> cyclic (Bool, NonEmpty vertex)
-> [HalfPlaneConvexPolygonIntersection f r vertex]
collectComponents (HalfSpaceF (LinePV 2 r)
halfPlaneHalfSpaceF (LinePV 2 r)
-> Getting (LinePV 2 r) (HalfSpaceF (LinePV 2 r)) (LinePV 2 r)
-> LinePV 2 r
forall s a. s -> Getting a s a -> a
^.(BoundingHyperPlane (HalfSpaceF (LinePV 2 r)) 2 r
 -> Const
      (LinePV 2 r) (BoundingHyperPlane (HalfSpaceF (LinePV 2 r)) 2 r))
-> HalfSpaceF (LinePV 2 r)
-> Const (LinePV 2 r) (HalfSpaceF (LinePV 2 r))
Getting (LinePV 2 r) (HalfSpaceF (LinePV 2 r)) (LinePV 2 r)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens'
  (HalfSpaceF (LinePV 2 r))
  (BoundingHyperPlane (HalfSpaceF (LinePV 2 r)) 2 r)
boundingHyperPlane)
            (Cyclic NonEmpty (Bool, NonEmpty vertex)
 -> [HalfPlaneConvexPolygonIntersection f r vertex])
-> (NonEmpty vertex -> Cyclic NonEmpty (Bool, NonEmpty vertex))
-> NonEmpty vertex
-> [HalfPlaneConvexPolygonIntersection f r vertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (vertex -> Bool)
-> Cyclic NonEmpty vertex
-> Cyclic NonEmpty (Bool, NonEmpty vertex)
forall (cyclic :: * -> *) b a.
(Foldable1 cyclic, Eq b) =>
(a -> b) -> cyclic a -> Cyclic NonEmpty (b, NonEmpty a)
groupWith (\vertex
v -> (vertex
vvertex -> Getting (Point 2 r) vertex (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) vertex (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' vertex (Point 2 r)
asPoint) Point 2 r -> HalfSpaceF (LinePV 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfSpaceF (LinePV 2 r)
halfPlane) (Cyclic NonEmpty vertex -> Cyclic NonEmpty (Bool, NonEmpty vertex))
-> (NonEmpty vertex -> Cyclic NonEmpty vertex)
-> NonEmpty vertex
-> Cyclic NonEmpty (Bool, NonEmpty vertex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty vertex -> Cyclic NonEmpty vertex
forall {k} (v :: k -> *) (a :: k). v a -> Cyclic v a
Cyclic
            (NonEmpty vertex
 -> [HalfPlaneConvexPolygonIntersection f r vertex])
-> NonEmpty vertex
-> [HalfPlaneConvexPolygonIntersection f r vertex]
forall a b. (a -> b) -> a -> b
$ Getting (NonEmptyDList vertex) (ConvexPolygonF f vertex) vertex
-> ConvexPolygonF f vertex -> NonEmpty vertex
forall a s. Getting (NonEmptyDList a) s a -> s -> NonEmpty a
toNonEmptyOf Getting (NonEmptyDList vertex) (ConvexPolygonF f vertex) vertex
(Vertex (ConvexPolygonF f vertex)
 -> Const (NonEmptyDList vertex) (Vertex (ConvexPolygonF f vertex)))
-> ConvexPolygonF f vertex
-> Const (NonEmptyDList vertex) (ConvexPolygonF f vertex)
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (ConvexPolygonF f vertex))
  (ConvexPolygonF f vertex)
  (ConvexPolygonF f vertex)
  (Vertex (ConvexPolygonF f vertex))
  (Vertex (ConvexPolygonF f vertex))
vertices ConvexPolygonF f vertex
poly
  -- halfPlane `intersect` poly = case halfPlane `intersect` (toSimplePolygon poly) of
  --   [comp] -> Just $ ConvexPolygon <$> comp
  --             -- note that the intersection between a halfspace and a convex polygon
  --             -- is indeed guaranteed to be convex. Hence the 'ConvexPolygon' call here
  --             -- is safe.
  --   _      -> Nothing


-- | Collect the connected components
collectComponents   :: forall cyclic f vertex r. ( Point_ vertex 2 r, Ord r, Fractional r
                       , VertexContainer f (OriginalOrExtra vertex (Point 2 r))
                       , Traversable1 cyclic, HasFromFoldable1 f
                       )
                    => LinePV 2 r -- ^ the bounding line of the halfplane
                    -> cyclic (Bool, NonEmpty vertex)
                    -> [HalfPlaneConvexPolygonIntersection f r vertex]
collectComponents :: forall (cyclic :: * -> *) (f :: * -> *) vertex r.
(Point_ vertex 2 r, Ord r, Fractional r,
 VertexContainer f (OriginalOrExtra vertex (Point 2 r)),
 Traversable1 cyclic, HasFromFoldable1 f) =>
LinePV 2 r
-> cyclic (Bool, NonEmpty vertex)
-> [HalfPlaneConvexPolygonIntersection f r vertex]
collectComponents LinePV 2 r
l = Getting
  [HalfPlaneConvexPolygonIntersection f r vertex]
  (cyclic (Bool, NonEmpty vertex))
  ((Bool, NonEmpty vertex), V2 (Bool, NonEmpty vertex))
-> (((Bool, NonEmpty vertex), V2 (Bool, NonEmpty vertex))
    -> [HalfPlaneConvexPolygonIntersection f r vertex])
-> cyclic (Bool, NonEmpty vertex)
-> [HalfPlaneConvexPolygonIntersection f r vertex]
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf (Traversal1
  (cyclic (Bool, NonEmpty vertex))
  (cyclic (ZonkAny 0))
  ((Bool, NonEmpty vertex), V2 (Bool, NonEmpty vertex))
  (ZonkAny 0)
-> Fold1
     (cyclic (Bool, NonEmpty vertex))
     ((Bool, NonEmpty vertex), V2 (Bool, NonEmpty vertex))
forall s t a b. Traversal1 s t a b -> Fold1 s a
asFold1 (((Bool, NonEmpty vertex), V2 (Bool, NonEmpty vertex))
 -> f (ZonkAny 0))
-> cyclic (Bool, NonEmpty vertex) -> f (cyclic (ZonkAny 0))
Traversal1
  (cyclic (Bool, NonEmpty vertex))
  (cyclic (ZonkAny 0))
  ((Bool, NonEmpty vertex), V2 (Bool, NonEmpty vertex))
  (ZonkAny 0)
forall (cyclic :: * -> *) a b.
Traversable1 cyclic =>
Traversal1 (cyclic a) (cyclic b) (a, V2 a) b
withCyclicNeighbours) ((Bool, NonEmpty vertex), V2 (Bool, NonEmpty vertex))
-> [HalfPlaneConvexPolygonIntersection f r vertex]
f
  where
    -- We go through the components with their neighbours. Each component
    -- is a non-empty list of vertices in CCW order along the polygon.
    --
    -- For each component [v1,..,vn] we may need to add two vertices; the intersection
    -- point of l with the edge between the last vertex um of the previous component and
    -- v1, and the intersection point of l with the edge between vn and the first vertex
    -- w1 of the next component
    f :: ((Bool, NonEmpty vertex), V2 (Bool, NonEmpty vertex))
      -> [HalfPlaneConvexPolygonIntersection f r vertex]
    f :: ((Bool, NonEmpty vertex), V2 (Bool, NonEmpty vertex))
-> [HalfPlaneConvexPolygonIntersection f r vertex]
f ((Bool
b, current :: NonEmpty vertex
current@(vertex
v1 :| [vertex]
rest)), V2 (Bool
_, NonEmpty vertex -> vertex
forall a. NonEmpty a -> a
NonEmpty.last -> vertex
um) (Bool
_, vertex
w1 :| [vertex]
_))
      | Bool -> Bool
not Bool
b     = []
      | Bool
otherwise = let vn :: vertex
vn     = NonEmpty vertex -> vertex
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty vertex
current
                        extras :: [Point 2 r]
extras = ((vertex, vertex) -> Maybe (Point 2 r))
-> [(vertex, vertex)] -> [Point 2 r]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LinePV 2 r -> (vertex, vertex) -> Maybe (Point 2 r)
forall vertex r.
(Point_ vertex 2 r, Ord r, Fractional r) =>
LinePV 2 r -> (vertex, vertex) -> Maybe (Point 2 r)
intersectionPoint LinePV 2 r
l) [(vertex
vn,vertex
w1), (vertex
um,vertex
v1)]
                    in HalfPlaneConvexPolygonIntersection f r vertex
-> [HalfPlaneConvexPolygonIntersection f r vertex]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HalfPlaneConvexPolygonIntersection f r vertex
 -> [HalfPlaneConvexPolygonIntersection f r vertex])
-> HalfPlaneConvexPolygonIntersection f r vertex
-> [HalfPlaneConvexPolygonIntersection f r vertex]
forall a b. (a -> b) -> a -> b
$ case ([Point 2 r] -> Maybe (NonEmpty (Point 2 r))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [Point 2 r]
extras,[vertex] -> Maybe (NonEmpty vertex)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [vertex]
rest) of
                       (Maybe (NonEmpty (Point 2 r))
Nothing, Maybe (NonEmpty vertex)
Nothing)        -> vertex -> HalfPlaneConvexPolygonIntersection f r vertex
forall vertex polygon.
vertex -> PossiblyDegenerateSimplePolygon vertex polygon
DegenerateVertex vertex
v1
                       (Maybe (NonEmpty (Point 2 r))
Nothing, Just (vertex
p :| [])) -> ClosedLineSegment vertex
-> HalfPlaneConvexPolygonIntersection f r vertex
forall vertex polygon.
ClosedLineSegment vertex
-> PossiblyDegenerateSimplePolygon vertex polygon
DegenerateEdge
                                                  (ClosedLineSegment vertex
 -> HalfPlaneConvexPolygonIntersection f r vertex)
-> ClosedLineSegment vertex
-> HalfPlaneConvexPolygonIntersection f r vertex
forall a b. (a -> b) -> a -> b
$ vertex -> vertex -> ClosedLineSegment vertex
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment vertex
p vertex
v1
                       (Maybe (NonEmpty (Point 2 r))
extras',  Maybe (NonEmpty vertex)
_)             -> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
-> HalfPlaneConvexPolygonIntersection f r vertex
forall vertex polygon.
polygon -> PossiblyDegenerateSimplePolygon vertex polygon
ActualPolygon ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
poly
                         where
                           poly :: ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
poly = NonEmpty (OriginalOrExtra vertex (Point 2 r))
-> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (OriginalOrExtra vertex (Point 2 r))
-> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
uncheckedFromCCWPoints
                                (NonEmpty (OriginalOrExtra vertex (Point 2 r))
 -> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
-> NonEmpty (OriginalOrExtra vertex (Point 2 r))
-> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
forall a b. (a -> b) -> a -> b
$ ((Point 2 r -> OriginalOrExtra vertex (Point 2 r))
-> NonEmpty (Point 2 r)
-> NonEmpty (OriginalOrExtra vertex (Point 2 r))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point 2 r -> OriginalOrExtra vertex (Point 2 r)
forall orig extra. extra -> OriginalOrExtra orig extra
Extra (NonEmpty (Point 2 r)
 -> NonEmpty (OriginalOrExtra vertex (Point 2 r)))
-> Maybe (NonEmpty (Point 2 r))
-> Maybe (NonEmpty (OriginalOrExtra vertex (Point 2 r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty (Point 2 r))
extras') Maybe (NonEmpty (OriginalOrExtra vertex (Point 2 r)))
-> NonEmpty (OriginalOrExtra vertex (Point 2 r))
-> NonEmpty (OriginalOrExtra vertex (Point 2 r))
forall a. Semigroup a => Maybe a -> a -> a
<<> (vertex -> OriginalOrExtra vertex (Point 2 r)
forall orig extra. orig -> OriginalOrExtra orig extra
Original (vertex -> OriginalOrExtra vertex (Point 2 r))
-> NonEmpty vertex -> NonEmpty (OriginalOrExtra vertex (Point 2 r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty vertex
current)

-- | Helper to combine at most two a's into one
(<<>)     :: Semigroup a => Maybe a -> a -> a
Maybe a
xs <<> :: forall a. Semigroup a => Maybe a -> a -> a
<<> a
ys = case Maybe a
xs of
              Maybe a
Nothing  -> a
ys
              Just a
xs' -> a
xs' a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
ys

-- | Compute the intersection between a line and the "edge" given by the two vertices.
-- We treat the edge as open; i.e. we only report the intersection if it is interior
intersectionPoint            :: (Point_ vertex 2 r, Ord r, Fractional r)
                             => LinePV 2 r -> (vertex, vertex) -> Maybe (Point 2 r)
intersectionPoint :: forall vertex r.
(Point_ vertex 2 r, Ord r, Fractional r) =>
LinePV 2 r -> (vertex, vertex) -> Maybe (Point 2 r)
intersectionPoint LinePV 2 r
line (vertex
u,vertex
v) = case LinePV 2 r
line LinePV 2 r
-> OpenLineSegment vertex
-> Intersection (LinePV 2 r) (OpenLineSegment vertex)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` vertex -> vertex -> OpenLineSegment vertex
forall point. point -> point -> OpenLineSegment point
OpenLineSegment vertex
u vertex
v of
                                 Just (Line_x_LineSegment_Point Point 2 (NumType (OpenLineSegment vertex))
p) -> Point 2 r -> Maybe (Point 2 r)
forall a. a -> Maybe a
Just Point 2 r
Point 2 (NumType (OpenLineSegment vertex))
p
                                 Intersection (LinePV 2 r) (OpenLineSegment vertex)
_                                 -> Maybe (Point 2 r)
forall a. Maybe a
Nothing

-- | Convert a traversal into a fold.
asFold1   :: Traversal1 s t a b -> Fold1 s a
asFold1 :: forall s t a b. Traversal1 s t a b -> Fold1 s a
asFold1 Traversal1 s t a b
t = \a -> f a
aFa -> f t -> f s
forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom (f t -> f s) -> (s -> f t) -> s -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> s -> f t
Traversal1 s t a b
t (f a -> f b
forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom (f a -> f b) -> (a -> f a) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
aFa)

--------------------------------------------------------------------------------
-- * Intersecting a Halfspace and a Possibly Degenerate Convex Polygon

-- | Intersecting a halfplane witha possibly degenerate convex polygon
-- gives us a possibly degenerate polygon again.
--
type instance Intersection (HalfSpaceF line)
                           (PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex))
  = Maybe (PossiblyDegenerateSimplePolygon
              (OriginalOrExtra vertex (CanonicalPoint vertex))
              (ConvexPolygonF f (OriginalOrExtra vertex (CanonicalPoint vertex)))
          )
   -- we lose some information here; if we are a degenreate point we are guaranteed
   -- to be an original; the type also allows it to be an Extra.

instance ( Point_ vertex 2 r, Fractional r, Ord r, VertexContainer f vertex
         , VertexContainer f (OriginalOrExtra vertex (Point 2 r))
         , HyperPlane_ line 2 r
         , IsIntersectableWith (HalfSpaceF line) (ConvexPolygonF f vertex)
         -- this one is satisfied for e.g. line ~ LinePV

         , IsIntersectableWith (LinePV 2 r) line
         , Intersection (LinePV 2 r) line ~ Maybe (LineLineIntersectionG r line')
         ) => HalfSpaceF line `IsIntersectableWith`
              PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex) where
  HalfSpaceF line
halfSpace intersect :: HalfSpaceF line
-> PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex)
-> Intersection
     (HalfSpaceF line)
     (PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex))
`intersect` PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex)
degenPoly = case PossiblyDegenerateSimplePolygon vertex (ConvexPolygonF f vertex)
degenPoly of
    DegenerateVertex vertex
v -> OriginalOrExtra vertex (Point 2 r)
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall vertex polygon.
vertex -> PossiblyDegenerateSimplePolygon vertex polygon
DegenerateVertex (vertex -> OriginalOrExtra vertex (Point 2 r)
forall orig extra. orig -> OriginalOrExtra orig extra
Original vertex
v) PossiblyDegenerateSimplePolygon
  (OriginalOrExtra vertex (Point 2 r))
  (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
-> Maybe (Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ((vertex
vvertex -> Getting (Point 2 r) vertex (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) vertex (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' vertex (Point 2 r)
asPoint) Point 2 r
-> HalfSpaceF line -> Intersection (Point 2 r) (HalfSpaceF line)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` HalfSpaceF line
halfSpace)
    DegenerateEdge ClosedLineSegment vertex
e   -> ClosedLineSegment vertex
e ClosedLineSegment vertex
-> HalfSpaceF line
-> Intersection (ClosedLineSegment vertex) (HalfSpaceF line)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` HalfSpaceF line
halfSpace Maybe (ClosedSegmentHalfSpaceIntersection (Point 2 r) vertex)
-> (ClosedSegmentHalfSpaceIntersection (Point 2 r) vertex
    -> PossiblyDegenerateSimplePolygon
         (OriginalOrExtra vertex (Point 2 r))
         (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      ClosedLineSegment_x_HalfSpace_Point vertex
v           -> OriginalOrExtra vertex (Point 2 r)
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall vertex polygon.
vertex -> PossiblyDegenerateSimplePolygon vertex polygon
DegenerateVertex (vertex -> OriginalOrExtra vertex (Point 2 r)
forall orig extra. orig -> OriginalOrExtra orig extra
Original vertex
v)
      ClosedLineSegment_x_HalfSpace_SubSegment ClosedLineSegment (OriginalOrExtra vertex (Point 2 r))
s      -> ClosedLineSegment (OriginalOrExtra vertex (Point 2 r))
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall vertex polygon.
ClosedLineSegment vertex
-> PossiblyDegenerateSimplePolygon vertex polygon
DegenerateEdge ClosedLineSegment (OriginalOrExtra vertex (Point 2 r))
s
      ClosedLineSegment_x_HalfSpace_CompleteSegment ClosedLineSegment vertex
_ -> ClosedLineSegment (OriginalOrExtra vertex (Point 2 r))
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall vertex polygon.
ClosedLineSegment vertex
-> PossiblyDegenerateSimplePolygon vertex polygon
DegenerateEdge (vertex -> OriginalOrExtra vertex (Point 2 r)
forall orig extra. orig -> OriginalOrExtra orig extra
Original (vertex -> OriginalOrExtra vertex (Point 2 r))
-> ClosedLineSegment vertex
-> ClosedLineSegment (OriginalOrExtra vertex (Point 2 r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClosedLineSegment vertex
e)

    ActualPolygon ConvexPolygonF f vertex
poly -> (vertex -> OriginalOrExtra vertex (Point 2 r))
-> PossiblyDegenerateSimplePolygon
     vertex (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall a b c.
(a -> b)
-> PossiblyDegenerateSimplePolygon a c
-> PossiblyDegenerateSimplePolygon b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first vertex -> OriginalOrExtra vertex (Point 2 r)
forall orig extra. orig -> OriginalOrExtra orig extra
Original (PossiblyDegenerateSimplePolygon
   vertex (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
 -> PossiblyDegenerateSimplePolygon
      (OriginalOrExtra vertex (Point 2 r))
      (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        vertex (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HalfSpaceF line
halfSpace HalfSpaceF line
-> ConvexPolygonF f vertex
-> Intersection (HalfSpaceF line) (ConvexPolygonF f vertex)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` ConvexPolygonF f vertex
poly

--------------------------------------------------------------------------------
-- * Intersection of Triangle and ConvexPolygon

type instance Intersection (Triangle corner) (ConvexPolygonF f vertex) =
  Maybe (PossiblyDegenerateSimplePolygon (OriginalOrCanonical vertex)
                                         (ConvexPolygonF f (OriginalOrCanonical vertex))
        )

instance ( Point_ point 2 r, Point_ point' 2 r, Num r, Ord r, VertexContainer f point
         , VertexContainer f (Point 2 r)
         ) => HasIntersectionWith (Triangle point') (ConvexPolygonF f point) where
  Triangle point'
triangle intersects :: Triangle point' -> ConvexPolygonF f point -> Bool
`intersects` ConvexPolygonF f point
poly = Getting Any (ConvexPolygonF f (Point 2 r)) (Point 2 r)
-> (Point 2 r -> Bool) -> ConvexPolygonF f (Point 2 r) -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Vertex (ConvexPolygonF f (Point 2 r))
 -> Const Any (Vertex (ConvexPolygonF f (Point 2 r))))
-> ConvexPolygonF f (Point 2 r)
-> Const Any (ConvexPolygonF f (Point 2 r))
Getting Any (ConvexPolygonF f (Point 2 r)) (Point 2 r)
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (ConvexPolygonF f (Point 2 r)))
  (ConvexPolygonF f (Point 2 r))
  (ConvexPolygonF f (Point 2 r))
  (Vertex (ConvexPolygonF f (Point 2 r)))
  (Vertex (ConvexPolygonF f (Point 2 r)))
vertices                  (Point 2 r -> Triangle (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Triangle (Point 2 r)
tri) ConvexPolygonF f (Point 2 r)
poly'
                              Bool -> Bool -> Bool
|| Getting
  Any (ConvexPolygonF f (Point 2 r)) (ClosedLineSegment (Point 2 r))
-> (ClosedLineSegment (Point 2 r) -> Bool)
-> ConvexPolygonF f (Point 2 r)
-> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Getting
  Any (ConvexPolygonF f (Point 2 r)) (ClosedLineSegment (Point 2 r))
forall polygon point r.
(HasOuterBoundary polygon, Vertex polygon ~ point,
 Point_ point 2 r) =>
IndexedFold1
  (VertexIx polygon, VertexIx polygon)
  polygon
  (ClosedLineSegment point)
IndexedFold1
  (VertexIx (ConvexPolygonF f (Point 2 r)),
   VertexIx (ConvexPolygonF f (Point 2 r)))
  (ConvexPolygonF f (Point 2 r))
  (ClosedLineSegment (Point 2 r))
outerBoundaryEdgeSegments (ClosedLineSegment (Point 2 r) -> Triangle (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Triangle (Point 2 r)
tri) ConvexPolygonF f (Point 2 r)
poly'
    where
      poly' :: ConvexPolygonF f (Point 2 r)
      poly' :: ConvexPolygonF f (Point 2 r)
poly' = ConvexPolygonF f point
polyConvexPolygonF f point
-> (ConvexPolygonF f point -> ConvexPolygonF f (Point 2 r))
-> ConvexPolygonF f (Point 2 r)
forall a b. a -> (a -> b) -> b
&(point -> Identity (Point 2 r))
-> ConvexPolygonF f point
-> Identity (ConvexPolygonF f (Point 2 r))
(Vertex (ConvexPolygonF f point)
 -> Identity (Vertex (ConvexPolygonF f (Point 2 r))))
-> ConvexPolygonF f point
-> Identity (ConvexPolygonF f (Point 2 r))
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (ConvexPolygonF f point))
  (ConvexPolygonF f point)
  (ConvexPolygonF f (Point 2 r))
  (Vertex (ConvexPolygonF f point))
  (Vertex (ConvexPolygonF f (Point 2 r)))
vertices ((point -> Identity (Point 2 r))
 -> ConvexPolygonF f point
 -> Identity (ConvexPolygonF f (Point 2 r)))
-> (point -> Point 2 r)
-> ConvexPolygonF f point
-> ConvexPolygonF f (Point 2 r)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Getting (Point 2 r) point (Point 2 r) -> point -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint
      tri :: Triangle (Point 2 r)
tri = (point' -> Getting (Point 2 r) point' (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point' (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point' (Point 2 r)
asPoint) (point' -> Point 2 r) -> Triangle point' -> Triangle (Point 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Triangle point'
triangle


type V vertex r = OriginalOrExtra vertex (Point 2 r)

instance ( Point_ vertex 2 r, Point_ corner 2 r, Fractional r, Ord r, VertexContainer f vertex
         , VertexContainer f (Point 2 r)
         , VertexContainer f (OriginalOrCanonical vertex)
         , VertexContainer f (OriginalOrExtra (OriginalOrCanonical vertex) (Point 2 r))
         , HasFromFoldable1 f
         ) => IsIntersectableWith (Triangle corner) (ConvexPolygonF f vertex) where
  Triangle corner
triangle intersect :: Triangle corner
-> ConvexPolygonF f vertex
-> Intersection (Triangle corner) (ConvexPolygonF f vertex)
`intersect` ConvexPolygonF f vertex
poly = (HalfSpaceF (LinePV 2 r)
 -> Maybe
      (PossiblyDegenerateSimplePolygon
         (OriginalOrExtra vertex (Point 2 r))
         (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
 -> Maybe
      (PossiblyDegenerateSimplePolygon
         (OriginalOrExtra vertex (Point 2 r))
         (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> Vector 3 (HalfSpaceF (LinePV 2 r))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall a b. (a -> b -> b) -> b -> Vector 3 a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HalfSpaceF (LinePV 2 r)
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall vertex r (f :: * -> *).
(Point_ vertex 2 r, Fractional r, Ord r, VertexContainer f vertex,
 VertexContainer f (Point 2 r),
 VertexContainer f (OriginalOrCanonical vertex),
 VertexContainer
   f (OriginalOrExtra (OriginalOrCanonical vertex) (Point 2 r)),
 HasFromFoldable1 f) =>
HalfSpaceF (LinePV 2 r)
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (V vertex r) (ConvexPolygonF f (V vertex r)))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (V vertex r) (ConvexPolygonF f (V vertex r)))
intersect' (PossiblyDegenerateSimplePolygon
  (OriginalOrExtra vertex (Point 2 r))
  (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall a. a -> Maybe a
Just (PossiblyDegenerateSimplePolygon
   (OriginalOrExtra vertex (Point 2 r))
   (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
 -> Maybe
      (PossiblyDegenerateSimplePolygon
         (OriginalOrExtra vertex (Point 2 r))
         (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))))
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall a b. (a -> b) -> a -> b
$ ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall vertex polygon.
polygon -> PossiblyDegenerateSimplePolygon vertex polygon
ActualPolygon (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
 -> PossiblyDegenerateSimplePolygon
      (OriginalOrExtra vertex (Point 2 r))
      (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall a b. (a -> b) -> a -> b
$ ConvexPolygonF f vertex
polyConvexPolygonF f vertex
-> (ConvexPolygonF f vertex
    -> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
-> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
forall a b. a -> (a -> b) -> b
&(vertex -> Identity (OriginalOrExtra vertex (Point 2 r)))
-> ConvexPolygonF f vertex
-> Identity (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
(Vertex (ConvexPolygonF f vertex)
 -> Identity
      (Vertex (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))))
-> ConvexPolygonF f vertex
-> Identity (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (ConvexPolygonF f vertex))
  (ConvexPolygonF f vertex)
  (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
  (Vertex (ConvexPolygonF f vertex))
  (Vertex (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
vertices ((vertex -> Identity (OriginalOrExtra vertex (Point 2 r)))
 -> ConvexPolygonF f vertex
 -> Identity
      (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> (vertex -> OriginalOrExtra vertex (Point 2 r))
-> ConvexPolygonF f vertex
-> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ vertex -> OriginalOrExtra vertex (Point 2 r)
forall orig extra. orig -> OriginalOrExtra orig extra
Original)
                                               (Triangle corner -> Vector 3 (HalfSpaceF (LinePV 2 r))
forall triangle point r.
(Triangle_ triangle point, Point_ point 2 r, Num r, Ord r) =>
triangle -> Vector 3 (HalfSpaceF (LinePV 2 r))
Triangle.intersectingHalfPlanes Triangle corner
triangle)

-- | Helper to repeatedly intersect a halfplane and a convex polygon
intersect'      :: ( Point_ vertex 2 r, Fractional r, Ord r, VertexContainer f vertex
                   , VertexContainer f (Point 2 r)
                   , VertexContainer f (OriginalOrCanonical vertex)
                   , VertexContainer f (OriginalOrExtra (OriginalOrCanonical vertex) (Point 2 r))
                   , HasFromFoldable1 f
                   )
                => HalfSpaceF (LinePV 2 r)
                -> Maybe (PossiblyDegenerateSimplePolygon (V vertex r)
                                                          (ConvexPolygonF f (V vertex r)))
                -> Maybe (PossiblyDegenerateSimplePolygon (V vertex r)
                                                          (ConvexPolygonF f (V vertex r)))
intersect' :: forall vertex r (f :: * -> *).
(Point_ vertex 2 r, Fractional r, Ord r, VertexContainer f vertex,
 VertexContainer f (Point 2 r),
 VertexContainer f (OriginalOrCanonical vertex),
 VertexContainer
   f (OriginalOrExtra (OriginalOrCanonical vertex) (Point 2 r)),
 HasFromFoldable1 f) =>
HalfSpaceF (LinePV 2 r)
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (V vertex r) (ConvexPolygonF f (V vertex r)))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (V vertex r) (ConvexPolygonF f (V vertex r)))
intersect' HalfSpaceF (LinePV 2 r)
h Maybe
  (PossiblyDegenerateSimplePolygon
     (V vertex r) (ConvexPolygonF f (V vertex r)))
mp = do p <- Maybe
  (PossiblyDegenerateSimplePolygon
     (V vertex r) (ConvexPolygonF f (V vertex r)))
mp
                     bimap flatten (fmap flatten) <$> h `intersect` p

-- | Flatten two nested originals
flatten :: OriginalOrExtra (OriginalOrExtra vertex extra) extra -> OriginalOrExtra vertex extra
flatten :: forall vertex extra.
OriginalOrExtra (OriginalOrExtra vertex extra) extra
-> OriginalOrExtra vertex extra
flatten = \case
  Extra extra
e    -> extra -> OriginalOrExtra vertex extra
forall orig extra. extra -> OriginalOrExtra orig extra
Extra extra
e
  Original OriginalOrExtra vertex extra
o -> OriginalOrExtra vertex extra
o


-- * Intersection of Rectangle and ConvexPolygon

type instance Intersection (Rectangle corner) (ConvexPolygonF f vertex) =
  Maybe (PossiblyDegenerateSimplePolygon (OriginalOrCanonical vertex)
                                         (ConvexPolygonF f (OriginalOrCanonical vertex))
        )

instance ( Point_ point 2 r, Point_ point' 2 r, Num r, Ord r, VertexContainer f point
         , VertexContainer f (Point 2 r)
         ) => HasIntersectionWith (Rectangle point') (ConvexPolygonF f point) where
  Rectangle point'
rectangle intersects :: Rectangle point' -> ConvexPolygonF f point -> Bool
`intersects` ConvexPolygonF f point
poly =
       Getting Any (ConvexPolygonF f (Point 2 r)) (Point 2 r)
-> (Point 2 r -> Bool) -> ConvexPolygonF f (Point 2 r) -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Vertex (ConvexPolygonF f (Point 2 r))
 -> Const Any (Vertex (ConvexPolygonF f (Point 2 r))))
-> ConvexPolygonF f (Point 2 r)
-> Const Any (ConvexPolygonF f (Point 2 r))
Getting Any (ConvexPolygonF f (Point 2 r)) (Point 2 r)
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (ConvexPolygonF f (Point 2 r)))
  (ConvexPolygonF f (Point 2 r))
  (ConvexPolygonF f (Point 2 r))
  (Vertex (ConvexPolygonF f (Point 2 r)))
  (Vertex (ConvexPolygonF f (Point 2 r)))
vertices                  (Point 2 r -> Box (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Box (Point 2 r)
rect) ConvexPolygonF f (Point 2 r)
poly'
    Bool -> Bool -> Bool
|| Getting
  Any (ConvexPolygonF f (Point 2 r)) (ClosedLineSegment (Point 2 r))
-> (ClosedLineSegment (Point 2 r) -> Bool)
-> ConvexPolygonF f (Point 2 r)
-> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Getting
  Any (ConvexPolygonF f (Point 2 r)) (ClosedLineSegment (Point 2 r))
forall polygon point r.
(HasOuterBoundary polygon, Vertex polygon ~ point,
 Point_ point 2 r) =>
IndexedFold1
  (VertexIx polygon, VertexIx polygon)
  polygon
  (ClosedLineSegment point)
IndexedFold1
  (VertexIx (ConvexPolygonF f (Point 2 r)),
   VertexIx (ConvexPolygonF f (Point 2 r)))
  (ConvexPolygonF f (Point 2 r))
  (ClosedLineSegment (Point 2 r))
outerBoundaryEdgeSegments (ClosedLineSegment (Point 2 r) -> Box (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Box (Point 2 r)
rect) ConvexPolygonF f (Point 2 r)
poly'
    where
      poly' :: ConvexPolygonF f (Point 2 r)
      poly' :: ConvexPolygonF f (Point 2 r)
poly' = ConvexPolygonF f point
polyConvexPolygonF f point
-> (ConvexPolygonF f point -> ConvexPolygonF f (Point 2 r))
-> ConvexPolygonF f (Point 2 r)
forall a b. a -> (a -> b) -> b
&(point -> Identity (Point 2 r))
-> ConvexPolygonF f point
-> Identity (ConvexPolygonF f (Point 2 r))
(Vertex (ConvexPolygonF f point)
 -> Identity (Vertex (ConvexPolygonF f (Point 2 r))))
-> ConvexPolygonF f point
-> Identity (ConvexPolygonF f (Point 2 r))
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (ConvexPolygonF f point))
  (ConvexPolygonF f point)
  (ConvexPolygonF f (Point 2 r))
  (Vertex (ConvexPolygonF f point))
  (Vertex (ConvexPolygonF f (Point 2 r)))
vertices ((point -> Identity (Point 2 r))
 -> ConvexPolygonF f point
 -> Identity (ConvexPolygonF f (Point 2 r)))
-> (point -> Point 2 r)
-> ConvexPolygonF f point
-> ConvexPolygonF f (Point 2 r)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Getting (Point 2 r) point (Point 2 r) -> point -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint
      rect :: Box (Point 2 r)
rect  = (point' -> Getting (Point 2 r) point' (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point' (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point' (Point 2 r)
asPoint) (point' -> Point 2 r) -> Rectangle point' -> Box (Point 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle point'
rectangle


instance ( Point_ vertex 2 r, Point_ corner 2 r, Fractional r, Ord r, VertexContainer f vertex
         , VertexContainer f (Point 2 r)
         , VertexContainer f (OriginalOrCanonical vertex)
         , VertexContainer f (OriginalOrExtra (OriginalOrCanonical vertex) (Point 2 r))
         , HasFromFoldable1 f
         ) => IsIntersectableWith (Rectangle corner) (ConvexPolygonF f vertex) where
  Rectangle corner
rect intersect :: Rectangle corner
-> ConvexPolygonF f vertex
-> Intersection (Rectangle corner) (ConvexPolygonF f vertex)
`intersect` ConvexPolygonF f vertex
poly = (HalfSpaceF (LinePV 2 r)
 -> Maybe
      (PossiblyDegenerateSimplePolygon
         (OriginalOrExtra vertex (Point 2 r))
         (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
 -> Maybe
      (PossiblyDegenerateSimplePolygon
         (OriginalOrExtra vertex (Point 2 r))
         (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> Sides (HalfSpaceF (LinePV 2 r))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall a b. (a -> b -> b) -> b -> Sides a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HalfSpaceF (LinePV 2 r)
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall vertex r (f :: * -> *).
(Point_ vertex 2 r, Fractional r, Ord r, VertexContainer f vertex,
 VertexContainer f (Point 2 r),
 VertexContainer f (OriginalOrCanonical vertex),
 VertexContainer
   f (OriginalOrExtra (OriginalOrCanonical vertex) (Point 2 r)),
 HasFromFoldable1 f) =>
HalfSpaceF (LinePV 2 r)
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (V vertex r) (ConvexPolygonF f (V vertex r)))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (V vertex r) (ConvexPolygonF f (V vertex r)))
intersect' (PossiblyDegenerateSimplePolygon
  (OriginalOrExtra vertex (Point 2 r))
  (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall a. a -> Maybe a
Just (PossiblyDegenerateSimplePolygon
   (OriginalOrExtra vertex (Point 2 r))
   (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
 -> Maybe
      (PossiblyDegenerateSimplePolygon
         (OriginalOrExtra vertex (Point 2 r))
         (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))))
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (OriginalOrExtra vertex (Point 2 r))
        (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
forall a b. (a -> b) -> a -> b
$ ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall vertex polygon.
polygon -> PossiblyDegenerateSimplePolygon vertex polygon
ActualPolygon (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
 -> PossiblyDegenerateSimplePolygon
      (OriginalOrExtra vertex (Point 2 r))
      (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
-> PossiblyDegenerateSimplePolygon
     (OriginalOrExtra vertex (Point 2 r))
     (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall a b. (a -> b) -> a -> b
$ ConvexPolygonF f vertex
polyConvexPolygonF f vertex
-> (ConvexPolygonF f vertex
    -> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
-> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
forall a b. a -> (a -> b) -> b
&(vertex -> Identity (OriginalOrExtra vertex (Point 2 r)))
-> ConvexPolygonF f vertex
-> Identity (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
(Vertex (ConvexPolygonF f vertex)
 -> Identity
      (Vertex (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))))
-> ConvexPolygonF f vertex
-> Identity (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (ConvexPolygonF f vertex))
  (ConvexPolygonF f vertex)
  (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r)))
  (Vertex (ConvexPolygonF f vertex))
  (Vertex (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
vertices ((vertex -> Identity (OriginalOrExtra vertex (Point 2 r)))
 -> ConvexPolygonF f vertex
 -> Identity
      (ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))))
-> (vertex -> OriginalOrExtra vertex (Point 2 r))
-> ConvexPolygonF f vertex
-> ConvexPolygonF f (OriginalOrExtra vertex (Point 2 r))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ vertex -> OriginalOrExtra vertex (Point 2 r)
forall orig extra. orig -> OriginalOrExtra orig extra
Original)
                                           (Rectangle corner -> Sides (HalfSpaceF (LinePV 2 r))
forall rectangle point r.
(Rectangle_ rectangle point, Point_ point 2 r, Num r) =>
rectangle -> Sides (HalfSpaceF (LinePV 2 r))
Box.intersectingHalfPlanes Rectangle corner
rect)

--------------------------------------------------------------------------------
-- * Halfspace x Rectangle Intersection

type instance Intersection (HalfSpaceF line) (Rectangle corner) =
  Maybe (PossiblyDegenerateSimplePolygon (CanonicalPoint corner)
                                         (ConvexPolygon (CanonicalPoint corner))
        )

-- this type is not entirely right; as we need to constrain the dimension to 2

instance ( Point_ corner 2 r, Num r, Ord r
         ) => HasIntersectionWith (HalfSpaceF (LinePV 2 r)) (Rectangle corner) where
  HalfSpaceF (LinePV 2 r)
halfPlane intersects :: HalfSpaceF (LinePV 2 r) -> Rectangle corner -> Bool
`intersects` Rectangle corner
rect' = (Point 2 r -> Bool) -> Corners (Point 2 r) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point 2 r -> HalfSpaceF (LinePV 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfSpaceF (LinePV 2 r)
halfPlane) ((corner -> Getting (Point 2 r) corner (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) corner (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' corner (Point 2 r)
asPoint) (corner -> Point 2 r) -> Corners corner -> Corners (Point 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle corner -> Corners corner
forall r rectangle point.
(Num r, Rectangle_ rectangle point, Point_ point 2 r) =>
rectangle -> Corners point
Box.corners Rectangle corner
rect')

instance ( Point_ corner 2 r, Fractional r, Ord r
         ) => IsIntersectableWith (HalfSpaceF (LinePV 2 r)) (Rectangle corner) where
  HalfSpaceF (LinePV 2 r)
halfPlane intersect :: HalfSpaceF (LinePV 2 r)
-> Rectangle corner
-> Intersection (HalfSpaceF (LinePV 2 r)) (Rectangle corner)
`intersect` Rectangle corner
rect' = (ConvexPolygonF
   (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r))
 -> ConvexPolygon (Point 2 r))
-> PossiblyDegenerateSimplePolygon
     (Point 2 r)
     (ConvexPolygonF
        (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r)))
-> PossiblyDegenerateSimplePolygon
     (Point 2 r) (ConvexPolygon (Point 2 r))
forall a b.
(a -> b)
-> PossiblyDegenerateSimplePolygon (Point 2 r) a
-> PossiblyDegenerateSimplePolygon (Point 2 r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((OriginalOrExtra (Point 2 r) (Point 2 r) -> Point 2 r)
-> ConvexPolygonF
     (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r))
-> ConvexPolygon (Point 2 r)
forall a b.
(a -> b)
-> ConvexPolygonF (Cyclic NonEmptyVector) a
-> ConvexPolygonF (Cyclic NonEmptyVector) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OriginalOrExtra (Point 2 r) (Point 2 r) -> Point 2 r
forall {orig}. OriginalOrExtra orig orig -> orig
flatten')
                             (PossiblyDegenerateSimplePolygon
   (Point 2 r)
   (ConvexPolygonF
      (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r)))
 -> PossiblyDegenerateSimplePolygon
      (Point 2 r) (ConvexPolygon (Point 2 r)))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (Point 2 r)
        (ConvexPolygonF
           (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r))))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (Point 2 r) (ConvexPolygon (Point 2 r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HalfSpaceF (LinePV 2 r)
halfPlane HalfSpaceF (LinePV 2 r)
-> ConvexPolygon (Point 2 r)
-> Intersection
     (HalfSpaceF (LinePV 2 r)) (ConvexPolygon (Point 2 r))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` (Rectangle corner -> ConvexPolygon (Point 2 r)
toConvexPolygon Rectangle corner
rect')
    where
      flatten' :: OriginalOrExtra orig orig -> orig
flatten' = \case
        Original orig
p -> orig
p
        Extra orig
p    -> orig
p

      toConvexPolygon :: Rectangle corner -> ConvexPolygon (Point 2 r)
      toConvexPolygon :: Rectangle corner -> ConvexPolygon (Point 2 r)
toConvexPolygon = Corners (Point 2 r) -> ConvexPolygon (Point 2 r)
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (Point 2 r) -> ConvexPolygon (Point 2 r)
uncheckedFromCCWPoints (Corners (Point 2 r) -> ConvexPolygon (Point 2 r))
-> (Rectangle corner -> Corners (Point 2 r))
-> Rectangle corner
-> ConvexPolygon (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (corner -> Point 2 r) -> Corners corner -> Corners (Point 2 r)
forall a b. (a -> b) -> Corners a -> Corners b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (corner -> Getting (Point 2 r) corner (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) corner (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' corner (Point 2 r)
asPoint) (Corners corner -> Corners (Point 2 r))
-> (Rectangle corner -> Corners corner)
-> Rectangle corner
-> Corners (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle corner -> Corners corner
forall r rectangle point.
(Num r, Rectangle_ rectangle point, Point_ point 2 r) =>
rectangle -> Corners point
Box.corners

--------------------------------------------------------------------------------
-- * Halfspace x Triangle Intersection

type instance Intersection (HalfSpaceF line) (Triangle corner) =
  Maybe (PossiblyDegenerateSimplePolygon (CanonicalPoint corner)
                                         (ConvexPolygon (CanonicalPoint corner))
        )
-- this type is not entirely right; as we need to constrain the dimension to 2

instance ( Point_ corner 2 r, Num r, Ord r
         ) => HasIntersectionWith (HalfSpaceF (LinePV 2 r)) (Triangle corner) where
  HalfSpaceF (LinePV 2 r)
halfPlane intersects :: HalfSpaceF (LinePV 2 r) -> Triangle corner -> Bool
`intersects` Triangle corner
tri = Getting Any (Triangle corner) (Point 2 r)
-> (Point 2 r -> Bool) -> Triangle corner -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((Vector 3 corner -> Const Any (Vector 3 corner))
-> Triangle corner -> Const Any (Triangle corner)
forall triangle point.
Triangle_ triangle point =>
Lens' triangle (Vector 3 point)
Lens' (Triangle corner) (Vector 3 corner)
Triangle.corners((Vector 3 corner -> Const Any (Vector 3 corner))
 -> Triangle corner -> Const Any (Triangle corner))
-> ((Point 2 r -> Const Any (Point 2 r))
    -> Vector 3 corner -> Const Any (Vector 3 corner))
-> Getting Any (Triangle corner) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(corner -> Const Any corner)
-> Vector 3 corner -> Const Any (Vector 3 corner)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Vector 3 a -> f (Vector 3 b)
traverse1((corner -> Const Any corner)
 -> Vector 3 corner -> Const Any (Vector 3 corner))
-> ((Point 2 r -> Const Any (Point 2 r))
    -> corner -> Const Any corner)
-> (Point 2 r -> Const Any (Point 2 r))
-> Vector 3 corner
-> Const Any (Vector 3 corner)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const Any (Point 2 r)) -> corner -> Const Any corner
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' corner (Point 2 r)
asPoint)
                                     (Point 2 r -> HalfSpaceF (LinePV 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfSpaceF (LinePV 2 r)
halfPlane) Triangle corner
tri

instance ( Point_ corner 2 r, Fractional r, Ord r
         ) => IsIntersectableWith (HalfSpaceF (LinePV 2 r)) (Triangle corner) where
  HalfSpaceF (LinePV 2 r)
halfPlane intersect :: HalfSpaceF (LinePV 2 r)
-> Triangle corner
-> Intersection (HalfSpaceF (LinePV 2 r)) (Triangle corner)
`intersect` Triangle corner
tri = (ConvexPolygonF
   (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r))
 -> ConvexPolygon (Point 2 r))
-> PossiblyDegenerateSimplePolygon
     (Point 2 r)
     (ConvexPolygonF
        (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r)))
-> PossiblyDegenerateSimplePolygon
     (Point 2 r) (ConvexPolygon (Point 2 r))
forall a b.
(a -> b)
-> PossiblyDegenerateSimplePolygon (Point 2 r) a
-> PossiblyDegenerateSimplePolygon (Point 2 r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((OriginalOrExtra (Point 2 r) (Point 2 r) -> Point 2 r)
-> ConvexPolygonF
     (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r))
-> ConvexPolygon (Point 2 r)
forall a b.
(a -> b)
-> ConvexPolygonF (Cyclic NonEmptyVector) a
-> ConvexPolygonF (Cyclic NonEmptyVector) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OriginalOrExtra (Point 2 r) (Point 2 r) -> Point 2 r
forall {orig}. OriginalOrExtra orig orig -> orig
flatten')
                           (PossiblyDegenerateSimplePolygon
   (Point 2 r)
   (ConvexPolygonF
      (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r)))
 -> PossiblyDegenerateSimplePolygon
      (Point 2 r) (ConvexPolygon (Point 2 r)))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (Point 2 r)
        (ConvexPolygonF
           (Cyclic NonEmptyVector) (OriginalOrExtra (Point 2 r) (Point 2 r))))
-> Maybe
     (PossiblyDegenerateSimplePolygon
        (Point 2 r) (ConvexPolygon (Point 2 r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HalfSpaceF (LinePV 2 r)
halfPlane HalfSpaceF (LinePV 2 r)
-> ConvexPolygon (Point 2 r)
-> Intersection
     (HalfSpaceF (LinePV 2 r)) (ConvexPolygon (Point 2 r))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` (Triangle corner -> ConvexPolygon (Point 2 r)
toConvexPolygon Triangle corner
tri)
    where
      flatten' :: OriginalOrExtra orig orig -> orig
flatten' = \case
        Original orig
p -> orig
p
        Extra orig
p    -> orig
p

      toConvexPolygon :: Triangle corner -> ConvexPolygon (Point 2 r)
      toConvexPolygon :: Triangle corner -> ConvexPolygon (Point 2 r)
toConvexPolygon = Vector 3 (Point 2 r) -> ConvexPolygon (Point 2 r)
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (Point 2 r) -> ConvexPolygon (Point 2 r)
uncheckedFromCCWPoints (Vector 3 (Point 2 r) -> ConvexPolygon (Point 2 r))
-> (Triangle corner -> Vector 3 (Point 2 r))
-> Triangle corner
-> ConvexPolygon (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (corner -> Point 2 r) -> Vector 3 corner -> Vector 3 (Point 2 r)
forall a b. (a -> b) -> Vector 3 a -> Vector 3 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (corner -> Getting (Point 2 r) corner (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) corner (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' corner (Point 2 r)
asPoint) (Vector 3 corner -> Vector 3 (Point 2 r))
-> (Triangle corner -> Vector 3 corner)
-> Triangle corner
-> Vector 3 (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Vector 3 corner) (Triangle corner) (Vector 3 corner)
-> Triangle corner -> Vector 3 corner
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Vector 3 corner) (Triangle corner) (Vector 3 corner)
forall triangle point.
Triangle_ triangle point =>
Lens' triangle (Vector 3 point)
Lens' (Triangle corner) (Vector 3 corner)
Triangle.corners)
                      (Triangle corner -> Vector 3 corner)
-> (Triangle corner -> Triangle corner)
-> Triangle corner
-> Vector 3 corner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Triangle corner -> Triangle corner
forall r point triangle.
(Num r, Eq r, Point_ point 2 r, Triangle_ triangle point) =>
triangle -> triangle
toCounterClockwiseTriangle