{-# LANGUAGE BangPatterns    #-}
{-# LANGUAGE ConstraintKinds #-}
{-# OPTIONS_HADDOCK hide #-}
module Reanimate.Math.Polygon
  ( APolygon(..)
  , Polygon
  , FPolygon
  , P
  , mkPolygon     -- :: (Fractional a, Ord a) => V.Vector (V2 a) -> APolygon a
  , mkPolygonFromRing -- :: (Fractional a, Ord a) => Ring a -> APolygon a
  , castPolygon   -- :: (Real a, Fractional b, Ord a) => APolygon a -> APolygon b
  , pParent       -- :: Polygon -> Int -> Int -> Int
  , pSetOffset    -- :: APolygon a -> Int -> APolygon a
  , pAdjustOffset -- :: APolygon a -> Int -> APolygon a
  , pSize         -- :: APolygon a -> Int
  , pNull         -- :: APolygon a -> Bool
  , pNext         -- :: APolygon a -> Int -> Int
  , pPrev         -- :: APolygon a -> Int -> Int
  , pIsSimple     -- :: Polygon -> Bool
  , pIsConvex     -- :: Polygon -> Bool
  , pIsCCW        -- :: Polygon -> Bool
  , pScale        -- :: Rational -> Polygon -> Polygon
  , pAtCentroid   -- :: Polygon -> Polygon
  , pAtCenter     -- :: Polygon -> Polygon
  , pTranslate    -- :: V2 Rational -> Polygon -> Polygon
  , pCenter       -- :: Polygon -> V2 Rational
  , pBoundingBox  -- :: Polygon -> (Rational, Rational, Rational, Rational)
  , pIsInside     -- :: Polygon -> V2 Rational -> Bool
  , pAccess       -- :: APolygon a -> Int -> V2 a
  , pMkWinding    -- :: Int -> Polygon
  , pDeoverlap    -- :: Polygon -> Polygon
  , pCycles       -- :: Polygon -> [Polygon]
  , pCycle        -- :: (Real a, Fractional a, Ord a) => APolygon a -> Double -> APolygon a
  , pCentroid     -- :: Polygon -> V2 Rational
  , pMapEdges     -- :: (V2 Rational -> V2 Rational -> a) -> Polygon -> V.Vector a
  , pArea         -- :: Polygon -> Rational
  , pCircumference   -- :: (Real a, Fractional a) => APolygon a -> a
  , pCircumference'  -- :: (Real a, Fractional a) => APolygon a -> Double
  , pAddPoints       -- :: Int -> Polygon -> Polygon
  , pAddPointsRestricted -- :: [Int] -> Int -> Polygon -> Polygon
  , pAddPointsBetween -- :: (Fractional a, Ord a, Real a) => (Int, Int) -> Int -> APolygon a -> APolygon a
  , pRayIntersect    -- :: Polygon -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
  , pOverlap         -- :: Polygon -> Polygon -> Polygon
  , pCuts         -- :: Polygon -> [(Polygon,Polygon)]
  , pCutEqual     -- :: Polygon -> (Polygon, Polygon)
  -- * Triangulation
  , isValidTriangulation     -- :: Polygon -> Triangulation -> Bool
  , triangulationsToPolygons -- :: Polygon -> Triangulation -> [Polygon]
  -- * Single-Source-Shortest-Path
  , ssspVisibility -- :: Polygon -> Polygon
  , ssspWindows -- :: Polygon -> [(V2 Rational, V2 Rational)]
  -- * Built-in shapes for testing
  , triangle  -- :: Polygon
  , triangle' -- :: [P]
  , shape1  -- :: Polygon
  , shape2  -- :: Polygon
  , shape3  -- :: Polygon
  , shape4  -- :: Polygon
  , shape5  -- :: Polygon
  , shape6  -- :: Polygon
  , shape7  -- :: Polygon
  , shape8  -- :: Polygon
  , shape9  -- :: Polygon
  , shape10 -- :: Polygon
  , shape11 -- :: Polygon
  , shape12 -- :: Polygon
  , shape13 -- :: Polygon
  , shape14 -- :: Polygon
  , shape15 -- :: Polygon
  , shape16 -- :: Polygon
  , shape17 -- :: Polygon
  , shape18 -- :: Polygon
  , shape19 -- :: Polygon
  , shape20 -- :: Polygon
  , shape21 -- :: Polygon
  , shape22 -- :: Polygon
  , shape23 -- :: Polygon
  , concave -- :: Polygon
  -- * Internals
  , pRing       -- :: APolygon a -> Ring a
  , pUnsafeMap  -- :: (Ring a -> Ring a) -> APolygon a -> APolygon a
  , pCopy       -- :: Polygon -> Polygon
  , pGenerate   -- :: [(Double, Double)] -> Polygon
  , pUnGenerate -- :: Polygon -> [(Double, Double)]
  , Epsilon
  ) where

-- import           Control.Exception
import           Data.Hashable
import           Data.List                  (intersect, maximumBy, sort, sortOn,
                                             tails)
import           Data.Maybe
import           Data.Ratio
import           Data.Serialize
import           Data.Vector                (Vector)
import qualified Data.Vector                as V
import           Linear.V2
import           Linear.Vector
import           Reanimate.Math.Common
-- import           Reanimate.Math.EarClip
import           Reanimate.Math.SSSP
import           Reanimate.Math.Triangulate

-- import Debug.Trace

-- Generate random polygons, options:
--   1. put corners around a circle. Vary the radius.
--   2. close a hilbert curve
type FPolygon = APolygon Double
-- Optimize representation?
--   Polygon = (Vector XNumerator, Vector XDenominator
--             ,Vector YNumerator, Vector YDenominator)
data APolygon a = Polygon
  { APolygon a -> Vector (V2 a)
polygonPoints        :: Vector (V2 a)
  , APolygon a -> Int
polygonOffset        :: Int
  , APolygon a -> Triangulation
polygonTriangulation :: Triangulation
  , APolygon a -> Vector SSSP
polygonSSSP          :: Vector SSSP
  }
type Polygon = APolygon Rational
type P = V2 Double

instance Show a => Show (APolygon a) where
  show :: APolygon a -> String
show = [V2 a] -> String
forall a. Show a => a -> String
show ([V2 a] -> String)
-> (APolygon a -> [V2 a]) -> APolygon a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (V2 a) -> [V2 a]
forall a. Vector a -> [a]
V.toList (Vector (V2 a) -> [V2 a])
-> (APolygon a -> Vector (V2 a)) -> APolygon a -> [V2 a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints

instance Hashable a => Hashable (APolygon a) where
  hashWithSalt :: Int -> APolygon a -> Int
hashWithSalt Int
s APolygon a
p = (Int -> V2 a -> Int) -> Int -> Vector (V2 a) -> Int
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' Int -> V2 a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints APolygon a
p)

instance (PolyCtx a, Serialize a) => Serialize (APolygon a) where
  put :: Putter (APolygon a)
put = Putter [V2 a]
forall t. Serialize t => Putter t
put Putter [V2 a] -> (APolygon a -> [V2 a]) -> Putter (APolygon a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (V2 a) -> [V2 a]
forall a. Vector a -> [a]
V.toList (Vector (V2 a) -> [V2 a])
-> (APolygon a -> Vector (V2 a)) -> APolygon a -> [V2 a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints
  get :: Get (APolygon a)
get = Vector (V2 a) -> APolygon a
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 a) -> APolygon a)
-> ([V2 a] -> Vector (V2 a)) -> [V2 a] -> APolygon a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList ([V2 a] -> APolygon a) -> Get [V2 a] -> Get (APolygon a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [V2 a]
forall t. Serialize t => Get t
get

pRing :: APolygon a -> Ring a
pRing :: APolygon a -> Ring a
pRing = Vector (V2 a) -> Ring a
forall a. Vector (V2 a) -> Ring a
ringPack (Vector (V2 a) -> Ring a)
-> (APolygon a -> Vector (V2 a)) -> APolygon a -> Ring a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints

type PolyCtx a = (Real a, Fractional a, Epsilon a)

mkPolygon :: PolyCtx a => V.Vector (V2 a) -> APolygon a
mkPolygon :: Vector (V2 a) -> APolygon a
mkPolygon Vector (V2 a)
points = Polygon :: forall a.
Vector (V2 a) -> Int -> Triangulation -> Vector SSSP -> APolygon a
Polygon
    { polygonPoints :: Vector (V2 a)
polygonPoints = Vector (V2 a)
points
    , polygonOffset :: Int
polygonOffset = Int
0
    , polygonTriangulation :: Triangulation
polygonTriangulation = Triangulation
trig
    , polygonSSSP :: Vector SSSP
polygonSSSP = Int -> (Int -> SSSP) -> Vector SSSP
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
n ((Int -> SSSP) -> Vector SSSP) -> (Int -> SSSP) -> Vector SSSP
forall a b. (a -> b) -> a -> b
$ \Int
i -> Ring a -> Dual -> SSSP
forall a.
(Fractional a, Ord a, Epsilon a) =>
Ring a -> Dual -> SSSP
sssp Ring a
ring (Int -> Triangulation -> Dual
dual Int
i Triangulation
trig)
    }
  where
    n :: Int
n = Vector (V2 a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (V2 a)
points
    ring :: Ring a
ring = Vector (V2 a) -> Ring a
forall a. Vector (V2 a) -> Ring a
ringPack Vector (V2 a)
points
    trig :: Triangulation
trig = Ring a -> Triangulation
forall a. (Fractional a, Ord a) => Ring a -> Triangulation
triangulate Ring a
ring
      -- earClip ring

castPolygon :: (PolyCtx a, PolyCtx b) => APolygon a -> APolygon b
castPolygon :: APolygon a -> APolygon b
castPolygon = Vector (V2 b) -> APolygon b
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 b) -> APolygon b)
-> (APolygon a -> Vector (V2 b)) -> APolygon a -> APolygon b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 a -> V2 b) -> Vector (V2 a) -> Vector (V2 b)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((a -> b) -> V2 a -> V2 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (Vector (V2 a) -> Vector (V2 b))
-> (APolygon a -> Vector (V2 a)) -> APolygon a -> Vector (V2 b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints

mkPolygonFromRing :: PolyCtx a => Ring a -> APolygon a
mkPolygonFromRing :: Ring a -> APolygon a
mkPolygonFromRing = Vector (V2 a) -> APolygon a
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 a) -> APolygon a)
-> (Ring a -> Vector (V2 a)) -> Ring a -> APolygon a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ring a -> Vector (V2 a)
forall a. Ring a -> Vector (V2 a)
ringUnpack

pUnsafeMap :: (Ring a -> Ring a) -> APolygon a -> APolygon a
pUnsafeMap :: (Ring a -> Ring a) -> APolygon a -> APolygon a
pUnsafeMap Ring a -> Ring a
fn APolygon a
p = APolygon a
p{ polygonPoints :: Vector (V2 a)
polygonPoints = Ring a -> Vector (V2 a)
forall a. Ring a -> Vector (V2 a)
ringUnpack (Ring a -> Ring a
fn (APolygon a -> Ring a
forall a. APolygon a -> Ring a
pRing APolygon a
p)) }

-- pParent p i j = shortest-path parent from j to i
pParent :: APolygon a -> Int -> Int -> Int
pParent :: APolygon a -> Int -> Int -> Int
pParent APolygon a
p Int
i Int
j =
    (SSSP
sTree SSSP -> Int -> Int
forall a. Vector a -> Int -> a
V.! Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ APolygon a -> Int
forall a. APolygon a -> Int
polygonOffset APolygon a
p) Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- APolygon a -> Int
forall a. APolygon a -> Int
polygonOffset APolygon a
p) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n
  where
    sTree :: SSSP
sTree = APolygon a -> Vector SSSP
forall a. APolygon a -> Vector SSSP
polygonSSSP APolygon a
p Vector SSSP -> Int -> SSSP
forall a. Vector a -> Int -> a
V.! Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ APolygon a -> Int
forall a. APolygon a -> Int
polygonOffset APolygon a
p) Int
n
    n :: Int
n = APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p

pCopy :: Polygon -> Polygon
pCopy :: Polygon -> Polygon
pCopy Polygon
p = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> V2 Rational) -> Vector (V2 Rational)
forall a. Int -> (Int -> a) -> Vector a
V.generate (Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
p) ((Int -> V2 Rational) -> Vector (V2 Rational))
-> (Int -> V2 Rational) -> Vector (V2 Rational)
forall a b. (a -> b) -> a -> b
$ Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p

pSetOffset :: APolygon a -> Int -> APolygon a
pSetOffset :: APolygon a -> Int -> APolygon a
pSetOffset APolygon a
p Int
offset =
  APolygon a
p { polygonOffset :: Int
polygonOffset = Int
offset Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p }

pAdjustOffset :: APolygon a -> Int -> APolygon a
pAdjustOffset :: APolygon a -> Int -> APolygon a
pAdjustOffset APolygon a
p Int
offset =
  APolygon a
p { polygonOffset :: Int
polygonOffset = (APolygon a -> Int
forall a. APolygon a -> Int
polygonOffset APolygon a
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p }

{-# INLINE pSize #-}
pSize :: APolygon a -> Int
pSize :: APolygon a -> Int
pSize = Vector (V2 a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector (V2 a) -> Int)
-> (APolygon a -> Vector (V2 a)) -> APolygon a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints

pNull :: APolygon a -> Bool
pNull :: APolygon a -> Bool
pNull = Vector (V2 a) -> Bool
forall a. Vector a -> Bool
V.null (Vector (V2 a) -> Bool)
-> (APolygon a -> Vector (V2 a)) -> APolygon a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints

pNext :: APolygon a -> Int -> Int
pNext :: APolygon a -> Int -> Int
pNext APolygon a
p Int
i = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p

pPrev :: APolygon a -> Int -> Int
pPrev :: APolygon a -> Int -> Int
pPrev APolygon a
p Int
i = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p

-- When is a polygon valid/simple?
--   It is counter-clockwise.
--   No edges intersect.
-- O(n^2)
-- 'checkEdge' takes 90% of the time.
pIsSimple :: Polygon -> Bool
pIsSimple :: Polygon -> Bool
pIsSimple Polygon
p | Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = Bool
False
pIsSimple Polygon
p = Polygon -> Bool
pIsCCW Polygon
p Bool -> Bool -> Bool
&& Bool
noDups Bool -> Bool -> Bool
&& Int -> Int -> Bool
checkEdge Int
0 Int
2
  where
    noDups :: Bool
noDups = [V2 Rational] -> Bool
forall a. Eq a => [a] -> Bool
checkForDups ([V2 Rational] -> [V2 Rational]
forall a. Ord a => [a] -> [a]
sort (Vector (V2 Rational) -> [V2 Rational]
forall a. Vector a -> [a]
V.toList (Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
p)))
    checkForDups :: [a] -> Bool
checkForDups (a
x:a
y:[a]
xs)
      = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y Bool -> Bool -> Bool
&& [a] -> Bool
checkForDups (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
    checkForDups [a]
_ = Bool
True
    len :: Int
len = Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
p
    -- check i,i+1 against j,j+1
    -- j > i+1
    checkEdge :: Int -> Int -> Bool
checkEdge Int
i Int
j
      | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3) Bool -> Bool -> Bool
|| Int -> Int -> Bool
checkEdge (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
      | Bool
otherwise =
        case (V2 Rational, V2 Rational)
-> (V2 Rational, V2 Rational) -> Maybe (V2 Rational)
forall a.
(Ord a, Fractional a) =>
(V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
lineIntersect (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
i, Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int -> V2 Rational) -> Int -> V2 Rational
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                           (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
j, Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int -> V2 Rational) -> Int -> V2 Rational
forall a b. (a -> b) -> a -> b
$ Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) of
          Just V2 Rational
u | V2 Rational
u V2 Rational -> V2 Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
i -> Bool
False
          Maybe (V2 Rational)
_nothing                  -> Int -> Int -> Bool
checkEdge Int
i (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

pScale :: Rational -> Polygon -> Polygon
pScale :: Rational -> Polygon -> Polygon
pScale Rational
s = (Ring Rational -> Ring Rational) -> Polygon -> Polygon
forall a. (Ring a -> Ring a) -> APolygon a -> APolygon a
pUnsafeMap ((V2 Rational -> V2 Rational) -> Ring Rational -> Ring Rational
forall a b. (V2 a -> V2 b) -> Ring a -> Ring b
ringMap (V2 Rational -> Rational -> V2 Rational
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Rational
s))

pAtCentroid :: Polygon -> Polygon
pAtCentroid :: Polygon -> Polygon
pAtCentroid Polygon
p = V2 Rational -> Polygon -> Polygon
pTranslate (V2 Rational -> V2 Rational
forall a. Num a => a -> a
negate V2 Rational
c) Polygon
p
  where c :: V2 Rational
c = Polygon -> V2 Rational
forall a. Fractional a => APolygon a -> V2 a
pCentroid Polygon
p V2 Rational -> Rational -> V2 Rational
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ Rational
2

pAtCenter :: Polygon -> Polygon
pAtCenter :: Polygon -> Polygon
pAtCenter Polygon
p = V2 Rational -> Polygon -> Polygon
pTranslate (V2 Rational -> V2 Rational
forall a. Num a => a -> a
negate (V2 Rational -> V2 Rational) -> V2 Rational -> V2 Rational
forall a b. (a -> b) -> a -> b
$ Polygon -> V2 Rational
pCenter Polygon
p) Polygon
p

pTranslate :: V2 Rational -> Polygon -> Polygon
pTranslate :: V2 Rational -> Polygon -> Polygon
pTranslate V2 Rational
v = (Ring Rational -> Ring Rational) -> Polygon -> Polygon
forall a. (Ring a -> Ring a) -> APolygon a -> APolygon a
pUnsafeMap ((V2 Rational -> V2 Rational) -> Ring Rational -> Ring Rational
forall a b. (V2 a -> V2 b) -> Ring a -> Ring b
ringMap (V2 Rational -> V2 Rational -> V2 Rational
forall a. Num a => a -> a -> a
+V2 Rational
v))

pCenter :: Polygon -> V2 Rational
pCenter :: Polygon -> V2 Rational
pCenter Polygon
p = Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (Rational
xRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
wRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2) (Rational
yRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
hRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)
  where
    (Rational
x,Rational
y,Rational
w,Rational
h) = Polygon -> (Rational, Rational, Rational, Rational)
pBoundingBox Polygon
p

-- Returns (min-x, min-y, width, height)
pBoundingBox :: Polygon -> (Rational, Rational, Rational, Rational)
pBoundingBox :: Polygon -> (Rational, Rational, Rational, Rational)
pBoundingBox = \Polygon
p ->
    let V2 Rational
x Rational
y = Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
0 in
    case ((Rational, Rational, Rational, Rational)
 -> V2 Rational -> (Rational, Rational, Rational, Rational))
-> (Rational, Rational, Rational, Rational)
-> Vector (V2 Rational)
-> (Rational, Rational, Rational, Rational)
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (Rational, Rational, Rational, Rational)
-> V2 Rational -> (Rational, Rational, Rational, Rational)
forall d. Ord d => (d, d, d, d) -> V2 d -> (d, d, d, d)
worker (Rational
x, Rational
y, Rational
0, Rational
0) (Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
p) of
      (Rational
xMin, Rational
yMin, Rational
xMax, Rational
yMax) ->
        (Rational
xMin, Rational
yMin, Rational
xMaxRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
xMin, Rational
yMaxRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
yMin)
  where
    worker :: (d, d, d, d) -> V2 d -> (d, d, d, d)
worker (d
xMin,d
yMin,d
xMax,d
yMax) (V2 d
thisX d
thisY) =
      (d -> d -> d
forall a. Ord a => a -> a -> a
min d
xMin d
thisX, d -> d -> d
forall a. Ord a => a -> a -> a
min d
yMin d
thisY
      ,d -> d -> d
forall a. Ord a => a -> a -> a
max d
xMax d
thisX, d -> d -> d
forall a. Ord a => a -> a -> a
max d
yMax d
thisY)

-- Place n points on a circle, use one parameter to slide the points back and forth.
-- Use second parameter to move points closer to center circle.
pGenerate :: [(Double, Double)] -> Polygon
pGenerate :: [(Double, Double)] -> Polygon
pGenerate [(Double, Double)]
points
  | Double
len Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
4 = String -> Polygon
forall a. HasCallStack => String -> a
error String
"pGenerate: require at least four points"
  | Bool
otherwise = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (Double -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Rational) -> Double -> Rational
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
cos Double
ang Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
rMod)
       (Double -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Rational) -> Double -> Rational
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
sin Double
ang Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
rMod)
  | (Double
i,(Double
angMod,Double
rMod))  <- [Double] -> [(Double, Double)] -> [(Double, (Double, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double
0..] [(Double, Double)]
points
  , let minAngle :: Double
minAngle = Double
tau Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
len Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
i Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
forall a. Floating a => a
pi
        maxAngle :: Double
maxAngle = Double
tau Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
len Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
iDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
forall a. Floating a => a
pi
        ang :: Double
ang = Double
minAngle Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
maxAngleDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
minAngle)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
angMod
  ]
  where
    tau :: Double
tau = Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi
    len :: Double
len = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(Double, Double)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Double, Double)]
points)

