--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.PlanarSubdivision.Merge
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
-- Description :  Functions for merging two planar subdivisions
--
--------------------------------------------------------------------------------
module Data.Geometry.PlanarSubdivision.Merge( merge
                                            , mergeWith
                                            , mergeAllWith

                                            , embedAsHoleIn
                                            , embedAsHolesIn
                                            ) where

import           Algorithms.DivideAndConquer
import           Control.Lens hiding (holes)
import           Data.Ext
import           Data.Geometry.PlanarSubdivision.Basic
import           Data.Geometry.PlanarSubdivision.Raw
import           Data.Geometry.Point
import           Data.Geometry.Polygon
import           Data.PlanarGraph.Dart
import qualified Data.PlaneGraph as PG
import           Data.Semigroup.Foldable
import qualified Data.Vector as V
import           Unsafe.Coerce (unsafeCoerce)

--------------------------------------------------------------------------------
-- * Embedding one subdivision in another one


embedAsHolesIn      :: forall t s h v e f r. (Foldable1 t, Functor t)
                    => t (PlanarSubdivision h v e f r) -- ^ The disjoint "holes"
                    -> (t f -> f -> f) -- ^ How to merge the face data
                    -> FaceId' s -- ^ Face in which to embed the given subdivisions
                    -> PlanarSubdivision s v e f r -- ^ the outer subdivision
                    -> PlanarSubdivision s v e f r
embedAsHolesIn :: 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 t (PlanarSubdivision h v e f r)
hs t f -> f -> f
f = PlanarSubdivision h v e f r
-> (f -> f -> f)
-> FaceId' s
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall k k (s :: k) (h :: k) v e f r.
PlanarSubdivision h v e f r
-> (f -> f -> f)
-> FaceId' s
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
embedAsHoleIn PlanarSubdivision h v e f r
ph' f -> f -> f
g
  where
    -- merges all holes into one subdivision
    ph' :: PlanarSubdivision h v e f r
ph' = (f -> f -> f)
-> t (PlanarSubdivision h v e f r) -> PlanarSubdivision h v e 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 t (PlanarSubdivision h v e f r)
hs
    -- the new data value to use for the face i
    g :: f -> f -> f
