Remove fusePairs, replaces with snapToGrid

src/Dodge/Layout.hs

@@ -50,7 +50,7 @@ generateLevelFromRoomList gr' w =
   where
     (_, path) = pairsToGraph pairPath'
     pairPath = foldMap _rmPath rs
-    pairPath' = fusePairs pairPath
+    pairPath' = snapToGrid pairPath
     rs = map doRoomShift $ IM.elems rs'
     rs' = mapM shuffleRoomPos gr' & evalState $ _randGen w
 

src/Dodge/Path.hs

@@ -9,7 +9,7 @@ module Dodge.Path (
     getNodePos,
     walkableNodeNear,
     bfsNodePoints,
-    fusePairs,
+    snapToGrid,
 ) where
 
 import Data.Set (Set)
@@ -17,7 +17,6 @@ import qualified Data.Set as Set
 import Control.Lens
 import Data.Foldable
 import Data.Graph.Inductive hiding ((&))
-import Data.List
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -29,7 +28,6 @@ import Geometry
 import Data.Bifunctor
 
 getNodePos :: Int -> World -> Maybe Point2
---getNodePos i w = _pathGraph (_cWorld w) `lab` i
 getNodePos i w = (w ^. cWorld . pathGraph) `lab` i
 
 makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
@@ -147,10 +145,8 @@ obstructPathsCrossing obstacletype sp' ep w =
     updateedge gr (PathEdgeNodes x y pe) =
         insEdge (x, y, pe & peObstacles . at obstacletype ?~ ()) $ delEdge (x, y) gr
 
-fuseFunc :: (a -> a -> Bool) -> [a] -> a -> a
-fuseFunc t xs x = fromJust . find (t x) $ nubBy t xs
-
-fusePairs :: Set (Point2, Point2) -> Set (Point2, Point2)
-fusePairs ps = Set.map (bimap f f) ps
+snapToGrid :: Set (Point2,Point2) -> Set (Point2, Point2)
+snapToGrid = Set.map (over each (fmap (fromIntegral . f)))
   where
-    f = fuseFunc (\x y -> dist x y < 2) . nub $ concatMap (\(x, y) -> [x, y]) $ toList ps
+    f :: Float -> Int
+    f = round