{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.PlanarSubdivision
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data type to represent a PlanarSubdivision
--
--------------------------------------------------------------------------------
module Data.Geometry.PlanarSubdivision( module Data.Geometry.PlanarSubdivision.Basic
                                      , fromPolygons, fromPolygons'
                                      , fromPolygon
                                      ) where

-- import           Algorithms.Geometry.PolygonTriangulation.Triangulate
import           Data.Ext
import           Data.Semigroup.Foldable
import qualified Data.Vector as V
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Geometry.PlanarSubdivision.Basic
import           Data.Geometry.PlanarSubdivision.Merge
import           Data.Geometry.Polygon
import           Data.Proxy


-- import Data.Geometry.Point
-- import qualified Data.List.NonEmpty as NonEmpty


-- import Debug.Trace

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

-- | Constructs a planar subdivision from a collection of \(k\)
-- disjoint polygons of total complexity \(O(n)\).
--
-- pre: The boundary of the polygons is given in counterclockwise orientation
--
-- runningtime: \(O(n\log n\log k)\) in case of polygons with holes,
-- and \(O(n\log k)\) in case of simple polygons.
fromPolygons       :: (Foldable1 c, Ord r, Fractional r)
                   => proxy s
                   -> f -- ^ outer face data
                   -> c (Polygon t p r :+ f) -- ^ the disjoint polygons
                   -> PlanarSubdivision s p () f r
fromPolygons :: proxy s
-> f -> c (Polygon t p r :+ f) -> PlanarSubdivision s p () f r
fromPolygons proxy s
px f
oD = (f -> f -> f)
-> NonEmpty (PlanarSubdivision s p () f r)
-> PlanarSubdivision s p () f r
forall k (t :: * -> *) f (s :: k) v e r.
Foldable1 t =>
(f -> f -> f)
-> t (PlanarSubdivision s v e f r) -> PlanarSubdivision s v e f r
mergeAllWith f -> f -> f
forall a b. a -> b -> a
const
                   (NonEmpty (PlanarSubdivision s p () f r)
 -> PlanarSubdivision s p () f r)
-> (c (Polygon t p r :+ f)
    -> NonEmpty (PlanarSubdivision s p () f r))
-> c (Polygon t p r :+ f)
-> PlanarSubdivision s p () f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Polygon t p r :+ f) -> PlanarSubdivision s p () f r)
-> NonEmpty (Polygon t p r :+ f)
-> NonEmpty (PlanarSubdivision s p () f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Polygon t p r
pg :+ f
iD) -> proxy s -> Polygon t p r -> f -> f -> PlanarSubdivision s p () f r
forall k (proxy :: k -> *) (t :: PolygonType) p f r (s :: k).
(Ord r, Fractional r) =>
proxy s -> Polygon t p r -> f -> f -> PlanarSubdivision s p () f r
fromPolygon proxy s
px Polygon t p r
pg f
iD f
oD) (NonEmpty (Polygon t p r :+ f)
 -> NonEmpty (PlanarSubdivision s p () f r))
-> (c (Polygon t p r :+ f) -> NonEmpty (Polygon t p r :+ f))
-> c (Polygon t p r :+ f)
-> NonEmpty (PlanarSubdivision s p () f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c (Polygon t p r :+ f) -> NonEmpty (Polygon t p r :+ f)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty

-- | Version of 'fromPolygons' that accepts 'SomePolygon's as input.
fromPolygons'      :: forall proxy c s p r f. (Foldable1 c, Ord r, Fractional r)
                   => proxy s
                   -> f -- ^ outer face data
                   -> c (SomePolygon p r :+ f) -- ^ the disjoint polygons
                   -> PlanarSubdivision s p () f r
fromPolygons' :: proxy s
-> f -> c (SomePolygon p r :+ f) -> PlanarSubdivision s p () f r
fromPolygons' proxy s
px f
oD =
    (f -> f -> f)
-> NonEmpty (PlanarSubdivision s p () f r)
-> PlanarSubdivision s p () f r
forall k (t :: * -> *) f (s :: k) v e r.
Foldable1 t =>
(f -> f -> f)
-> t (PlanarSubdivision s v e f r) -> PlanarSubdivision s v e f r
mergeAllWith f -> f -> f
forall a b. a -> b -> a
const (NonEmpty (PlanarSubdivision s p () f r)
 -> PlanarSubdivision s p () f r)
-> (c (SomePolygon p r :+ f)
    -> NonEmpty (PlanarSubdivision s p () f r))
-> c (SomePolygon p r :+ f)
-> PlanarSubdivision s p () f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SomePolygon p r :+ f) -> PlanarSubdivision s p () f r)
-> NonEmpty (SomePolygon p r :+ f)
-> NonEmpty (PlanarSubdivision s p () f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SomePolygon p r
pg :+ f
iD) -> (Polygon 'Simple p r -> PlanarSubdivision s p () f r)
-> (Polygon 'Multi p r -> PlanarSubdivision s p () f r)
-> SomePolygon p r
-> PlanarSubdivision s p () f r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f -> Polygon 'Simple p r -> PlanarSubdivision s p () f r
forall (t :: PolygonType).
f -> Polygon t p r -> PlanarSubdivision s p () f r
build f
iD) (f -> Polygon 'Multi p r -> PlanarSubdivision s p () f r
forall (t :: PolygonType).
f -> Polygon t p r -> PlanarSubdivision s p () f r
build f
iD) SomePolygon p r
pg) (NonEmpty (SomePolygon p r :+ f)
 -> NonEmpty (PlanarSubdivision s p () f r))
