--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Polygon.Simple.Class
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A Simple polygon and some basic functions to interact with them.
--
--------------------------------------------------------------------------------
module HGeometry.Polygon.Simple.Class
  ( SimplePolygon_(..)

  -- , signedArea, area2X
  ) where

import           Control.Lens
import           Data.Default
import qualified Data.Foldable as F
import           Data.Foldable1
import           Data.Kind (Constraint)
import           HGeometry.Ext
import           HGeometry.Point.Class
import           HGeometry.Polygon.Class
import           HGeometry.Vector

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

-- | A class representing simple polygons; i.e. polygons without holes
-- (and without self intersections in the boundary.)
class ( Polygon_ simplePolygon point r
      , VertexIx simplePolygon ~ Int
      , Point_ point 2 r
      ) => SimplePolygon_ simplePolygon point r where

  -- | Given the vertices of the polygon, in CCW order, constructs the
  -- polygon. The vertices are numbered in the order they are given.
  --
  -- pre: - the vertices are given in CCW order
  --      - at least 3 vertices, not all colinear
  --      - no repeated vertices
  --      - no self-inttersections
  uncheckedFromCCWPoints :: Foldable1 f => f point -> simplePolygon

  -- | Constraints that allow us to construct a simple polygon
  type ConstructableSimplePolygon simplePolygon point r :: Constraint
  type ConstructableSimplePolygon simplePolygon point r = (Eq r, Num r)

  -- | Given the vertices of the polygon, constructs the polygon. This
  -- function will make sure the polygon is a valid simple polygon,
  -- i.e. it has at least three vertices, is given in CCW order, no
  -- repeated vertices etc.
  --
  -- In particular, it will drop repeated vertices.
  fromPoints :: ( Foldable f
                , ConstructableSimplePolygon simplePolygon point r
                )
             => f point -> Maybe simplePolygon

  -- | Compute the centroid of a simple polygon.
  --
  -- running time: \(O(n)\)
  centroid      :: (Fractional r, ConstructablePoint_ point' 2 r) => simplePolygon -> point'
  centroid simplePolygon
poly = Vector 2 r -> point'
forall point (d :: Nat) r.
ConstructablePoint_ point d r =>
Vector d r -> point
fromVector (Vector 2 r -> point') -> Vector 2 r -> point'
forall a b. (a -> b) -> a -> b
$ [Vector 2 r] -> Vector 2 r
sum' [Vector 2 r]
xs Vector 2 r -> r -> Vector 2 r
forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ (r
3 r -> r -> r
forall a. Num a => a -> a -> a
* simplePolygon -> r
forall r simplePolygon point.
(Num r, HasOuterBoundary simplePolygon, Point_ point 2 r,
 Vertex simplePolygon ~ point) =>
simplePolygon -> r
signedArea2X simplePolygon
poly)
    where
      xs :: [Vector 2 r]
xs = [ (point
ppoint -> Getting (Vector 2 r) point (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 r) point (Vector 2 r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector 2 r) (Vector 2 r)
vector Vector 2 r -> Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^+^ point
qpoint -> Getting (Vector 2 r) point (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 r) point (Vector 2 r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector 2 r) (Vector 2 r)
vector) Vector 2 r -> r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> r -> vector
^* (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord r -> r -> r
forall a. Num a => a -> a -> a
* point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord r -> r -> r
forall a. Num a => a -> a -> a
- point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord r -> r -> r
forall a. Num a => a -> a -> a
* point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
           | (point
p,point
q) <- simplePolygon
poly simplePolygon
-> Getting (Endo [(point, point)]) simplePolygon (point, point)
-> [(point, point)]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting (Endo [(point, point)]) simplePolygon (point, point)
((Vertex simplePolygon, Vertex simplePolygon)
 -> Const
      (Endo [(point, point)])
      (Vertex simplePolygon, Vertex simplePolygon))
-> simplePolygon -> Const (Endo [(point, point)]) simplePolygon
forall polygon.
HasOuterBoundary polygon =>
IndexedFold1
  (VertexIx polygon, VertexIx polygon)
  polygon
  (Vertex polygon, Vertex polygon)
IndexedFold1
  (VertexIx simplePolygon, VertexIx simplePolygon)
  simplePolygon
  (Vertex simplePolygon, Vertex simplePolygon)
outerBoundaryEdges   ]
      sum' :: [Vector 2 r] -> Vector 2 r
sum' = (Vector 2 r -> Vector 2 r -> Vector 2 r)
-> Vector 2 r -> [Vector 2 r] -> Vector 2 r
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Vector 2 r -> Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
(^+^) Vector 2 r
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero

instance ( SimplePolygon_ simplePolygon point r
         , Default extra
         )
         => SimplePolygon_ (simplePolygon :+ extra) point r where
  uncheckedFromCCWPoints :: forall (f :: * -> *).
Foldable1 f =>
f point -> simplePolygon :+ extra
uncheckedFromCCWPoints = (simplePolygon -> extra -> simplePolygon :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
forall a. Default a => a
def) (simplePolygon -> simplePolygon :+ extra)
-> (f point -> simplePolygon) -> f point -> simplePolygon :+ extra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f point -> simplePolygon
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *). Foldable1 f => f point -> simplePolygon
uncheckedFromCCWPoints
  type ConstructableSimplePolygon (simplePolygon :+ extra) point r =
         (ConstructableSimplePolygon simplePolygon point r, Default extra)
  fromPoints :: forall (f :: * -> *).
(Foldable f,
 ConstructableSimplePolygon (simplePolygon :+ extra) point r) =>
f point -> Maybe (simplePolygon :+ extra)
fromPoints = (simplePolygon -> simplePolygon :+ extra)
-> Maybe simplePolygon -> Maybe (simplePolygon :+ extra)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (simplePolygon -> extra -> simplePolygon :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
forall a. Default a => a
def) (Maybe simplePolygon -> Maybe (simplePolygon :+ extra))
-> (f point -> Maybe simplePolygon)
-> f point
-> Maybe (simplePolygon :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f point -> Maybe simplePolygon
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable f,
 ConstructableSimplePolygon simplePolygon point r) =>
f point -> Maybe simplePolygon
forall (f :: * -> *).
(Foldable f, ConstructableSimplePolygon simplePolygon point r) =>
f point -> Maybe simplePolygon
fromPoints

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


-- -- | Compute the signed area of a simple polygon. When the vertices
-- -- are given in counter clockwise order (as they should be), the area
-- -- will be positive.
-- signedArea      :: (Fractional r, SimplePolygon_ simplePolygon point r)
--                 => simplePolygon -> r
-- signedArea poly = signedArea2X poly / 2