never executed always true always false
    1 {-# LANGUAGE DataKinds           #-}
    2 {-# LANGUAGE ScopedTypeVariables #-}
    3 {-# OPTIONS_HADDOCK hide #-}
    4 module Reanimate.Math.Triangulate
    5   ( Triangulation
    6   , edgesToTriangulation
    7   , edgesToTriangulationM
    8   , trianglesToTriangulation
    9   , trianglesToTriangulationM
   10   , triangulate
   11   )
   12 where
   13 
   14 import           Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate')
   15 import           Algorithms.Geometry.PolygonTriangulation.Types
   16 import           Control.Lens
   17 import           Control.Monad
   18 import           Control.Monad.ST
   19 import           Data.Ext
   20 import           Data.Geometry.PlanarSubdivision                      (PolygonFaceData)
   21 import           Data.Geometry.Point
   22 import           Data.Geometry.Polygon
   23 import qualified Data.IntSet                                          as ISet
   24 import qualified Data.PlaneGraph as Geo
   25 import           Data.Proxy
   26 import qualified Data.Vector                                          as V
   27 import qualified Data.Vector.Mutable                                  as MV
   28 import           Linear.V2
   29 import           Reanimate.Math.Common
   30 -- Max edges: n-2
   31 -- Each edge is represented twice: 2n-4
   32 -- Flat structure:
   33 --   edges   :: V.Vector Int -- max length (2n-4)
   34 --   offsets :: V.Vector Int -- length n
   35 -- Combine the two vectors? < n => offsets, >= n => edges?
   36 type Triangulation = V.Vector [Int]
   37 
   38 -- FIXME: Move to Common or a Triangulation module
   39 -- O(n)
   40 edgesToTriangulation :: Int -> [(Int, Int)] -> Triangulation
   41 edgesToTriangulation size edges = runST $ do
   42   v <- edgesToTriangulationM size edges
   43   V.unsafeFreeze v
   44 
   45 edgesToTriangulationM :: Int -> [(Int, Int)] -> ST s (V.MVector s [Int])
   46 edgesToTriangulationM size edges = do
   47   v <- MV.replicate size []
   48   forM_ edges $ \(e1, e2) -> do
   49     MV.modify v (e1 :) e2
   50     MV.modify v (e2 :) e1
   51   forM_ [0 .. size - 1] $ \i -> MV.modify v (ISet.toList . ISet.fromList) i
   52   return v
   53 
   54 trianglesToTriangulation :: Int -> V.Vector (Int, Int, Int) -> Triangulation
   55 trianglesToTriangulation size edges = runST $ do
   56   v <- trianglesToTriangulationM size edges
   57   V.unsafeFreeze v
   58 
   59 trianglesToTriangulationM
   60   :: Int -> V.Vector (Int, Int, Int) -> ST s (V.MVector s [Int])
   61 trianglesToTriangulationM size trigs = do
   62   v <- MV.replicate size []
   63   forM_ (V.toList trigs) $ \(a, b, c) -> do
   64     MV.modify v (\x -> b : c : x) a
   65     MV.modify v (\x -> a : c : x) b
   66     MV.modify v (\x -> a : b : x) c
   67   forM_ [0 .. size - 1] $ \i -> MV.modify v (ISet.toList . ISet.fromList) i
   68   return v
   69 
   70 
   71 triangulate :: forall a. (Fractional a, Ord a) => Ring a -> Triangulation
   72 triangulate r = edgesToTriangulation (ringSize r) ds
   73   where
   74     ds :: [(Int,Int)]
   75     ds =
   76       [ (a^.Geo.vData, b^.Geo.vData)
   77       | (d, Diagonal) <- V.toList (Geo.edges pg)
   78       , let (a,b) = Geo.endPointData d pg ]
   79     pg :: Geo.PlaneGraph () Int PolygonEdgeType PolygonFaceData a
   80     pg = triangulate' Proxy p
   81     p :: SimplePolygon Int a
   82     p = fromPoints $
   83       [ Point2 x y :+ n
   84       | (n,V2 x y) <- zip [0..] (V.toList (ringUnpack r)) ]
   85     -- ringUnpack