-> (c (SomePolygon p r :+ f) -> NonEmpty (SomePolygon p r :+ f))
-> c (SomePolygon p r :+ f)
-> NonEmpty (PlanarSubdivision s p () f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c (SomePolygon p r :+ f) -> NonEmpty (SomePolygon p r :+ f)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty
  where
    build       :: f -> Polygon t p r -> PlanarSubdivision s p () f r
    build :: f -> Polygon t p r -> PlanarSubdivision s p () f r
build f
iD Polygon t p r
pg = proxy s -> Polygon t p r -> f -> f -> PlanarSubdivision s p () f r
forall k (proxy :: k -> *) (t :: PolygonType) p f r (s :: k).
(Ord r, Fractional r) =>
proxy s -> Polygon t p r -> f -> f -> PlanarSubdivision s p () f r
fromPolygon proxy s
px Polygon t p r
pg f
iD f
oD

-- | Construct a planar subdivision from a polygon. Since our PlanarSubdivision
-- models only connected planar subdivisions, this may add dummy/invisible
-- edges.
--
-- pre: The outer boundary of the polygons is given in counterclockwise orientation
--
-- running time: \(O(n)\) for a simple polygon, \(O(n\log n)\) for a
-- polygon with holes.
fromPolygon                              :: forall proxy t p f r s. (Ord r, Fractional r)
                                         => proxy s
                                         -> Polygon t p r
                                         -> f -- ^ data inside
                                         -> f -- ^ data outside the polygon
                                         -> PlanarSubdivision s p () f r
fromPolygon :: proxy s -> Polygon t p r -> f -> f -> PlanarSubdivision s p () f r
fromPolygon proxy s
p pg :: Polygon t p r
pg@SimplePolygon{} f
iD f
oD   = proxy s
-> SimplePolygon p r -> f -> f -> PlanarSubdivision s p () f r
forall k r (proxy :: k -> *) (s :: k) p f.
(Ord r, Fractional r) =>
proxy s
-> SimplePolygon p r -> f -> f -> PlanarSubdivision s p () f r
fromSimplePolygon proxy s
p Polygon t p r
SimplePolygon p r
pg f
iD f
oD
fromPolygon proxy s
p (MultiPolygon SimplePolygon p r
vs [SimplePolygon p r]
hs) f
iD f
oD = case [SimplePolygon p r] -> Maybe (NonEmpty (SimplePolygon p r))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [SimplePolygon p r]
hs of
    Maybe (NonEmpty (SimplePolygon p r))
Nothing  -> PlanarSubdivision s p () f r
outerPG
    Just NonEmpty (SimplePolygon p r)
hs' -> let hs'' :: NonEmpty (PlanarSubdivision (Wrap s) p () f r)
hs'' = (\SimplePolygon p r
pg -> Proxy (Wrap s)
-> SimplePolygon p r
-> f
-> f
-> PlanarSubdivision (Wrap s) p () f r
forall k r (proxy :: k -> *) (s :: k) p f.
(Ord r, Fractional r) =>
proxy s
-> SimplePolygon p r -> f -> f -> PlanarSubdivision s p () f r
fromSimplePolygon Proxy (Wrap s)
wp (SimplePolygon p r -> SimplePolygon p r
forall r (t :: PolygonType) p.
(Eq r, Num r) =>
Polygon t p r -> Polygon t p r
toCounterClockWiseOrder SimplePolygon p r
pg) f
oD f
iD) (SimplePolygon p r -> PlanarSubdivision (Wrap s) p () f r)
-> NonEmpty (SimplePolygon p r)
-> NonEmpty (PlanarSubdivision (Wrap s) p () f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (SimplePolygon p r)
hs'
                in NonEmpty (PlanarSubdivision (Wrap s) p () f r)
-> (NonEmpty f -> f -> f)
-> FaceId' s
-> PlanarSubdivision s p () f r
-> PlanarSubdivision s p () f r
forall k1 k2 (t :: * -> *) (s :: k1) (h :: k2) v e f r.
(Foldable1 t, Functor t) =>
t (PlanarSubdivision h v e f r)
-> (t f -> f -> f)
-> FaceId' s
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
embedAsHolesIn NonEmpty (PlanarSubdivision (Wrap s) p () f r)
hs'' (\NonEmpty f
_ f
x -> f
x) FaceId' s
i PlanarSubdivision s p () f r
outerPG
  where
    wp :: Proxy (Wrap s)
wp = Proxy (Wrap s)
forall k (t :: k). Proxy t
Proxy :: Proxy (Wrap s)

    outerPG :: PlanarSubdivision s p () f r
outerPG = proxy s
-> SimplePolygon p r -> f -> f -> PlanarSubdivision s p () f r
forall k r (proxy :: k -> *) (s :: k) p f.
(Ord r, Fractional r) =>
proxy s
-> SimplePolygon p r -> f -> f -> PlanarSubdivision s p () f r
fromSimplePolygon proxy s
p SimplePolygon p r
vs f
iD f
oD
    i :: FaceId' s
i = Vector (FaceId' s) -> FaceId' s
forall a. Vector a -> a
V.last (Vector (FaceId' s) -> FaceId' s)
-> Vector (FaceId' s) -> FaceId' s
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s p () f r -> Vector (FaceId' s)
forall k (s :: k) v e f r.
PlanarSubdivision s v e f r -> Vector (FaceId' s)
faces' PlanarSubdivision s p () f r
outerPG






  -- subd&planeGraph.faceData .~ faceData'
  --                            &planeGraph.vertexData.traverse %~ getP
  -- where
  --   faceData' = fmap (\(fi, FaceData hs _) -> FaceData hs (getFData fi)) . faces $ subd

  --   -- given a faceId lookup the
  --   getFData fi = let v = boundaryVertices fi subd V.! 0
  --                 in subd^.dataOf v.to holeData

  --   -- note that we intentionally reverse the order of iDd and oD in the call below,
  --   -- as our holes are now outside
  --   subd = fromPolygon px (MultiPolygon (CSeq.fromList [a,b,c,d]) holes') (Just oD) Nothing

  --   -- for every polygon, construct a hole.
  --   holes' = map withF . F.toList $ pgs
  --   -- add the facedata to the vertex data
  --   withF (pg :+ f) = bimap (\p -> Hole f p) id pg

  --   -- corners of the slightly enlarged boundingbox
  --   (a,b,c,d) = corners . bimap (const $ Outer oD) id
  --             . grow 1 . boundingBoxList . fmap (^.core) $ pgs

    --TODO: We need to mark the edges of the outer square as invisible.

    -- Main Idea: Assign the vertices the hole-number on which they occur. For
    -- each face we then find an incident vertex to find the data corresponding
    -- to that face.

data HoleData f p = Outer !f | Hole !f !p deriving (Int -> HoleData f p -> ShowS
[HoleData f p] -> ShowS
HoleData f p -> String
(Int -> HoleData f p -> ShowS)
-> (HoleData f p -> String)
-> ([HoleData f p] -> ShowS)
-> Show (HoleData f p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall f p. (Show f, Show p) => Int -> HoleData f p -> ShowS
forall f p. (Show f, Show p) => [HoleData f p] -> ShowS
forall f p. (Show f, Show p) => HoleData f p -> String
showList :: [HoleData f p] -> ShowS
$cshowList :: forall f p. (Show f, Show p) => [HoleData f p] -> ShowS
show :: HoleData f p -> String
$cshow :: forall f p. (Show f, Show p) => HoleData f p -> String
showsPrec :: Int -> HoleData f p -> ShowS
$cshowsPrec :: forall f p. (Show f, Show p) => Int -> HoleData f p -> ShowS
Show,HoleData f p -> HoleData f p -> Bool
(HoleData f p -> HoleData f p -> Bool)
-> (HoleData f p -> HoleData f p -> Bool) -> Eq (HoleData f p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall f p. (Eq f, Eq p) => HoleData f p -> HoleData f p -> Bool
/= :: HoleData f p -> HoleData f p -> Bool
$c/= :: forall f p. (Eq f, Eq p) => HoleData f p -> HoleData f p -> Bool
== :: HoleData f p -> HoleData f p -> Bool
$c== :: forall f p. (Eq f, Eq p) => HoleData f p -> HoleData f p -> Bool
Eq)

_holeData            :: HoleData f p -> f
_holeData :: HoleData f p -> f
_holeData (Outer f
f)  = f
f
_holeData (Hole f
f p
_) = f
f

_getP            :: HoleData f p -> Maybe p
_getP :: HoleData f p -> Maybe p
_getP (Outer f
_)  = Maybe p
forall a. Maybe a
Nothing
_getP (Hole f
_ p
p) = p -> Maybe p
forall a. a -> Maybe a
Just p
p

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

-- data Test = Test
-- data Id a = Id a


-- simplePg  = fromSimplePolygon (Id Test) simplePg' Inside Outside
-- simplePg' = toCounterClockWiseOrder . fromPoints $ map ext $ [ Point2 160 736
--                                                              , Point2 128 688
--                                                              , Point2 176 672
--                                                              , Point2 256 672
--                                                              , Point2 272 608
--                                                              , Point2 384 656
--                                                              , Point2 336 768
--                                                              , Point2 272 720
--                                                              ]

-- triangle :: PlanarSubdivision Test () () PolygonFaceData Rational
-- triangle = (\pg -> fromSimplePolygon (Id Test) pg Inside Outside)
--          $ trianglePG

-- trianglePG = fromPoints . map ext $ [origin, Point2 10 0, Point2 10 10]


-- mySubDiv = fromSimplePolygons (Id Test)
--                               0
--                               (NonEmpty.fromList [simplePg' :+ 1, trianglePG :+ 2])