pUnGenerate :: Polygon -> [(Double, Double)]
pUnGenerate :: Polygon -> [(Double, Double)]
pUnGenerate Polygon
p =
    [ Double -> V2 Double -> (Double, Double)
worker Double
i ((Rational -> Double) -> V2 Rational -> V2 Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac V2 Rational
e)
    | (Double
i,V2 Rational
e) <- [Double] -> [V2 Rational] -> [(Double, V2 Rational)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double
0..] (Vector (V2 Rational) -> [V2 Rational]
forall a. Vector a -> [a]
V.toList (Vector (V2 Rational) -> [V2 Rational])
-> Vector (V2 Rational) -> [V2 Rational]
forall a b. (a -> b) -> a -> b
$ Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
p) ]
  where
    len :: Double
len = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
p)
    worker :: Double -> V2 Double -> (Double, Double)
worker Double
i (V2 Double
x Double
y) =
      let ang :: Double
ang = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
y Double
x
          minAngle :: Double
minAngle = Double
tau Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
len Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
i Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
forall a. Floating a => a
pi
          maxAngle :: Double
maxAngle = Double
tau Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
len Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
iDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
forall a. Floating a => a
pi
      in ((Double
angDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
minAngle)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
maxAngleDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
minAngle), Double -> Double
forall a. Floating a => a -> a
sqrt (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y))
    tau :: Double
tau = Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi

-- When is a triangulation valid?
--   Intersection: No internal edges intersect.
--   Completeness: All edge neighbours share a single internal edge.
isValidTriangulation :: Polygon -> Triangulation -> Bool
isValidTriangulation :: Polygon -> Triangulation -> Bool
isValidTriangulation Polygon
p Triangulation
t = Bool
isComplete Bool -> Bool -> Bool
&& Bool
intersectionFree
  where
    o :: Int
o = Polygon -> Int
forall a. APolygon a -> Int
polygonOffset Polygon
p
    isComplete :: Bool
