Work on perhaps replacing FGL with incidence vectors

src/Dodge/Data/World.hs

@@ -50,6 +50,7 @@ data World = World
     , _pnZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
     , _peZoning :: IntMap (IntMap (Set PathEdgeNodes))
     , _incNodeZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
+    , _incEdgeZoning :: IntMap (IntMap [(Int,Int)]) --Zoning IM.IntMap Creature
     , _gsZoning :: IntMap (IntMap IntSet)
     , _wCam :: Camera
     , _unpauseClock :: Int

src/Dodge/Default/World.hs

@@ -50,6 +50,7 @@ defaultWorld =
         , _pnZoning = mempty
         , _peZoning = mempty
         , _incNodeZoning = mempty
+        , _incEdgeZoning = mempty
         , _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos)
         , _unpauseClock = 0
         , _coordinates = mempty

src/Dodge/Layout.hs

@@ -51,9 +51,11 @@ generateLevelFromRoomList gr' w =
             & pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
             & peZoning .~ foldl' (flip zonePe) mempty (map fromEdgeTuple $ labEdges path)
             & incNodeZoning .~ UV.ifoldl' (\m i p -> zonePn (i,p) m) mempty inodes
+            & incEdgeZoning .~ foldl' (flip (zoneIncPe inodes)) mempty ipairs
   where
-    (_, path) = pairsToGraph . snapToGrid $ foldMap _rmPath rs
-    (inodes,igraph) = pairsToIncGraph . snapToGrid $ foldMap _rmPath rs
+    pairs = snapToGrid $ foldMap _rmPath rs
+    (_, path) = pairsToGraph pairs
+    (inodes,igraph,ipairs) = pairsToIncGraph pairs
     rs = map doRoomShift $ IM.elems rs'
     rs' = mapM shuffleRoomPos gr' & evalState $ _randGen w
 

src/Dodge/Path.hs

@@ -126,8 +126,11 @@ pointTowardsImpulse a b w =
 --
 
 pairsToIncGraph :: Set.Set (Point2,Point2) 
-    -> (UV.Vector Point2, V.Vector [(Int,SimpleEdge)])
-pairsToIncGraph pairs = (inodes,incgraph)
+    -> (UV.Vector Point2
+        , V.Vector [(Int,SimpleEdge)]
+        , [(Int,Int)]
+    )
+pairsToIncGraph pairs = (inodes,incgraph,undefined)
   where
     incgraph = V.generate (length im) (\i -> im ^?! ix i)
     im = IM.fromListWith (<>) . fmap toedge $ Set.toList pairs

src/Dodge/Zoning/Pathing.hs

@@ -1,5 +1,6 @@
 module Dodge.Zoning.Pathing where
 
+import qualified Data.Vector.Unboxed as UV
 import Data.Foldable
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -8,6 +9,7 @@ import Dodge.Zoning.Base
 import Dodge.Zoning.Common
 import Geometry
 import qualified IntMapHelp as IM
+import Control.Lens
 
 pnsNearPoint :: Point2 -> World -> [(Int, Point2)]
 pnsNearPoint = nearPoint pnZoneSize _pnZoning
@@ -47,6 +49,9 @@ pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r)
 peZoneSize :: Float
 peZoneSize = 50
 
+zoneOfIncPe :: UV.Vector Point2 -> (Int,Int) -> [Int2]
+zoneOfIncPe m (i,j) = zoneOfSeg peZoneSize (m ^?! ix i) (m ^?! ix j)
+
 zoneOfPe :: PathEdgeNodes -> [Int2]
 zoneOfPe (PathEdgeNodes _ _ pe) = zoneOfSeg peZoneSize (_peStart pe) (_peEnd pe)
 
@@ -57,3 +62,11 @@ zonePe ::
 zonePe pe im = foldl' f im (zoneOfPe pe)
   where
     f im' i2 = zoneMonoid i2 (Set.singleton pe) im'
+
+zoneIncPe :: UV.Vector Point2 -> 
+    (Int,Int) ->
+    IM.IntMap (IM.IntMap [(Int,Int)]) ->
+    IM.IntMap (IM.IntMap [(Int,Int)])
+zoneIncPe v pe im = foldl' f im (zoneOfIncPe v pe)
+  where
+    f im' i2 = zoneMonoid i2 [pe] im'