Store paths crossing block walls in block

This commit is contained in:
2022-07-02 15:31:27 +01:00
parent 75a98a572f
commit 3952ec6315
8 changed files with 52 additions and 17 deletions
+4 -3
View File
@@ -120,9 +120,10 @@ evaluateRandPS rgen ps w = placeSpotID ps evaluatedType (set randGen g w)
(evaluatedType, g) = runState rgen (_randGen w)
placeWallPoly :: [Point2] -> Wall -> World -> World
placeWallPoly ps wl = rmCrossPaths . over walls (placeWalls ps wl)
where
rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ loopPairs ps
placeWallPoly ps wl = -- rmCrossPaths .
over walls (placeWalls ps wl)
-- where
-- rmCrossPaths w = foldr (uncurry obstructPathsCrossing) w $ loopPairs ps
placeWalls :: [Point2] -> Wall -> IM.IntMap Wall -> IM.IntMap Wall
placeWalls qs wl wls = foldl' (addPane wl) wls pairs