isComplete = (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Int -> Bool
isProper [Int
0 .. Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
    isProper :: Int -> Bool
isProper Int
i =
      let j :: Int
j = Polygon -> Int -> Int
forall a. APolygon a -> Int -> Int
pNext Polygon
p Int
i in
      [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Polygon -> Int -> Int
forall a. APolygon a -> Int -> Int
pPrev Polygon
p Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Triangulation
t Triangulation -> Int -> [Int]
forall a. Vector a -> Int -> a
V.! Int
i)) [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` (Polygon -> Int -> Int
forall a. APolygon a -> Int -> Int
pNext Polygon
p Int
j Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Triangulation
t Triangulation -> Int -> [Int]
forall a. Vector a -> Int -> a
V.! Int
j)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    intersectionFree :: Bool
intersectionFree = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
      [ case (V2 Rational, V2 Rational)
-> (V2 Rational, V2 Rational) -> Maybe (V2 Rational)
forall a.
(Ord a, Fractional a) =>
(V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
lineIntersect (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o), Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o)) (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o), Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o)) of
          Maybe (V2 Rational)
Nothing -> Bool
True
          Just V2 Rational
u  -> V2 Rational
u V2 Rational -> V2 Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o) Bool -> Bool -> Bool
|| V2 Rational
u V2 Rational -> V2 Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o) Bool -> Bool -> Bool
||
                     V2 Rational
u V2 Rational -> V2 Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o) Bool -> Bool -> Bool
|| V2 Rational
u V2 Rational -> V2 Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o)
      | ((Int
a,Int
b),(Int
c,Int
d)) <- [((Int, Int), (Int, Int))]
edgePairs ]
    edgePairs :: [((Int, Int), (Int, Int))]
edgePairs = [ ((Int, Int)
e1, (Int, Int)
e2) | ((Int, Int)
e1, [(Int, Int)]
rest) <- [(Int, Int)] -> [[(Int, Int)]] -> [((Int, Int), [(Int, Int)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int, Int)]
edges (Int -> [[(Int, Int)]] -> [[(Int, Int)]]
forall a. Int -> [a] -> [a]
drop Int
1 ([[(Int, Int)]] -> [[(Int, Int)]])
-> [[(Int, Int)]] -> [[(Int, Int)]]
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> [[(Int, Int)]]
forall a. [a] -> [[a]]
tails [(Int, Int)]
edges), (Int, Int)
e2 <- [(Int, Int)]
rest]
    edges :: [(Int, Int)]
edges =
      [ (Int
n, Int
i)
      | (Int
n, [Int]
lst) <- [Int] -> [[Int]] -> [(Int, [Int])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Triangulation -> [[Int]]
forall a. Vector a -> [a]
V.toList Triangulation
t)
      , Int
i <- [Int]
lst
      , Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i
      ]

triangulationsToPolygons :: Polygon -> Triangulation -> [Polygon]
triangulationsToPolygons :: Polygon -> Triangulation -> [Polygon]
triangulationsToPolygons Polygon
p Triangulation
t =
  [ Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
    [ Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
g, Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
i, Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
j ]
  | Int
i <- [Int
0 .. Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  , let js :: [Int]
js = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Triangulation
t Triangulation -> Int -> [Int]
forall a. Vector a -> Int -> a
V.! Int
i
  , (Int
g, Int
j) <- [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
js) [Int]
js
  ]

pIsInside :: Polygon -> V2 Rational -> Bool
pIsInside :: Polygon -> V2 Rational -> Bool
pIsInside Polygon
p V2 Rational
point = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
  [ V2 Rational -> V2 Rational -> V2 Rational -> V2 Rational -> Bool
forall a.
(Fractional a, Ord a) =>
V2 a -> V2 a -> V2 a -> V2 a -> Bool
isInside (Int -> V2 Rational
rawAccess Int
g) (Int -> V2 Rational
rawAccess Int
i) (Int -> V2 Rational
rawAccess Int
j) V2 Rational
point
  | Int
i <- [Int
0 .. Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  , let js :: [Int]
js = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Polygon -> Triangulation
forall a. APolygon a -> Triangulation
polygonTriangulation Polygon
p Triangulation -> Int -> [Int]
forall a. Vector a -> Int -> a
V.! Int
i
  , (Int
g, Int
j) <- [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
js) [Int]
js
  ]
  where
    rawAccess :: Int -> V2 Rational
rawAccess Int
x = Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
p Vector (V2 Rational) -> Int -> V2 Rational
forall a. Vector a -> Int -> a
V.! Int
x

-- reducePolygons :: Int -> [Polygon] -> [Polygon]
-- reducePolygons n ps
--   | length ps <= n = ps
--   | otherwise =
--     let p = findSmallest ps
--         es = edges p
--         e = findSmallest es
--     in reducePolygons n (merge p e : delete p (delete e ps))
--   where
--     findSmallest = minimumBy (comparing area2X)
--     shareEdge p1 p2 =

{-# INLINE pAccess #-}
pAccess :: APolygon a -> Int -> V2 a
pAccess :: APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
i = -- polygonPoints p V.! ((polygonOffset p + i) `mod` pSize p)
  APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints APolygon a
p Vector (V2 a) -> Int -> V2 a
forall a. Vector a -> Int -> a
`V.unsafeIndex` ((APolygon a -> Int
forall a. APolygon a -> Int
polygonOffset APolygon a
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p)

triangle :: Polygon
triangle :: Polygon
triangle = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList [Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
0]

triangle' :: [P]
triangle' :: [V2 Double]
triangle' = [V2 Double] -> [V2 Double]
forall a. [a] -> [a]
reverse [Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
1 Double
1, Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
0 Double
0, Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
2 Double
0]

shape1 :: Polygon
shape1 :: Polygon
shape1 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
0
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
3, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
4, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
5, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
6
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
1 ]

shape2 :: Polygon
shape2 :: Polygon
shape2 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 (-Rational
1), Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 (-Rational
1), Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 (-Rational
2)
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 (-Rational
2), Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
2]

shape3 :: Polygon
shape3 :: Polygon
shape3 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
2]

shape4 :: Polygon
shape4 :: Polygon
shape4 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 (-Rational
1), Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 (-Rational
1),Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
2]

shape5 :: Polygon
shape5 :: Polygon
shape5 = Polygon -> [Polygon]
forall a. APolygon a -> [APolygon a]
pCycles Polygon
shape4 [Polygon] -> Int -> Polygon
forall a. [a] -> Int -> a
!! Int
2

-- square
shape6 :: Polygon
shape6 :: Polygon
shape6 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
1 ]

shape7 :: Polygon
shape7 :: Polygon
shape7 = Rational -> Polygon -> Polygon
pScale Rational
6 (Polygon -> Polygon) -> Polygon -> Polygon
forall a b. (a -> b) -> a -> b
$ Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
        [Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 ((-Integer
1567171105775771) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
144115188075855872) ((-Integer
7758063241391039) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1152921504606846976)
        ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 ((-Integer
2711114907999263) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
18014398509481984) ((-Integer
3561889280168807) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
18014398509481984)
        ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 ((-Integer
6897139157863177) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
72057594037927936) ((-Integer
1632144794297397) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
4503599627370496)
        ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (Integer
5592137945106423 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
36028797018963968) ((-Integer
71351641856107) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
281474976710656)
        ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (Integer
2568147525079071 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
4503599627370496) ((-Integer
4312925637247687) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
18014398509481984)
        ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (Integer
1291079014395023 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2251799813685248) (Integer
321513444515769 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2251799813685248)
        ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (Integer
2071709221627247 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
4503599627370496) (Integer
4019115966736491 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
9007199254740992)
        ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 ((-Integer
1589087869859839) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
144115188075855872) (Integer
4904023654354179 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
9007199254740992)
        ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 ((-Integer
2328090886101149) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
36028797018963968) (Integer
2587887893460759 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
36028797018963968)
        ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 ((-Integer
7990199074159871) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
18014398509481984) (Integer
1301850651537745 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
4503599627370496)]

shape8 :: Polygon
shape8 :: Polygon
shape8 = Rational -> Polygon -> Polygon
pScale Rational
10 (Polygon -> Polygon) -> Polygon -> Polygon
forall a b. (a -> b) -> a -> b
$ [(Double, Double)] -> Polygon
pGenerate
          [(Double
0.36,Double
0.4),(Double
0.7,Double
1.8e-2),(Double
0.7,Double
0.2),(Double
0.1,Double
0.4),(Double
0.2,Double
0.2),(Double
0.7,Double
0.1),(Double
0.4,Double
8.0e-2)]

shape9 :: Polygon
shape9 :: Polygon
shape9 = Rational -> Polygon -> Polygon
pScale Rational
5 (Polygon -> Polygon) -> Polygon -> Polygon
forall a b. (a -> b) -> a -> b
$ [(Double, Double)] -> Polygon
pGenerate
  [(Double
0.5,Double
0.2),(Double
0.7,Double
0.6),(Double
0.4,Double
0.3),(Double
0.1,Double
0.7),(Double
0.3,Double
1.0e-2),(Double
0.5,Double
0.3),(Double
0.2,Double
0.8),(Double
0.1,Double
0.8),(Double
0.7,Double
6.0e-2),(Double
0.1,Double
0.6)]

shape10 :: Polygon
shape10 :: Polygon
shape10 = [(Double, Double)] -> Polygon
pGenerate
  [(Double
0.4,Double
0.7),(Double
0.2,Double
0.2),(Double
0.3,Double
0.9),(Double
5.0e-2,Double
0.1),(Double
0.7,Double
1.0e-2),(Double
0.7,Double
0.9),(Double
0.2,Double
0.1),(Double
0.5,Double
6.0e-2),(Double
0.6,Double
9.0e-2)]

shape11 :: Polygon
shape11 :: Polygon
shape11 = [(Double, Double)] -> Polygon
pGenerate
  [(Double
0.1,Double
0.8),(Double
0.7,Double
0.6),(Double
0.7,Double
0.4),(Double
0.3,Double
0.5),(Double
0.8,Double
0.9),(Double
0.8,Double
6.0e-2),(Double
1.0e-2,Double
4.0e-2),(Double
0.8,Double
0.1)]

shape12 :: Polygon
shape12 :: Polygon
shape12 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.5 Rational
1.5, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
2) Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
0.5) Rational
1.5 ]

-- F shape
shape13 :: Polygon
shape13 :: Polygon
shape13 = Polygon -> [Polygon]
forall a. APolygon a -> [APolygon a]
pCycles (Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ Vector (V2 Rational) -> Vector (V2 Rational)
forall a. Vector a -> Vector a
V.reverse ([V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
2
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1.7, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.3 Rational
1.7, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.3 Rational
1
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0.7
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.3 Rational
0.7, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.3 Rational
0 ])) [Polygon] -> Int -> Polygon
forall a. [a] -> Int -> a
!! Int
7

-- E shape
shape14 :: Polygon
shape14 :: Polygon
shape14 = Polygon -> [Polygon]
forall a. APolygon a -> [APolygon a]
pCycles (Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ Vector (V2 Rational) -> Vector (V2 Rational)
forall a. Vector a -> Vector a
V.reverse (Vector (V2 Rational) -> Vector (V2 Rational))
-> Vector (V2 Rational) -> Vector (V2 Rational)
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
2 -- up
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1.7, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.3 Rational
1.7, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.3 Rational
1 -- first prong
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0.7, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.3 Rational
0.7, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.3 Rational
0.3 -- second prong
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0.3, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0 -- last prong
  ]) [Polygon] -> Int -> Polygon
forall a. [a] -> Int -> a
!! Int
9

--
shape15 :: Polygon
shape15 :: Polygon
shape15 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
0
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
2
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
1]

shape16 :: Polygon
shape16 :: Polygon
shape16 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
0
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
2]

shape17 :: Polygon
shape17 :: Polygon
shape17 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
1
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
2
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0 ]

shape18 :: Polygon
shape18 :: Polygon
shape18 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
2
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0 ]

shape19 :: Polygon
shape19 :: Polygon
shape19 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
3) (-Rational
3), Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 (-Rational
1)
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 (-Rational
3), Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 Rational
3, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
1
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
3) Rational
3, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
1) Rational
0 ]

shape20 :: Polygon
shape20 :: Polygon
shape20 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
3) (-Rational
3)
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 (-Rational
1)
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 (-Rational
3)
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
5 Rational
0
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2.5 (-Rational
2)
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 Rational
3
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
1
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
3) Rational
3
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
1) Rational
0 ]

shape21 :: Polygon
shape21 :: Polygon
shape21 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.0 Rational
0.0,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1.0 Rational
0.0,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1.0 Rational
1.0,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2.0 Rational
1.0,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2.0 (-Rational
1.0),Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3.0 (-Rational
1.0)
  ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3.0 Rational
2.0,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.0 Rational
2.0]

shape22 :: Polygon
shape22 :: Polygon
shape22 = Rational -> Polygon -> Polygon
pScale Rational
2 (Polygon -> Polygon) -> Polygon -> Polygon
forall a b. (a -> b) -> a -> b
$ Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
0.17) (-Rational
0.08)
  ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
0.34) (-Rational
0.21)
  ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0.0 Rational
0.0
  ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
0.10) Rational
0.60
  ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
0.14) Rational
0.19
  ,Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
0.05) Rational
0.03
  ]

shape23 :: Polygon
shape23 :: Polygon
shape23 = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$ [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList
  [ Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
4 Rational
0
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
4 Rational
3, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
3
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 Rational
2
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
3 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
2
  , Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
3, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
3 ]

concave :: Polygon
concave :: Polygon
concave = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$
  [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList [Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
0, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
2 Rational
2, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
1, Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
2]

pMkWinding :: Int -> Polygon
pMkWinding :: Int -> Polygon
pMkWinding Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> Polygon
forall a. HasCallStack => String -> a
error String
"Polygon must have at least one winding."
pMkWinding Int
n = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 Rational) -> Polygon)
-> Vector (V2 Rational) -> Polygon
forall a b. (a -> b) -> a -> b
$
    [V2 Rational] -> Vector (V2 Rational)
forall a. [a] -> Vector a
V.fromList ([V2 Rational] -> Vector (V2 Rational))
-> [V2 Rational] -> Vector (V2 Rational)
forall a b. (a -> b) -> a -> b
$ V2 Rational
p0 V2 Rational -> [V2 Rational] -> [V2 Rational]
forall a. a -> [a] -> [a]
: V2 Rational
p1 V2 Rational -> [V2 Rational] -> [V2 Rational]
forall a. a -> [a] -> [a]
: V2 Rational -> Int -> Int -> V2 Rational -> [V2 Rational]
forall t.
Real t =>
V2 Rational -> t -> t -> V2 Rational -> [V2 Rational]
walkTo V2 Rational
p1 Int
1 Int
n (Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
1 Rational
0) [V2 Rational] -> [V2 Rational] -> [V2 Rational]
forall a. [a] -> [a] -> [a]
++ [V2 Rational] -> [V2 Rational]
forall a. [a] -> [a]
reverse (V2 Rational -> Int -> Int -> V2 Rational -> [V2 Rational]
forall t.
Real t =>
V2 Rational -> t -> t -> V2 Rational -> [V2 Rational]
walkTo V2 Rational
p0 Int
1 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) (Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 (-Rational
1) Rational
0))
  where
    p0 :: V2 Rational
p0 = Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
0
    p1 :: V2 Rational
p1 = Rational -> Rational -> V2 Rational
forall a. a -> a -> V2 a
V2 Rational
0 Rational
1
    walkTo :: V2 Rational -> t -> t -> V2 Rational -> [V2 Rational]
walkTo V2 Rational
at t
a t
b V2 Rational
dir
      | t
a t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
b = []
      | Bool
otherwise =
        let newAt :: V2 Rational
newAt = V2 Rational
at V2 Rational -> V2 Rational -> V2 Rational
forall a. Num a => a -> a -> a
+ (V2 Rational
dir V2 Rational -> Rational -> V2 Rational
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* t -> Rational
forall a. Real a => a -> Rational
toRational t
a)
        in V2 Rational
newAt V2 Rational -> [V2 Rational] -> [V2 Rational]
forall a. a -> [a] -> [a]
: V2 Rational -> t -> t -> V2 Rational -> [V2 Rational]
walkTo V2 Rational
newAt (t
at -> t -> t
forall a. Num a => a -> a -> a
+t
1) t
b (V2 Rational -> V2 Rational
forall a. Num a => V2 a -> V2 a
rot V2 Rational
dir)
    rot :: V2 a -> V2 a
rot (V2 a
x a
y) =
      a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
y (-a
x)

pDeoverlap :: Polygon -> Polygon
pDeoverlap :: Polygon -> Polygon
pDeoverlap Polygon
p = Vector (V2 Rational) -> Polygon
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon Vector (V2 Rational)
arr
  where
    arr :: Vector (V2 Rational)
arr = Int -> (Int -> V2 Rational) -> Vector (V2 Rational)
forall a. Int -> (Int -> a) -> Vector a
V.generate (Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
p) Int -> V2 Rational
worker
    worker :: Int -> V2 Rational
worker Int
0 = Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
0
    worker Int
n =
      if SSSP -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (V2 Rational -> Vector (V2 Rational) -> SSSP
forall a. Eq a => a -> Vector a -> SSSP
V.elemIndices (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
n) (Polygon -> Vector (V2 Rational)
forall a. APolygon a -> Vector (V2 a)
polygonPoints Polygon
p)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
        then
          let prev :: V2 Rational
prev = Vector (V2 Rational)
arr Vector (V2 Rational) -> Int -> V2 Rational
forall a. Vector a -> Int -> a
V.! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
              this :: V2 Rational
this = Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
n
          in Rational -> V2 Rational -> V2 Rational -> V2 Rational
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp Rational
0.99999 V2 Rational
this V2 Rational
prev
        else Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
n

pCycles :: APolygon a -> [APolygon a]
pCycles :: APolygon a -> [APolygon a]
pCycles APolygon a
p = (Int -> APolygon a) -> [Int] -> [APolygon a]
forall a b. (a -> b) -> [a] -> [b]
map (APolygon a -> Int -> APolygon a
forall a. APolygon a -> Int -> APolygon a
pAdjustOffset APolygon a
p) [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

pCycle :: PolyCtx a => APolygon a -> Double -> APolygon a
pCycle :: APolygon a -> Double -> APolygon a
pCycle APolygon a
p Double
0 = APolygon a
p
pCycle APolygon a
p Double
t = Vector (V2 a) -> APolygon a
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 a) -> APolygon a) -> Vector (V2 a) -> APolygon a
forall a b. (a -> b) -> a -> b
$ Double -> Int -> Vector (V2 a)
worker Double
0 Int
0
  where
    worker :: Double -> Int -> Vector (V2 a)
worker Double
acc Int
i
      | Double
segment Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
acc Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
limit =
        V2 a -> Vector (V2 a)
forall a. a -> Vector a
V.singleton (a -> V2 a -> V2 a -> V2 a
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp (Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$ (Double
segment Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
acc Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
limit)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
segment) V2 a
x V2 a
y) Vector (V2 a) -> Vector (V2 a) -> Vector (V2 a)
forall a. Semigroup a => a -> a -> a
<>
        -- V.drop (i+1) (polygonPoints p) <>
        [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList ((Int -> V2 a) -> [Int] -> [V2 a]
forall a b. (a -> b) -> [a] -> [b]
map (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p) [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) Vector (V2 a) -> Vector (V2 a) -> Vector (V2 a)
forall a. Semigroup a => a -> a -> a
<>
        [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList ((Int -> V2 a) -> [Int] -> [V2 a]
forall a b. (a -> b) -> [a] -> [b]
map (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p) [Int
0 .. Int
i])
        -- V.take (i+1) (polygonPoints p)
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1  = [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList ((Int -> V2 a) -> [Int] -> [V2 a]
forall a b. (a -> b) -> [a] -> [b]
map (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p) [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
      | Bool
otherwise = Double -> Int -> Vector (V2 a)
worker (Double
accDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
segment) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        where
          x :: V2 a
x = APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
i
          y :: V2 a
y = APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
          segment :: Double
segment = V2 a -> V2 a -> Double
forall a. (Real a, Fractional a) => V2 a -> V2 a -> Double
distance' V2 a
x V2 a
y
    len :: Double
len = APolygon a -> Double
forall a. (Real a, Fractional a) => APolygon a -> Double
pCircumference' APolygon a
p
    limit :: Double
limit = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
len

pCentroid :: Fractional a => APolygon a -> V2 a
pCentroid :: APolygon a -> V2 a
pCentroid APolygon a
p = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
cx a
cy
  where
    a :: a
a = APolygon a -> a
forall a. Fractional a => APolygon a -> a
pArea APolygon a
p
    cx :: a
cx = a -> a
forall a. Fractional a => a -> a
recip (a
6a -> a -> a
forall a. Num a => a -> a -> a
*a
a) a -> a -> a
forall a. Num a => a -> a -> a
* Vector a -> a
forall a. Num a => Vector a -> a
V.sum ((V2 a -> V2 a -> a) -> APolygon a -> Vector a
forall a b. (V2 a -> V2 a -> b) -> APolygon a -> Vector b
pMapEdges V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
fnX APolygon a
p)
    cy :: a
cy = a -> a
forall a. Fractional a => a -> a
recip (a
6a -> a -> a
forall a. Num a => a -> a -> a
*a
a) a -> a -> a
forall a. Num a => a -> a -> a
* Vector a -> a
forall a. Num a => Vector a -> a
V.sum ((V2 a -> V2 a -> a) -> APolygon a -> Vector a
forall a b. (V2 a -> V2 a -> b) -> APolygon a -> Vector b
pMapEdges V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
fnY APolygon a
p)
    fnX :: V2 a -> V2 a -> a
fnX (V2 a
x a
y) (V2 a
x' a
y') = (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
x')a -> a -> a
forall a. Num a => a -> a -> a
*(a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
y' a -> a -> a
forall a. Num a => a -> a -> a
- a
x'a -> a -> a
forall a. Num a => a -> a -> a
*a
y)
    fnY :: V2 a -> V2 a -> a
fnY (V2 a
x a
y) (V2 a
x' a
y') = (a
ya -> a -> a
forall a. Num a => a -> a -> a
+a
y')a -> a -> a
forall a. Num a => a -> a -> a
*(a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
y' a -> a -> a
forall a. Num a => a -> a -> a
- a
x'a -> a -> a
forall a. Num a => a -> a -> a
*a
y)

{-# INLINE pMapEdges #-}
pMapEdges :: (V2 a -> V2 a -> b) -> APolygon a -> V.Vector b
pMapEdges :: (V2 a -> V2 a -> b) -> APolygon a -> Vector b
pMapEdges V2 a -> V2 a -> b
fn APolygon a
p = Int -> (Int -> b) -> Vector b
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
n ((Int -> b) -> Vector b) -> (Int -> b) -> Vector b
forall a b. (a -> b) -> a -> b
$ \Int
i ->
  if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
    then V2 a -> V2 a -> b
fn (Vector (V2 a)
arr Vector (V2 a) -> Int -> V2 a
forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
i) (Vector (V2 a)
arr Vector (V2 a) -> Int -> V2 a
forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
0)
    else V2 a -> V2 a -> b
fn (Vector (V2 a)
arr Vector (V2 a) -> Int -> V2 a
forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
i) (Vector (V2 a)
arr Vector (V2 a) -> Int -> V2 a
forall a. Vector a -> Int -> a
`V.unsafeIndex` (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
  where
    n :: Int
n = APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p
    arr :: Vector (V2 a)
arr = APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints APolygon a
p

{-# SPECIALIZE pArea :: APolygon Double -> Double #-}
{-# SPECIALIZE pArea :: APolygon Rational -> Rational #-}
pArea :: (Fractional a) => APolygon a -> a
pArea :: APolygon a -> a
pArea APolygon a
p =
  -- 0.5 * V.sum (pMapEdges (\(V2 x y) (V2 x' y') -> x*y' - x'*y) p)
  a
0.5 a -> a -> a
forall a. Num a => a -> a -> a
* a -> Int -> a
worker a
0 Int
0
  where
    fn :: V2 a -> V2 a -> a
fn (V2 a
x a
y) (V2 a
x' a
y') = a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
y' a -> a -> a
forall a. Num a => a -> a -> a
- a
x'a -> a -> a
forall a. Num a => a -> a -> a
*a
y
    arr :: Vector (V2 a)
arr = APolygon a -> Vector (V2 a)
forall a. APolygon a -> Vector (V2 a)
polygonPoints APolygon a
p
    worker :: a -> Int -> a
worker !a
acc Int
i
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
fn (Vector (V2 a)
arr Vector (V2 a) -> Int -> V2 a
forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
i) (Vector (V2 a)
arr Vector (V2 a) -> Int -> V2 a
forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
0)
      | Bool
otherwise =
        a -> Int -> a
worker (a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
fn (Vector (V2 a)
arr Vector (V2 a) -> Int -> V2 a
forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
i) (Vector (V2 a)
arr Vector (V2 a) -> Int -> V2 a
forall a. Vector a -> Int -> a
`V.unsafeIndex` (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

pCircumference :: (Real a, Fractional a) => APolygon a -> a
pCircumference :: APolygon a -> a
pCircumference APolygon a
p = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
  [ V2 a -> V2 a -> a
forall a. (Real a, Fractional a) => V2 a -> V2 a -> a
approxDist (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
i) (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  | Int
i <- [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]

pCircumference' :: (Real a, Fractional a) => APolygon a -> Double
pCircumference' :: APolygon a -> Double
pCircumference' APolygon a
p = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
  [ V2 a -> V2 a -> Double
forall a. (Real a, Fractional a) => V2 a -> V2 a -> Double
distance' (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
i) (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  | Int
i <- [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]


-- Add points by splitting the longest lines in half repeatedly.
pAddPoints :: PolyCtx a => Int -> APolygon a -> APolygon a
pAddPoints :: Int -> APolygon a -> APolygon a
pAddPoints = [(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
forall a.
PolyCtx a =>
[(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
pAddPointsRestricted []

pAddPointsRestricted :: PolyCtx a => [(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
pAddPointsRestricted :: [(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
pAddPointsRestricted [(V2 a, V2 a)]
_immutableEdges Int
n APolygon a
p | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = APolygon a
p
pAddPointsRestricted [(V2 a, V2 a)]
immutableEdges Int
n APolygon a
p = [(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
forall a.
PolyCtx a =>
[(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
pAddPointsRestricted [(V2 a, V2 a)]
immutableEdges (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (APolygon a -> APolygon a) -> APolygon a -> APolygon a
forall a b. (a -> b) -> a -> b
$
    Vector (V2 a) -> APolygon a
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 a) -> APolygon a) -> Vector (V2 a) -> APolygon a
forall a b. (a -> b) -> a -> b
$ [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList ([V2 a] -> Vector (V2 a)) -> [V2 a] -> Vector (V2 a)
forall a b. (a -> b) -> a -> b
$ (Int -> [V2 a]) -> [Int] -> [V2 a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [V2 a]
worker [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  where
    isImmutable :: Int -> Bool
isImmutable Int
idx =
      (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
idx, APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (V2 a, V2 a) -> [(V2 a, V2 a)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(V2 a, V2 a)]
immutableEdges Bool -> Bool -> Bool
||
      (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
idx) (V2 a, V2 a) -> [(V2 a, V2 a)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(V2 a, V2 a)]
immutableEdges
    worker :: Int -> [V2 a]
worker Int
idx
      | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
longestEdge Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Bool
isImmutable Int
idx) =
        [APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
idx, APolygon a -> Int -> V2 a
forall a. PolyCtx a => APolygon a -> Int -> V2 a
pMiddlePoint APolygon a
p Int
idx]
      | Bool
otherwise = [APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
idx]
    longestEdge :: Int
longestEdge = (Int -> Int -> Ordering) -> [Int] -> Int
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Int -> Int -> Ordering
cmpLength [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
    cmpLength :: Int -> Int -> Ordering
cmpLength Int
a Int
_ | Int -> Bool
isImmutable Int
a = Ordering
LT
    cmpLength Int
_ Int
b | Int -> Bool
isImmutable Int
b = Ordering
GT
    cmpLength Int
a Int
b =
      V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
distSquared (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
a) (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`
      V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
distSquared (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
b) (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

pMiddlePoint :: PolyCtx a => APolygon a -> Int -> V2 a
pMiddlePoint :: APolygon a -> Int -> V2 a
pMiddlePoint APolygon a
p Int
idx
  = a -> V2 a -> V2 a -> V2 a
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp a
0.5 (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
idx)

pAddPointsBetween :: PolyCtx a => (Int, Int) -> Int -> APolygon a -> APolygon a
pAddPointsBetween :: (Int, Int) -> Int -> APolygon a -> APolygon a
pAddPointsBetween (Int, Int)
_ Int
n APolygon a
p | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = APolygon a
p
pAddPointsBetween (Int
i,Int
l) Int
n APolygon a
p = (Int, Int) -> Int -> APolygon a -> APolygon a
forall a.
PolyCtx a =>
(Int, Int) -> Int -> APolygon a -> APolygon a
pAddPointsBetween (Int
i,Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (APolygon a -> APolygon a) -> APolygon a -> APolygon a
forall a b. (a -> b) -> a -> b
$
    Vector (V2 a) -> APolygon a
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 a) -> APolygon a) -> Vector (V2 a) -> APolygon a
forall a b. (a -> b) -> a -> b
$ [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList ([V2 a] -> Vector (V2 a)) -> [V2 a] -> Vector (V2 a)
forall a b. (a -> b) -> a -> b
$ (Int -> [V2 a]) -> [Int] -> [V2 a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [V2 a]
worker [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  where
    worker :: Int -> [V2 a]
worker Int
idx
      | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
longestEdge =
        [APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
idx, APolygon a -> Int -> V2 a
forall a. PolyCtx a => APolygon a -> Int -> V2 a
pMiddlePoint APolygon a
p Int
idx]
      | Bool
otherwise = [APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
idx]
    longestEdge :: Int
longestEdge = (Int -> Int -> Ordering) -> [Int] -> Int
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Int -> Int -> Ordering
cmpLength [Int
i .. Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
    cmpLength :: Int -> Int -> Ordering
cmpLength Int
a Int
b =
      V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
distSquared (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
a) (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`
      V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
distSquared (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
b) (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p (Int -> V2 a) -> Int -> V2 a
forall a b. (a -> b) -> a -> b
$ Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- addPoints :: Int -> Polygon -> Polygon
-- addPoints n p = mkPolygon $ V.fromList $ worker n 0 (map (pAccess p) [0..s])
--   where
--     worker 0 _ rest = init rest
--     worker i acc (x:y:xs) =
--       let xy = approxDist x y in
--       if acc + xy > limit
--         then x : worker (i-1) 0 (lerp ((limit-acc)/xy) y x : y:xs)
--         else x : worker i (acc+xy) (y:xs)
--     worker _ _ [_] = []
--     worker _ _ _ = error "addPoints: invalid polygon"
--     s = pSize p
--     len = polygonLength p
--     limit = len / fromIntegral (n+1)

pIsConvex :: Polygon -> Bool
pIsConvex :: Polygon -> Bool
pIsConvex Polygon
p = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
  [ V2 Rational -> V2 Rational -> V2 Rational -> Rational
forall a. Fractional a => V2 a -> V2 a -> V2 a -> a
area2X (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
i) (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
j) (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
k) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0
  | Int
i <- [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  , Int
j <- [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  , Int
k <- [Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  ]
  where n :: Int
n = Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
p

pIsCCW :: Polygon -> Bool
pIsCCW :: Polygon -> Bool
pIsCCW Polygon
p | Polygon -> Bool
forall a. APolygon a -> Bool
pNull Polygon
p = Bool
False
pIsCCW Polygon
p = Vector Rational -> Rational
forall a. Num a => Vector a -> a
V.sum ((V2 Rational -> V2 Rational -> Rational)
-> Polygon -> Vector Rational
forall a b. (V2 a -> V2 a -> b) -> APolygon a -> Vector b
pMapEdges V2 Rational -> V2 Rational -> Rational
forall a. Num a => V2 a -> V2 a -> a
fn Polygon
p) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0
  where
    fn :: V2 a -> V2 a -> a
fn (V2 a
x1 a
y1) (V2 a
x2 a
y2) = (a
x2a -> a -> a
forall a. Num a => a -> a -> a
-a
x1)a -> a -> a
forall a. Num a => a -> a -> a
*(a
y2a -> a -> a
forall a. Num a => a -> a -> a
+a
y1)

{-# INLINE pRayIntersect #-}
pRayIntersect :: PolyCtx a => APolygon a -> (Int, Int) -> (Int,Int) -> Maybe (V2 a)
pRayIntersect :: APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
pRayIntersect APolygon a
p (Int
a,Int
b) (Int
c,Int
d) =
  (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
forall a.
(Fractional a, Ord a) =>
(V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
rayIntersect (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
a, APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
b) (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
c, APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
d)

pCuts :: (Real a, Fractional a, Epsilon a) => APolygon a -> [(APolygon a,APolygon a)]
pCuts :: APolygon a -> [(APolygon a, APolygon a)]
pCuts APolygon a
p =
  [ APolygon a -> Int -> (APolygon a, APolygon a)
forall a.
PolyCtx a =>
APolygon a -> Int -> (APolygon a, APolygon a)
pCutAt (APolygon a -> Int -> APolygon a
forall a. APolygon a -> Int -> APolygon a
pAdjustOffset APolygon a
p Int
i) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)
  | Int
i <- [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 ]
  , Int
j <- [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 ]
  , (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
i
  , APolygon a -> Int -> Int -> Int
forall a. APolygon a -> Int -> Int -> Int
pParent APolygon a
p Int
i Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i ]

pCutEqual :: PolyCtx a => APolygon a -> (APolygon a, APolygon a)
pCutEqual :: APolygon a -> (APolygon a, APolygon a)
pCutEqual APolygon a
p =
    (APolygon a, APolygon a)
-> Maybe (APolygon a, APolygon a) -> (APolygon a, APolygon a)
forall a. a -> Maybe a -> a
fromMaybe (APolygon a
p,APolygon a
p) (Maybe (APolygon a, APolygon a) -> (APolygon a, APolygon a))
-> Maybe (APolygon a, APolygon a) -> (APolygon a, APolygon a)
forall a b. (a -> b) -> a -> b
$ [(APolygon a, APolygon a)] -> Maybe (APolygon a, APolygon a)
forall a. [a] -> Maybe a
listToMaybe ([(APolygon a, APolygon a)] -> Maybe (APolygon a, APolygon a))
-> [(APolygon a, APolygon a)] -> Maybe (APolygon a, APolygon a)
forall a b. (a -> b) -> a -> b
$ ((APolygon a, APolygon a) -> a)
-> [(APolygon a, APolygon a)] -> [(APolygon a, APolygon a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (APolygon a, APolygon a) -> a
forall a. Fractional a => (APolygon a, APolygon a) -> a
f ([(APolygon a, APolygon a)] -> [(APolygon a, APolygon a)])
-> [(APolygon a, APolygon a)] -> [(APolygon a, APolygon a)]
forall a b. (a -> b) -> a -> b
$ APolygon a -> [(APolygon a, APolygon a)]
forall a.
(Real a, Fractional a, Epsilon a) =>
APolygon a -> [(APolygon a, APolygon a)]
pCuts APolygon a
p
  where
    f :: (APolygon a, APolygon a) -> a
f (APolygon a
a,APolygon a
b) = a -> a
forall a. Num a => a -> a
abs (APolygon a -> a
forall a. Fractional a => APolygon a -> a
pArea APolygon a
a a -> a -> a
forall a. Num a => a -> a -> a
- APolygon a -> a
forall a. Fractional a => APolygon a -> a
pArea APolygon a
b)

-- FIXME: This should be more efficient
pCutAt :: PolyCtx a => APolygon a -> Int -> (APolygon a, APolygon a)
pCutAt :: APolygon a -> Int -> (APolygon a, APolygon a)
pCutAt APolygon a
p Int
i = (Vector (V2 a) -> APolygon a
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 a) -> APolygon a) -> Vector (V2 a) -> APolygon a
forall a b. (a -> b) -> a -> b
$ [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList [V2 a]
left, Vector (V2 a) -> APolygon a
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 a) -> APolygon a) -> Vector (V2 a) -> APolygon a
forall a b. (a -> b) -> a -> b
$ [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList [V2 a]
right)
  where
    n :: Int
n     = APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
p
    left :: [V2 a]
left  = (Int -> V2 a) -> [Int] -> [V2 a]
forall a b. (a -> b) -> [a] -> [b]
map (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p) [Int
0 .. Int
i]
    right :: [V2 a]
right = (Int -> V2 a) -> [Int] -> [V2 a]
forall a b. (a -> b) -> [a] -> [b]
map (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p) (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int
i..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])

pOverlap :: PolyCtx a => APolygon a -> APolygon a -> APolygon a
pOverlap :: APolygon a -> APolygon a -> APolygon a
pOverlap APolygon a
a APolygon a
b = Vector (V2 a) -> APolygon a
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 a) -> APolygon a) -> Vector (V2 a) -> APolygon a
forall a b. (a -> b) -> a -> b
$ [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList ([V2 a] -> Vector (V2 a)) -> [V2 a] -> Vector (V2 a)
forall a b. (a -> b) -> a -> b
$ [V2 a] -> [V2 a]
forall a. Eq a => [a] -> [a]
clearDups ([V2 a] -> [V2 a]) -> [V2 a] -> [V2 a]
forall a b. (a -> b) -> a -> b
$ (Int -> [V2 a]) -> [Int] -> [V2 a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [V2 a]
edgeIntersect [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  where
    clearDups :: [a] -> [a]
clearDups (a
x:a
y:[a]
xs)
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a]
clearDups (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
      | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
clearDups (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
    clearDups [a]
xs = [a]
xs
    edgeIntersect :: Int -> [V2 a]
edgeIntersect Int
edge =
      (V2 a -> a) -> [V2 a] -> [V2 a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (V2 a -> V2 a -> a
forall a. Num a => V2 a -> V2 a -> a
distSquared (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
a Int
edge)) ([V2 a] -> [V2 a]) -> [V2 a] -> [V2 a]
forall a b. (a -> b) -> a -> b
$ [Maybe (V2 a)] -> [V2 a]
forall a. [Maybe a] -> [a]
catMaybes
      [ (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
forall a.
(Ord a, Fractional a) =>
(V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
lineIntersect (V2 a
aP, V2 a
aP') (V2 a
bP, V2 a
bP')
      | Int
i <- [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
      , let aP :: V2 a
aP = APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
a Int
edge
            aP' :: V2 a
aP' = APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
a (Int
edgeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            bP :: V2 a
bP = APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
b Int
i
            bP' :: V2 a
bP' = APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
b (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      ]

---------------------------------------------------------
-- SSSP visibility and SSSP windows

ssspVisibility :: PolyCtx a => APolygon a -> APolygon a
ssspVisibility :: APolygon a -> APolygon a
ssspVisibility APolygon a
p = Vector (V2 a) -> APolygon a
forall a. PolyCtx a => Vector (V2 a) -> APolygon a
mkPolygon (Vector (V2 a) -> APolygon a) -> Vector (V2 a) -> APolygon a
forall a b. (a -> b) -> a -> b
$
    [V2 a] -> Vector (V2 a)
forall a. [a] -> Vector a
V.fromList ([V2 a] -> Vector (V2 a)) -> [V2 a] -> Vector (V2 a)
forall a b. (a -> b) -> a -> b
$ [V2 a] -> [V2 a]
forall a. Eq a => [a] -> [a]
clearDups ([V2 a] -> [V2 a]) -> [V2 a] -> [V2 a]
forall a b. (a -> b) -> a -> b
$ [Int] -> [V2 a]
go [Int
0 .. APolygon a -> Int
forall a. APolygon a -> Int
pSize APolygon a
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] -- ([root..pSize p-1]  ++ [0 .. root-1])
  where
    clearDups :: [a] -> [a]
clearDups (a
x:a
y:[a]
xs)
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a]
clearDups (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
      | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
clearDups (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
    clearDups [a]
xs = [a]
xs
    obstructedBy :: Int -> Int
obstructedBy Int
n =
      case APolygon a -> Int -> Int -> Int
forall a. APolygon a -> Int -> Int -> Int
pParent APolygon a
p Int
0 Int
n of
        Int
0 -> Int
n
        Int
i -> Int -> Int
obstructedBy Int
i
    go :: [Int] -> [V2 a]
go [] = []
    go [Int
x] = [APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
x]
    go (Int
x:Int
y:[Int]
xs) =
      let xO :: Int
xO = Int -> Int
obstructedBy Int
x
          yO :: Int
yO = Int -> Int
obstructedBy Int
y
      in case () of
          ()
            -- Both ends are visible.
            | Int
xO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x Bool -> Bool -> Bool
&& Int
yO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y -> APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
x V2 a -> [V2 a] -> [V2 a]
forall a. a -> [a] -> [a]
: [Int] -> [V2 a]
go (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
            -- X is visible, x to intersect (0,yO) (x,y)
            | Int
xO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x   ->
              APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
x V2 a -> [V2 a] -> [V2 a]
forall a. a -> [a] -> [a]
: V2 a -> Maybe (V2 a) -> V2 a
forall a. a -> Maybe a -> a
fromMaybe (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
y) (APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
forall a.
PolyCtx a =>
APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
pRayIntersect APolygon a
p (Int
0,Int
yO) (Int
x,Int
y)) V2 a -> [V2 a] -> [V2 a]
forall a. a -> [a] -> [a]
: [Int] -> [V2 a]
go (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
            -- Y is visible
            | Int
yO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y   -> V2 a -> Maybe (V2 a) -> V2 a
forall a. a -> Maybe a -> a
fromMaybe (APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
x) (APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
forall a.
PolyCtx a =>
APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
pRayIntersect APolygon a
p (Int
0,Int
xO) (Int
x,Int
y)) V2 a -> [V2 a] -> [V2 a]
forall a. a -> [a] -> [a]
: APolygon a -> Int -> V2 a
forall a. APolygon a -> Int -> V2 a
pAccess APolygon a
p Int
y V2 a -> [V2 a] -> [V2 a]
forall a. a -> [a] -> [a]
: [Int] -> [V2 a]
go (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
            -- Neither is visible and they've obstructed by the same point
            -- so the entire edge is hidden.
            | Int
xO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
yO -> [Int] -> [V2 a]
go (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
            -- Neither is visible. Cast shadow from obstruction points to
            -- find if a subsection of the edge is visible.
            | Bool
otherwise ->
              let a :: V2 a
a = V2 a -> Maybe (V2 a) -> V2 a
forall a. a -> Maybe a -> a
fromMaybe (String -> V2 a
forall a. HasCallStack => String -> a
error String
"a") (APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
forall a.
PolyCtx a =>
APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
pRayIntersect APolygon a
p (Int
0,Int
xO) (Int
x,Int
y))
                  b :: V2 a
b = V2 a -> Maybe (V2 a) -> V2 a
forall a. a -> Maybe a -> a
fromMaybe (String -> V2 a
forall a. HasCallStack => String -> a
error String
"b") (APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
forall a.
PolyCtx a =>
APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
pRayIntersect APolygon a
p (Int
0,Int
yO) (Int
x,Int
y))
              in if V2 a
a V2 a -> V2 a -> Bool
forall a. Eq a => a -> a -> Bool
/= V2 a
b
                then V2 a
a V2 a -> [V2 a] -> [V2 a]
forall a. a -> [a] -> [a]
: V2 a
b V2 a -> [V2 a] -> [V2 a]
forall a. a -> [a] -> [a]
: [Int] -> [V2 a]
go (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
                else [Int] -> [V2 a]
go (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)

ssspWindows :: Polygon -> [(V2 Rational, V2 Rational)]
ssspWindows :: Polygon -> [(V2 Rational, V2 Rational)]
ssspWindows Polygon
p = [(V2 Rational, V2 Rational)] -> [(V2 Rational, V2 Rational)]
forall a. Eq a => [a] -> [a]
clearDups ([(V2 Rational, V2 Rational)] -> [(V2 Rational, V2 Rational)])
-> [(V2 Rational, V2 Rational)] -> [(V2 Rational, V2 Rational)]
forall a b. (a -> b) -> a -> b
$ V2 Rational -> [Int] -> [(V2 Rational, V2 Rational)]
go (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
0) [Int
0..Polygon -> Int
forall a. APolygon a -> Int
pSize Polygon
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  where
    clearDups :: [a] -> [a]
clearDups (a
x:a
y:[a]
xs)
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a]
clearDups (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
      | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
clearDups (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
    clearDups [a]
xs = [a]
xs
    obstructedBy :: Int -> Int
obstructedBy Int
n =
      case Polygon -> Int -> Int -> Int
forall a. APolygon a -> Int -> Int -> Int
pParent Polygon
p Int
0 Int
n of
        Int
0 -> Int
n
        Int
i -> Int -> Int
obstructedBy Int
i
    go :: V2 Rational -> [Int] -> [(V2 Rational, V2 Rational)]
go V2 Rational
_ [] = []
    go V2 Rational
_ [Int
_] = []
    go V2 Rational
l (Int
x:Int
y:[Int]
xs) =
      let xO :: Int
xO = Int -> Int
obstructedBy Int
x
          yO :: Int
yO = Int -> Int
obstructedBy Int
y
      in case () of
          ()
            -- Both ends are visible.
            | Int
xO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x Bool -> Bool -> Bool
&& Int
yO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y -> V2 Rational -> [Int] -> [(V2 Rational, V2 Rational)]
go (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
x) (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
            -- X is visible, x to intersect (0,yO) (x,y)
            | Int
xO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x   ->
              V2 Rational -> [Int] -> [(V2 Rational, V2 Rational)]
go (V2 Rational -> Maybe (V2 Rational) -> V2 Rational
forall a. a -> Maybe a -> a
fromMaybe (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
y) (Polygon -> (Int, Int) -> (Int, Int) -> Maybe (V2 Rational)
forall a.
PolyCtx a =>
APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
pRayIntersect Polygon
p (Int
0,Int
yO) (Int
x,Int
y))) (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
            -- Y is visible
            | Int
yO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y   ->
              let newL :: V2 Rational
newL = V2 Rational -> Maybe (V2 Rational) -> V2 Rational
forall a. a -> Maybe a -> a
fromMaybe (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
x) (Polygon -> (Int, Int) -> (Int, Int) -> Maybe (V2 Rational)
forall a.
PolyCtx a =>
APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
pRayIntersect Polygon
p (Int
0,Int
xO) (Int
x,Int
y)) in
              (V2 Rational
l, V2 Rational
newL) (V2 Rational, V2 Rational)
-> [(V2 Rational, V2 Rational)] -> [(V2 Rational, V2 Rational)]
forall a. a -> [a] -> [a]
:
              V2 Rational -> [Int] -> [(V2 Rational, V2 Rational)]
go V2 Rational
newL (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
            -- Neither is visible and they've obstructed by the same point
            -- so the entire edge is hidden.
            | Int
xO Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
yO -> V2 Rational -> [Int] -> [(V2 Rational, V2 Rational)]
go V2 Rational
l (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
            -- Neither is visible. Cast shadow from obstruction points to
            -- find if a subsection of the edge is visible.
            | Bool
otherwise ->
              let a :: V2 Rational
a = V2 Rational -> Maybe (V2 Rational) -> V2 Rational
forall a. a -> Maybe a -> a
fromMaybe (String -> V2 Rational
forall a. HasCallStack => String -> a
error String
"a") (Polygon -> (Int, Int) -> (Int, Int) -> Maybe (V2 Rational)
forall a.
PolyCtx a =>
APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
pRayIntersect Polygon
p (Int
0,Int
xO) (Int
x,Int
y))
                  b :: V2 Rational
b = V2 Rational -> Maybe (V2 Rational) -> V2 Rational
forall a. a -> Maybe a -> a
fromMaybe (String -> V2 Rational
forall a. HasCallStack => String -> a
error String
"b") (Polygon -> (Int, Int) -> (Int, Int) -> Maybe (V2 Rational)
forall a.
PolyCtx a =>
APolygon a -> (Int, Int) -> (Int, Int) -> Maybe (V2 a)
pRayIntersect Polygon
p (Int
0,Int
yO) (Int
x,Int
y))
              in if V2 Rational
a V2 Rational -> V2 Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= V2 Rational
b
                then (V2 Rational
l, V2 Rational
a) (V2 Rational, V2 Rational)
-> [(V2 Rational, V2 Rational)] -> [(V2 Rational, V2 Rational)]
forall a. a -> [a] -> [a]
: (V2 Rational
b, Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
yO) (V2 Rational, V2 Rational)
-> [(V2 Rational, V2 Rational)] -> [(V2 Rational, V2 Rational)]
forall a. a -> [a] -> [a]
: V2 Rational -> [Int] -> [(V2 Rational, V2 Rational)]
go (Polygon -> Int -> V2 Rational
forall a. APolygon a -> Int -> V2 a
pAccess Polygon
p Int
yO) (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
                else V2 Rational -> [Int] -> [(V2 Rational, V2 Rational)]
go V2 Rational
l (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)