g f
_ = t f -> f -> f
f ((PlanarSubdivision h v e f r -> f)
-> t (PlanarSubdivision h v e f r) -> t f
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PlanarSubdivision h v e f r
h -> PlanarSubdivision h v e f r
hPlanarSubdivision h v e f r
-> Getting f (PlanarSubdivision h v e f r) f -> f
forall s a. s -> Getting a s a -> a
^.FaceId' h
-> Lens'
     (PlanarSubdivision h v e f r)
     (DataOf (PlanarSubdivision h v e f r) (FaceId' h))
forall g i. HasDataOf g i => i -> Lens' g (DataOf g i)
dataOf (PlanarSubdivision h v e f r -> FaceId' h
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> FaceId' s
outerFaceId PlanarSubdivision h v e f r
h)) t (PlanarSubdivision h v e f r)
hs)

embedAsHoleIn           :: forall s h v e f r.
                           PlanarSubdivision h v e f r -- ^ The hole
                        -> (f -> f -> f) -- ^ How to merge the face data (hole value first)
                        -> FaceId' s -- ^ Face in which to embed the given subdivisions
                        -> PlanarSubdivision s v e f r -- ^ the outer subdivision
                        -> PlanarSubdivision s v e f r
embedAsHoleIn :: PlanarSubdivision h v e f r
-> (f -> f -> f)
-> FaceId' s
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
embedAsHoleIn PlanarSubdivision h v e f r
ph' f -> f -> f
f FaceId' s
i PlanarSubdivision s v e f r
ps = (Vector (RawFace s f)
 -> Vector (RawFace s f) -> Vector (RawFace s f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall k (s :: k) f v e r.
(Vector (RawFace s f)
 -> Vector (RawFace s f) -> Vector (RawFace s f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
mergeWith' Vector (RawFace s f)
-> Vector (RawFace s f) -> Vector (RawFace s f)
mergeFaces PlanarSubdivision s v e f r
ps PlanarSubdivision s v e f r
ph
  where
    -- coerce the worlds to be the same
    ph :: PlanarSubdivision s v e f r
    ph :: PlanarSubdivision s v e f r
ph = PlanarSubdivision h v e f r -> PlanarSubdivision s v e f r
forall a b. a -> b
unsafeCoerce PlanarSubdivision h v e f r
ph'
      -- We are coercing the 'h' into an 's' here. Since these
      -- parameters are phantom types the representation of the data
      -- is the same, and hence the unsafeCoerce should be safe here.

    mergeFaces :: Vector (RawFace s f)
-> Vector (RawFace s f) -> Vector (RawFace s f)
mergeFaces Vector (RawFace s f)
fs1 Vector (RawFace s f)
fs2 = Vector (RawFace s f)
-> FaceId' s -> RawFace s f -> Vector (RawFace s f)
update Vector (RawFace s f)
fs1 FaceId' s
i (Vector (RawFace s f) -> RawFace s f
forall a. Vector a -> a
V.head Vector (RawFace s f)
fs2) Vector (RawFace s f)
-> Vector (RawFace s f) -> Vector (RawFace s f)
forall a. Semigroup a => a -> a -> a
<> Vector (RawFace s f) -> Vector (RawFace s f)
forall a. Vector a -> Vector a
V.tail Vector (RawFace s f)
fs2

    update :: Vector (RawFace s f)
-> FaceId' s -> RawFace s f -> Vector (RawFace s f)
update Vector (RawFace s f)
fs (FaceId (VertexId Int
j)) RawFace s f
h2 = let FaceData Seq (Dart s)
hs' f
x' = RawFace s f
h2RawFace s f
-> Getting
     (FaceData (Dart s) f) (RawFace s f) (FaceData (Dart s) f)
-> FaceData (Dart s) f
forall s a. s -> Getting a s a -> a
^.Getting (FaceData (Dart s) f) (RawFace s f) (FaceData (Dart s) f)
forall k (s :: k) f f2.
Lens
  (RawFace s f)
  (RawFace s f2)
  (FaceData (Dart s) f)
  (FaceData (Dart s) f2)
faceDataVal
                                             g :: FaceData (Dart s) f -> FaceData (Dart s) f
g (FaceData Seq (Dart s)
hs f
x) = Seq (Dart s) -> f -> FaceData (Dart s) f
forall h f. Seq h -> f -> FaceData h f
FaceData (Seq (Dart s)
hs' Seq (Dart s) -> Seq (Dart s) -> Seq (Dart s)
forall a. Semigroup a => a -> a -> a
<> Seq (Dart s)
hs) (f -> f -> f
f f
x' f
x)
                                         in Vector (RawFace s f)
fsVector (RawFace s f)
-> (Vector (RawFace s f) -> Vector (RawFace s f))
-> Vector (RawFace s f)
forall a b. a -> (a -> b) -> b
&Index (Vector (RawFace s f))
-> Traversal'
     (Vector (RawFace s f)) (IxValue (Vector (RawFace s f)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Vector (RawFace s f))
j((RawFace s f -> Identity (RawFace s f))
 -> Vector (RawFace s f) -> Identity (Vector (RawFace s f)))
-> ((FaceData (Dart s) f -> Identity (FaceData (Dart s) f))
    -> RawFace s f -> Identity (RawFace s f))
-> (FaceData (Dart s) f -> Identity (FaceData (Dart s) f))
-> Vector (RawFace s f)
-> Identity (Vector (RawFace s f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FaceData (Dart s) f -> Identity (FaceData (Dart s) f))
-> RawFace s f -> Identity (RawFace s f)
forall k (s :: k) f f2.
Lens
  (RawFace s f)
  (RawFace s f2)
  (FaceData (Dart s) f)
  (FaceData (Dart s) f2)
faceDataVal ((FaceData (Dart s) f -> Identity (FaceData (Dart s) f))
 -> Vector (RawFace s f) -> Identity (Vector (RawFace s f)))
-> (FaceData (Dart s) f -> FaceData (Dart s) f)
-> Vector (RawFace s f)
-> Vector (RawFace s f)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FaceData (Dart s) f -> FaceData (Dart s) f
g

  -- (PlanarSubdivision cs vd rd rf)&faceDataOf i %~ updateFData
  -- where
  --   -- shift p2
  --   p2' :: PlanarSubdivision s v e f r
  --   p2' = unsafeCoerce p2''

  --   p2'' :: PlanarSubdivision h v e f r
  --   p2'' = shift (numComponents ps) (numVertices ps) (numDarts ps `div` 2) (numFaces ps) ph
  --       -- we have to shift the number of the *Arcs*. Since every dart consists
  --       -- of two arcs, we have to shift by numDarts / 2

  --   -- merges all holes into one subdivision
  --   ph = mergeAllWith const hs

  --   cs = ps^.components <> p2'^.components
  --   vd = ps^.rawVertexData <> p2'^.rawVertexData
  --   rd = ps^.rawDartData <> p2'^.rawDartData
  --   rf = ps^.rawFaceData <> (V.tail $ p2'^.rawFaceData)

  --   -- the new data value to use for the face i
  --   x = f ofData (ps^.dataOf i)
  --   ofData = fmap (\h -> h^.dataOf (outerFaceId h)) hs

  --   updateFData (FaceData hs' _) = FaceData (newHs <> hs') x
  --   newHs = p2'^?!rawFaceData.ix 0.faceDataVal.holes





--------------------------------------------------------------------------------
-- * Merging Disjoint Subdivisions

-- | Merge a pair of *disjoint* planar subdivisions, unifying their
-- outer face. The given function is used to merge the data
-- corresponding to the outer face. The subdivisions are merged pairwise, no
-- guarantees are given about the order in which they are merged. Hence,
-- it is expected that f is commutative.
--
-- running time: \(O(n\log n)\), where \(n\) is the total size of the
-- subdivisions.
mergeAllWith   :: Foldable1 t
               => (f -> f -> f)
               -> t (PlanarSubdivision s v e f r)
               -> PlanarSubdivision s v e f r
mergeAllWith :: (f -> f -> f)
-> t (PlanarSubdivision s v e f r) -> PlanarSubdivision s v e f r
mergeAllWith f -> f -> f
f = (PlanarSubdivision s v e f r
 -> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> NonEmpty (PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall (f :: * -> *) s a.
Foldable1 f =>
(s -> s -> s) -> (a -> s) -> f a -> s
divideAndConquer1With ((f -> f -> f)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall k f (s :: k) v e r.
(f -> f -> f)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
mergeWith f -> f -> f
f) PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
forall a. a -> a
id (NonEmpty (PlanarSubdivision s v e f r)
 -> PlanarSubdivision s v e f r)
-> (t (PlanarSubdivision s v e f r)
    -> NonEmpty (PlanarSubdivision s v e f r))
-> t (PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (PlanarSubdivision s v e f r)
-> NonEmpty (PlanarSubdivision s v e f r)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty

-- | Merge a pair of *disjoint* planar subdivisions, unifying their
-- outer face. For the outerface data it simply takes the data of the
-- first subdivision.
--
-- runningtime: \(O(n)\)
merge :: PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
merge :: PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
merge = (f -> f -> f)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall k f (s :: k) v e r.
(f -> f -> f)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
mergeWith f -> f -> f
forall a b. a -> b -> a
const

-- | Merge a pair of *disjoint* planar subdivisions. In particular,
-- this function unifies the structure assuming that the two
-- subdivisions share the outer face.
--
-- runningtime: \(O(n)\)
mergeWith   :: (f -> f -> f) -- ^  how to merge the data of the outer face
            -> PlanarSubdivision s v e f r
            -> PlanarSubdivision s v e f r
            -> PlanarSubdivision s v e f r
mergeWith :: (f -> f -> f)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
mergeWith f -> f -> f
f = (Vector (RawFace s f)
 -> Vector (RawFace s f) -> Vector (RawFace s f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall k (s :: k) f v e r.
(Vector (RawFace s f)
 -> Vector (RawFace s f) -> Vector (RawFace s f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
mergeWith' ((f -> f -> f)
-> Vector (RawFace s f)
-> Vector (RawFace s f)
-> Vector (RawFace s f)
forall k f (s :: k).
(f -> f -> f)
-> Vector (RawFace s f)
-> Vector (RawFace s f)
-> Vector (RawFace s f)
mergeFaceData f -> f -> f
f)

-- | Takes care of actually combining the vectors with data.
-- only thing left is how to merge the raw face data
mergeWith'  :: (V.Vector (RawFace s f) -> V.Vector (RawFace s f) -> V.Vector (RawFace s f))
             -- ^  how to merge the raw face data
            -> PlanarSubdivision s v e f r
            -> PlanarSubdivision s v e f r
            -> PlanarSubdivision s v e f r
mergeWith' :: (Vector (RawFace s f)
 -> Vector (RawFace s f) -> Vector (RawFace s f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
mergeWith' Vector (RawFace s f)
-> Vector (RawFace s f) -> Vector (RawFace s f)
mergeFaces PlanarSubdivision s v e f r
p1 PlanarSubdivision s v e f r
p2 = Vector (Component s r)
-> Vector (Raw s (VertexId' (Wrap s)) v)
-> Vector (Raw s (Dart (Wrap s)) e)
-> Vector (RawFace s f)
-> PlanarSubdivision s v e f r
forall k (s :: k) v e f r1.
Vector (Component s r1)
-> Vector (Raw s (VertexId' (Wrap s)) v)
-> Vector (Raw s (Dart (Wrap s)) e)
-> Vector (RawFace s f)
-> PlanarSubdivision s v e f r1
PlanarSubdivision Vector (Component s r)
cs Vector (Raw s (VertexId' (Wrap s)) v)
vd Vector (Raw s (Dart (Wrap s)) e)
rd Vector (RawFace s f)
rf
  where
    -- shift p2
    p2' :: PlanarSubdivision s v e f r
p2' = Int
-> Int
-> Int
-> Int
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall k (s :: k) v e f r.
Int
-> Int
-> Int
-> Int
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
shift (PlanarSubdivision s v e f r -> Int
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Int
numComponents PlanarSubdivision s v e f r
p1) (PlanarSubdivision s v e f r -> Int
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Int
numVertices PlanarSubdivision s v e f r
p1) (PlanarSubdivision s v e f r -> Int
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Int
numDarts PlanarSubdivision s v e f r
p1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (PlanarSubdivision s v e f r -> Int
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Int
numFaces PlanarSubdivision s v e f r
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) PlanarSubdivision s v e f r
p2
        -- we have to shift the number of the *Arcs*. Since every dart
        -- consists of two arcs, we have to shift by numDarts / 2
        -- Furthermore, we take numFaces - 1 since we want the first
        -- /internal/ face of p2 (the one with FaceId 1) to correspond with the first free
        -- position (at index numFaces)

    cs :: Vector (Component s r)
cs = PlanarSubdivision s v e f r
p1PlanarSubdivision s v e f r
-> Getting
     (Vector (Component s r))
     (PlanarSubdivision s v e f r)
     (Vector (Component s r))
-> Vector (Component s r)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Component s r))
  (PlanarSubdivision s v e f r)
  (Vector (Component s r))
forall k (s :: k) v e f r1 r2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e f r2)
  (Vector (Component s r1))
  (Vector (Component s r2))
components Vector (Component s r)
-> Vector (Component s r) -> Vector (Component s r)
forall a. Semigroup a => a -> a -> a
<> PlanarSubdivision s v e f r
p2'PlanarSubdivision s v e f r
-> Getting
     (Vector (Component s r))
     (PlanarSubdivision s v e f r)
     (Vector (Component s r))
-> Vector (Component s r)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Component s r))
  (PlanarSubdivision s v e f r)
  (Vector (Component s r))
forall k (s :: k) v e f r1 r2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e f r2)
  (Vector (Component s r1))
  (Vector (Component s r2))
components
    vd :: Vector (Raw s (VertexId' (Wrap s)) v)
vd = PlanarSubdivision s v e f r
p1PlanarSubdivision s v e f r
-> Getting
     (Vector (Raw s (VertexId' (Wrap s)) v))
     (PlanarSubdivision s v e f r)
     (Vector (Raw s (VertexId' (Wrap s)) v))
-> Vector (Raw s (VertexId' (Wrap s)) v)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Raw s (VertexId' (Wrap s)) v))
  (PlanarSubdivision s v e f r)
  (Vector (Raw s (VertexId' (Wrap s)) v))
forall k (s :: k) v e f r1 v2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v2 e f r1)
  (Vector (Raw s (VertexId' (Wrap s)) v))
  (Vector (Raw s (VertexId' (Wrap s)) v2))
rawVertexData Vector (Raw s (VertexId' (Wrap s)) v)
-> Vector (Raw s (VertexId' (Wrap s)) v)
-> Vector (Raw s (VertexId' (Wrap s)) v)
forall a. Semigroup a => a -> a -> a
<> PlanarSubdivision s v e f r
p2'PlanarSubdivision s v e f r
-> Getting
     (Vector (Raw s (VertexId' (Wrap s)) v))
     (PlanarSubdivision s v e f r)
     (Vector (Raw s (VertexId' (Wrap s)) v))
-> Vector (Raw s (VertexId' (Wrap s)) v)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Raw s (VertexId' (Wrap s)) v))
  (PlanarSubdivision s v e f r)
  (Vector (Raw s (VertexId' (Wrap s)) v))
forall k (s :: k) v e f r1 v2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v2 e f r1)
  (Vector (Raw s (VertexId' (Wrap s)) v))
  (Vector (Raw s (VertexId' (Wrap s)) v2))
rawVertexData
    rd :: Vector (Raw s (Dart (Wrap s)) e)
rd = PlanarSubdivision s v e f r
p1PlanarSubdivision s v e f r
-> Getting
     (Vector (Raw s (Dart (Wrap s)) e))
     (PlanarSubdivision s v e f r)
     (Vector (Raw s (Dart (Wrap s)) e))
-> Vector (Raw s (Dart (Wrap s)) e)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Raw s (Dart (Wrap s)) e))
  (PlanarSubdivision s v e f r)
  (Vector (Raw s (Dart (Wrap s)) e))
forall k (s :: k) v e f r1 e2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e2 f r1)
  (Vector (Raw s (Dart (Wrap s)) e))
  (Vector (Raw s (Dart (Wrap s)) e2))
rawDartData Vector (Raw s (Dart (Wrap s)) e)
-> Vector (Raw s (Dart (Wrap s)) e)
-> Vector (Raw s (Dart (Wrap s)) e)
forall a. Semigroup a => a -> a -> a
<> PlanarSubdivision s v e f r
p2'PlanarSubdivision s v e f r
-> Getting
     (Vector (Raw s (Dart (Wrap s)) e))
     (PlanarSubdivision s v e f r)
     (Vector (Raw s (Dart (Wrap s)) e))
-> Vector (Raw s (Dart (Wrap s)) e)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Raw s (Dart (Wrap s)) e))
  (PlanarSubdivision s v e f r)
  (Vector (Raw s (Dart (Wrap s)) e))
forall k (s :: k) v e f r1 e2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e2 f r1)
  (Vector (Raw s (Dart (Wrap s)) e))
  (Vector (Raw s (Dart (Wrap s)) e2))
rawDartData
    rf :: Vector (RawFace s f)
rf = (PlanarSubdivision s v e f r
p1PlanarSubdivision s v e f r
-> Getting
     (Vector (RawFace s f))
     (PlanarSubdivision s v e f r)
     (Vector (RawFace s f))
-> Vector (RawFace s f)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (RawFace s f))
  (PlanarSubdivision s v e f r)
  (Vector (RawFace s f))
forall k (s :: k) v e f r1 f2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e f2 r1)
  (Vector (RawFace s f))
  (Vector (RawFace s f2))
rawFaceData) Vector (RawFace s f)
-> Vector (RawFace s f) -> Vector (RawFace s f)
`mergeFaces` (PlanarSubdivision s v e f r
p2'PlanarSubdivision s v e f r
-> Getting
     (Vector (RawFace s f))
     (PlanarSubdivision s v e f r)
     (Vector (RawFace s f))
-> Vector (RawFace s f)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (RawFace s f))
  (PlanarSubdivision s v e f r)
  (Vector (RawFace s f))
forall k (s :: k) v e f r1 f2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e f2 r1)
  (Vector (RawFace s f))
  (Vector (RawFace s f2))
rawFaceData)

mergeFaceData           :: (f -> f -> f)
                        -> V.Vector (RawFace s f)
                        -> V.Vector (RawFace s f)
                        -> V.Vector (RawFace s f)
mergeFaceData :: (f -> f -> f)
-> Vector (RawFace s f)
-> Vector (RawFace s f)
-> Vector (RawFace s f)
mergeFaceData f -> f -> f
f Vector (RawFace s f)
vs1 Vector (RawFace s f)
vs2 = RawFace s f -> Vector (RawFace s f) -> Vector (RawFace s f)
forall a. a -> Vector a -> Vector a
V.cons RawFace s f
h Vector (RawFace s f)
ts
  where
    ts :: Vector (RawFace s f)
ts = Vector (RawFace s f) -> Vector (RawFace s f)
forall a. Vector a -> Vector a
V.tail Vector (RawFace s f)
vs1 Vector (RawFace s f)
-> Vector (RawFace s f) -> Vector (RawFace s f)
forall a. Semigroup a => a -> a -> a
<> Vector (RawFace s f) -> Vector (RawFace s f)
forall a. Vector a -> Vector a
V.tail Vector (RawFace s f)
vs2
    h :: RawFace s f
h  = let FaceData Seq (Dart s)
hs1 f
x1 = Vector (RawFace s f)
vs1Vector (RawFace s f)
-> Getting
     (FaceData (Dart s) f) (Vector (RawFace s f)) (FaceData (Dart s) f)
-> FaceData (Dart s) f
forall s a. s -> Getting a s a -> a
^.(Vector (RawFace s f) -> RawFace s f)
-> Optic'
     (->)
     (Const (FaceData (Dart s) f))
     (Vector (RawFace s f))
     (RawFace s f)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Vector (RawFace s f) -> RawFace s f
forall a. Vector a -> a
V.headOptic'
  (->)
  (Const (FaceData (Dart s) f))
  (Vector (RawFace s f))
  (RawFace s f)
-> ((FaceData (Dart s) f
     -> Const (FaceData (Dart s) f) (FaceData (Dart s) f))
    -> RawFace s f -> Const (FaceData (Dart s) f) (RawFace s f))
-> Getting
     (FaceData (Dart s) f) (Vector (RawFace s f)) (FaceData (Dart s) f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FaceData (Dart s) f
 -> Const (FaceData (Dart s) f) (FaceData (Dart s) f))
-> RawFace s f -> Const (FaceData (Dart s) f) (RawFace s f)
forall k (s :: k) f f2.
Lens
  (RawFace s f)
  (RawFace s f2)
  (FaceData (Dart s) f)
  (FaceData (Dart s) f2)
faceDataVal
             FaceData Seq (Dart s)
hs2 f
x2 = Vector (RawFace s f)
vs2Vector (RawFace s f)
-> Getting
     (FaceData (Dart s) f) (Vector (RawFace s f)) (FaceData (Dart s) f)
-> FaceData (Dart s) f
forall s a. s -> Getting a s a -> a
^.(Vector (RawFace s f) -> RawFace s f)
-> Optic'
     (->)
     (Const (FaceData (Dart s) f))
     (Vector (RawFace s f))
     (RawFace s f)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Vector (RawFace s f) -> RawFace s f
forall a. Vector a -> a
V.headOptic'
  (->)
  (Const (FaceData (Dart s) f))
  (Vector (RawFace s f))
  (RawFace s f)
-> ((FaceData (Dart s) f
     -> Const (FaceData (Dart s) f) (FaceData (Dart s) f))
    -> RawFace s f -> Const (FaceData (Dart s) f) (RawFace s f))
-> Getting
     (FaceData (Dart s) f) (Vector (RawFace s f)) (FaceData (Dart s) f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FaceData (Dart s) f
 -> Const (FaceData (Dart s) f) (FaceData (Dart s) f))
-> RawFace s f -> Const (FaceData (Dart s) f) (RawFace s f)
forall k (s :: k) f f2.
Lens
  (RawFace s f)
  (RawFace s f2)
  (FaceData (Dart s) f)
  (FaceData (Dart s) f2)
faceDataVal
         in Maybe (ComponentId s, FaceId' (Wrap s))
-> FaceData (Dart s) f -> RawFace s f
forall k (s :: k) f.
Maybe (ComponentId s, FaceId' (Wrap s))
-> FaceData (Dart s) f -> RawFace s f
RawFace Maybe (ComponentId s, FaceId' (Wrap s))
forall a. Maybe a
Nothing (FaceData (Dart s) f -> RawFace s f)
-> FaceData (Dart s) f -> RawFace s f
forall a b. (a -> b) -> a -> b
$ Seq (Dart s) -> f -> FaceData (Dart s) f
forall h f. Seq h -> f -> FaceData h f
FaceData (Seq (Dart s)
hs1 Seq (Dart s) -> Seq (Dart s) -> Seq (Dart s)
forall a. Semigroup a => a -> a -> a
<> Seq (Dart s)
hs2) (f -> f -> f
f f
x1 f
x2)

-- -- | applies a function to the first value of a vector
-- onHead     :: (a -> a) -> V.Vector a -> V.Vector a
-- onHead f v = v&ix 0 %~ f

--------------------------------------------------------------------------------
-- * Implementation Helpers

-- | Shift the indices in a planar subdiv by the given numbers
-- (componentId;vertexId,darts,faceIds). Note that the result is not really a
-- valid planar subdivision, so be careful when using this!
shift                                             :: forall s v e f r.
                                                     Int -> Int -> Int -> Int
                                                  -> PlanarSubdivision s v e f r
                                                  -> PlanarSubdivision s v e f r
shift :: Int
-> Int
-> Int
-> Int
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
shift Int
nc Int
nv Int
nd Int
nf (PlanarSubdivision Vector (Component s r)
cs Vector (Raw s (VertexId' (Wrap s)) v)
vd Vector (Raw s (Dart (Wrap s)) e)
rd Vector (RawFace s f)
rf) = Vector (Component s r)
-> Vector (Raw s (VertexId' (Wrap s)) v)
-> Vector (Raw s (Dart (Wrap s)) e)
-> Vector (RawFace s f)
-> PlanarSubdivision s v e f r
forall k (s :: k) v e f r1.
Vector (Component s r1)
-> Vector (Raw s (VertexId' (Wrap s)) v)
-> Vector (Raw s (Dart (Wrap s)) e)
-> Vector (RawFace s f)
-> PlanarSubdivision s v e f r1
PlanarSubdivision Vector (Component s r)
cs' Vector (Raw s (VertexId' (Wrap s)) v)
vd' Vector (Raw s (Dart (Wrap s)) e)
rd' Vector (RawFace s f)
rf'
  where
    cs' :: Vector (Component s r)
cs' = (\Component s r
pg -> Component s r
pgComponent s r -> (Component s r -> Component s r) -> Component s r
forall a b. a -> (a -> b) -> b
&(Vector (VertexId s 'Primal)
 -> Identity (Vector (VertexId s 'Primal)))
-> Component s r -> Identity (Component s r)
forall k (s :: k) v e f r v'.
Lens
  (PlaneGraph s v e f r)
  (PlaneGraph s v' e f r)
  (Vector v)
  (Vector v')
PG.vertexData((Vector (VertexId s 'Primal)
  -> Identity (Vector (VertexId s 'Primal)))
 -> Component s r -> Identity (Component s r))
-> ((VertexId s 'Primal -> Identity (VertexId s 'Primal))
    -> Vector (VertexId s 'Primal)
    -> Identity (Vector (VertexId s 'Primal)))
-> (VertexId s 'Primal -> Identity (VertexId s 'Primal))
-> Component s r
-> Identity (Component s r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(VertexId s 'Primal -> Identity (VertexId s 'Primal))
-> Vector (VertexId s 'Primal)
-> Identity (Vector (VertexId s 'Primal))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse  ((VertexId s 'Primal -> Identity (VertexId s 'Primal))
 -> Component s r -> Identity (Component s r))
-> (VertexId s 'Primal -> VertexId s 'Primal)
-> Component s r
-> Component s r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ VertexId s 'Primal -> VertexId s 'Primal
incV
                    Component s r -> (Component s r -> Component s r) -> Component s r
forall a b. a -> (a -> b) -> b
&(Vector (Dart s) -> Identity (Vector (Dart s)))
-> Component s r -> Identity (Component s r)
forall k (s :: k) v e f r e'.
Lens
  (PlaneGraph s v e f r)
  (PlaneGraph s v e' f r)
  (Vector e)
  (Vector e')
PG.rawDartData((Vector (Dart s) -> Identity (Vector (Dart s)))
 -> Component s r -> Identity (Component s r))
-> ((Dart s -> Identity (Dart s))
    -> Vector (Dart s) -> Identity (Vector (Dart s)))
-> (Dart s -> Identity (Dart s))
-> Component s r
-> Identity (Component s r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Dart s -> Identity (Dart s))
-> Vector (Dart s) -> Identity (Vector (Dart s))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Dart s -> Identity (Dart s))
 -> Component s r -> Identity (Component s r))
-> (Dart s -> Dart s) -> Component s r -> Component s r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Dart s -> Dart s
incD
                    Component s r -> (Component s r -> Component s r) -> Component s r
forall a b. a -> (a -> b) -> b
&(Vector (FaceId s 'Primal) -> Identity (Vector (FaceId s 'Primal)))
-> Component s r -> Identity (Component s r)
forall k (s :: k) v e f r f'.
Lens
  (PlaneGraph s v e f r)
  (PlaneGraph s v e f' r)
  (Vector f)
  (Vector f')
PG.faceData((Vector (FaceId s 'Primal)
  -> Identity (Vector (FaceId s 'Primal)))
 -> Component s r -> Identity (Component s r))
-> ((FaceId s 'Primal -> Identity (FaceId s 'Primal))
    -> Vector (FaceId s 'Primal)
    -> Identity (Vector (FaceId s 'Primal)))
-> (FaceId s 'Primal -> Identity (FaceId s 'Primal))
-> Component s r
-> Identity (Component s r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FaceId s 'Primal -> Identity (FaceId s 'Primal))
-> Vector (FaceId s 'Primal)
-> Identity (Vector (FaceId s 'Primal))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse    ((FaceId s 'Primal -> Identity (FaceId s 'Primal))
 -> Component s r -> Identity (Component s r))
-> (FaceId s 'Primal -> FaceId s 'Primal)
-> Component s r
-> Component s r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FaceId s 'Primal -> FaceId s 'Primal
incFi
          ) (Component s r -> Component s r)
-> Vector (Component s r) -> Vector (Component s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Component s r)
cs
    vd' :: Vector (Raw s (VertexId' (Wrap s)) v)
vd' = (\(Raw ComponentId s
ci VertexId' (Wrap s)
i v
x)      -> ComponentId s
-> VertexId' (Wrap s) -> v -> Raw s (VertexId' (Wrap s)) v
forall k (s :: k) ia a. ComponentId s -> ia -> a -> Raw s ia a
Raw (ComponentId s -> ComponentId s
incC ComponentId s
ci) VertexId' (Wrap s)
i v
x)                    (Raw s (VertexId' (Wrap s)) v -> Raw s (VertexId' (Wrap s)) v)
-> Vector (Raw s (VertexId' (Wrap s)) v)
-> Vector (Raw s (VertexId' (Wrap s)) v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Raw s (VertexId' (Wrap s)) v)
vd
    rd' :: Vector (Raw s (Dart (Wrap s)) e)
rd' = (\(Raw ComponentId s
ci Dart (Wrap s)
i e
x)      -> ComponentId s -> Dart (Wrap s) -> e -> Raw s (Dart (Wrap s)) e
forall k (s :: k) ia a. ComponentId s -> ia -> a -> Raw s ia a
Raw (ComponentId s -> ComponentId s
incC ComponentId s
ci) Dart (Wrap s)
i e
x)                    (Raw s (Dart (Wrap s)) e -> Raw s (Dart (Wrap s)) e)
-> Vector (Raw s (Dart (Wrap s)) e)
-> Vector (Raw s (Dart (Wrap s)) e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Raw s (Dart (Wrap s)) e)
rd
    rf' :: Vector (RawFace s f)
rf' = (\(RawFace Maybe (ComponentId s, FaceId' (Wrap s))
fidx FaceData (Dart s) f
fd) -> Maybe (ComponentId s, FaceId' (Wrap s))
-> FaceData (Dart s) f -> RawFace s f
forall k (s :: k) f.
Maybe (ComponentId s, FaceId' (Wrap s))
-> FaceData (Dart s) f -> RawFace s f
RawFace ((ComponentId s, FaceId' (Wrap s))
-> (ComponentId s, FaceId' (Wrap s))
incFIdx ((ComponentId s, FaceId' (Wrap s))
 -> (ComponentId s, FaceId' (Wrap s)))
-> Maybe (ComponentId s, FaceId' (Wrap s))
-> Maybe (ComponentId s, FaceId' (Wrap s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ComponentId s, FaceId' (Wrap s))
fidx) (FaceData (Dart s) f -> FaceData (Dart s) f
incF FaceData (Dart s) f
fd)) (RawFace s f -> RawFace s f)
-> Vector (RawFace s f) -> Vector (RawFace s f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (RawFace s f)
rf

    incC                 :: ComponentId s -> ComponentId s
    incC :: ComponentId s -> ComponentId s
incC (ComponentId Int
i) = Int -> ComponentId s
forall k (s :: k). Int -> ComponentId s
ComponentId (Int -> ComponentId s) -> Int -> ComponentId s
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nc

    incV              :: VertexId' s -> VertexId' s
    incV :: VertexId s 'Primal -> VertexId s 'Primal
incV (VertexId Int
i) = Int -> VertexId s 'Primal
forall k (s :: k) (w :: World). Int -> VertexId s w
VertexId (Int -> VertexId s 'Primal) -> Int -> VertexId s 'Primal
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nv

    incD                  :: Dart s -> Dart s
    incD :: Dart s -> Dart s
incD (Dart (Arc Int
a) Direction
p) = Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart (Int -> Arc s
forall k (s :: k). Int -> Arc s
Arc (Int -> Arc s) -> Int -> Arc s
forall a b. (a -> b) -> a -> b
$ Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nd) Direction
p

    incFIdx :: (ComponentId s, FaceId' (Wrap s))
-> (ComponentId s, FaceId' (Wrap s))
incFIdx (ComponentId s
ci,FaceId' (Wrap s)
fi) = (ComponentId s -> ComponentId s
incC ComponentId s
ci, FaceId' (Wrap s)
fi)
      -- observe that the fi here is the fi with respect to its original graph. Hence,
      -- we do not want to increase those id's

    incF                 :: FaceData (Dart s) f -> FaceData (Dart s) f
    incF :: FaceData (Dart s) f -> FaceData (Dart s) f
incF (FaceData Seq (Dart s)
hs f
f) = Seq (Dart s) -> f -> FaceData (Dart s) f
forall h f. Seq h -> f -> FaceData h f
FaceData (Dart s -> Dart s
incD (Dart s -> Dart s) -> Seq (Dart s) -> Seq (Dart s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Dart s)
hs) f
f

    incFi                       :: FaceId' s -> FaceId' s
    incFi :: FaceId s 'Primal -> FaceId s 'Primal
incFi (FaceId (VertexId Int
i)) = VertexId s 'Dual -> FaceId s 'Primal
forall k (s :: k) (w :: World). VertexId s (DualOf w) -> FaceId s w
FaceId (VertexId s 'Dual -> FaceId s 'Primal)
-> (Int -> VertexId s 'Dual) -> Int -> FaceId s 'Primal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VertexId s 'Dual
forall k (s :: k) (w :: World). Int -> VertexId s w
VertexId (Int -> FaceId s 'Primal) -> Int -> FaceId s 'Primal
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nf


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

data Test = Test
newtype Id a = Id a


triangle1 :: PlanarSubdivision Test () () Int Rational
triangle1 :: PlanarSubdivision Test () () Int Rational
triangle1 = (\SimplePolygon () Rational
pg -> Id Test
-> SimplePolygon () Rational
-> Int
-> Int
-> PlanarSubdivision Test () () Int Rational
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 (Test -> Id Test
forall a. a -> Id a
Id Test
Test) SimplePolygon () Rational
pg Int
1 Int
0)
          SimplePolygon () Rational
trianglePG1
trianglePG1 :: SimplePolygon () Rational
trianglePG1 :: SimplePolygon () Rational
trianglePG1 = [Point 2 Rational :+ ()] -> SimplePolygon () Rational
forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
fromPoints ([Point 2 Rational :+ ()] -> SimplePolygon () Rational)
-> ([Point 2 Rational] -> [Point 2 Rational :+ ()])
-> [Point 2 Rational]
-> SimplePolygon () Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point 2 Rational -> Point 2 Rational :+ ())
-> [Point 2 Rational] -> [Point 2 Rational :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 Rational -> Point 2 Rational :+ ()
forall a. a -> a :+ ()
ext ([Point 2 Rational] -> SimplePolygon () Rational)
-> [Point 2 Rational] -> SimplePolygon () Rational
forall a b. (a -> b) -> a -> b
$ [Point 2 Rational
forall (d :: Nat) r. (Arity d, Num r) => Point d r
origin, Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
200 Rational
0, Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
200 Rational
200]


triangle2 :: PlanarSubdivision Test () () Int Rational
triangle2 :: PlanarSubdivision Test () () Int Rational
triangle2 = (\SimplePolygon () Rational
pg -> Id Test
-> SimplePolygon () Rational
-> Int
-> Int
-> PlanarSubdivision Test () () Int Rational
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 (Test -> Id Test
forall a. a -> Id a
Id Test
Test) SimplePolygon () Rational
pg Int
2 Int
0)
          SimplePolygon () Rational
trianglePG2
trianglePG2 :: SimplePolygon () Rational
trianglePG2 :: SimplePolygon () Rational
trianglePG2 = [Point 2 Rational :+ ()] -> SimplePolygon () Rational
forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
fromPoints ([Point 2 Rational :+ ()] -> SimplePolygon () Rational)
-> ([Point 2 Rational] -> [Point 2 Rational :+ ()])
-> [Point 2 Rational]
-> SimplePolygon () Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point 2 Rational -> Point 2 Rational :+ ())
-> [Point 2 Rational] -> [Point 2 Rational :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 Rational -> Point 2 Rational :+ ()
forall a. a -> a :+ ()
ext ([Point 2 Rational] -> SimplePolygon () Rational)
-> [Point 2 Rational] -> SimplePolygon () Rational
forall a b. (a -> b) -> a -> b
$ [Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
0 Rational
30, Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
10 Rational
30, Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
10 Rational
40]



triangle4 :: PlanarSubdivision Test () () Int Rational
triangle4 :: PlanarSubdivision Test () () Int Rational
triangle4 = (\SimplePolygon () Rational
pg -> Id Test
-> SimplePolygon () Rational
-> Int
-> Int
-> PlanarSubdivision Test () () Int Rational
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 (Test -> Id Test
forall a. a -> Id a
Id Test
Test) SimplePolygon () Rational
pg Int
1 Int
0)
          SimplePolygon () Rational
trianglePG4
trianglePG4 :: SimplePolygon () Rational
trianglePG4 :: SimplePolygon () Rational
trianglePG4 = [Point 2 Rational :+ ()] -> SimplePolygon () Rational
forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
fromPoints ([Point 2 Rational :+ ()] -> SimplePolygon () Rational)
-> ([Point 2 Rational] -> [Point 2 Rational :+ ()])
-> [Point 2 Rational]
-> SimplePolygon () Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point 2 Rational -> Point 2 Rational :+ ())
-> [Point 2 Rational] -> [Point 2 Rational :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 Rational -> Point 2 Rational :+ ()
forall a. a -> a :+ ()
ext ([Point 2 Rational] -> SimplePolygon () Rational)
-> [Point 2 Rational] -> SimplePolygon () Rational
forall a b. (a -> b) -> a -> b
$ [Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
400 Rational
400, Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
600 Rational
400, Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
600 Rational
600]

triangle3 :: PlanarSubdivision Test () () Int Rational
triangle3 :: PlanarSubdivision Test () () Int Rational
triangle3 = (\SimplePolygon () Rational
pg -> Id Test
-> SimplePolygon () Rational
-> Int
-> Int
-> PlanarSubdivision Test () () Int Rational
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 (Test -> Id Test
forall a. a -> Id a
Id Test
Test) SimplePolygon () Rational
pg Int
3 Int
0)
          SimplePolygon () Rational
trianglePG3
trianglePG3 :: SimplePolygon () Rational
trianglePG3 :: SimplePolygon () Rational
trianglePG3 = [Point 2 Rational :+ ()] -> SimplePolygon () Rational
forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
fromPoints ([Point 2 Rational :+ ()] -> SimplePolygon () Rational)
-> ([Point 2 Rational] -> [Point 2 Rational :+ ()])
-> [Point 2 Rational]
-> SimplePolygon () Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point 2 Rational -> Point 2 Rational :+ ())
-> [Point 2 Rational] -> [Point 2 Rational :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 Rational -> Point 2 Rational :+ ()
forall a. a -> a :+ ()
ext ([Point 2 Rational] -> SimplePolygon () Rational)
-> [Point 2 Rational] -> SimplePolygon () Rational
forall a b. (a -> b) -> a -> b
$ [Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
401 Rational
530, Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
410 Rational
530, Rational -> Rational -> Point 2 Rational
forall r. r -> r -> Point 2 r
Point2 Rational
410 Rational
540]


_myPS :: PlanarSubdivision Test () () Int Rational
_myPS :: PlanarSubdivision Test () () Int Rational
_myPS = PlanarSubdivision Test () () Int Rational
-> (Int -> Int -> Int)
-> FaceId' Test
-> PlanarSubdivision Test () () Int Rational
-> PlanarSubdivision Test () () Int Rational
forall k k (s :: k) (h :: k) v e f r.
PlanarSubdivision h v e f r
-> (f -> f -> f)
-> FaceId' s
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
embedAsHoleIn PlanarSubdivision Test () () Int Rational
triangle2 Int -> Int -> Int
forall a b. a -> b -> a
const (Int -> FaceId' Test
mkFI Int
1) PlanarSubdivision Test () () Int Rational
triangle1
       PlanarSubdivision Test () () Int Rational
-> PlanarSubdivision Test () () Int Rational
-> PlanarSubdivision Test () () Int Rational
forall k (s :: k) v e f r.
PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
`merge`
       PlanarSubdivision Test () () Int Rational
-> (Int -> Int -> Int)
-> FaceId' Test
-> PlanarSubdivision Test () () Int Rational
-> PlanarSubdivision Test () () Int Rational
forall k k (s :: k) (h :: k) v e f r.
PlanarSubdivision h v e f r
-> (f -> f -> f)
-> FaceId' s
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
embedAsHoleIn PlanarSubdivision Test () () Int Rational
triangle3 Int -> Int -> Int
forall a b. a -> b -> a
const (Int -> FaceId' Test
mkFI Int
1) PlanarSubdivision Test () () Int Rational
triangle4


mkFI :: Int -> FaceId' Test
mkFI :: Int -> FaceId' Test
mkFI  = VertexId Test 'Dual -> FaceId' Test
forall k (s :: k) (w :: World). VertexId s (DualOf w) -> FaceId s w
FaceId (VertexId Test 'Dual -> FaceId' Test)
-> (Int -> VertexId Test 'Dual) -> Int -> FaceId' Test
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VertexId Test 'Dual
forall k (s :: k) (w :: World). Int -> VertexId s w
VertexId