Attempt to improve perfomance

This commit is contained in:
2022-08-25 09:52:12 +01:00
parent 6973663055
commit 920bfdbc8e
18 changed files with 60 additions and 311 deletions
+1 -1
View File
@@ -119,7 +119,7 @@ insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ Set.uni
where
(w', paths) = mapAccumR (flip insertWall) w wls
insertWall :: Wall -> World -> (World, Set (Int, Int, PathEdge))
insertWall :: Wall -> World -> (World, Set PathEdgeNodes)
insertWall wl =
uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
. (cWorld . walls . at (_wlID wl) ?~ wl)
+3 -3
View File
@@ -65,11 +65,11 @@ addDoorWall eo drid wl w (wlid, wlps) =
where
(w', es) = uncurry (obstructPathsCrossing eo) wlps w
maybeClearDoorPaths :: EdgeObstacle -> Set (Int, Int, PathEdge) -> World -> World
maybeClearDoorPaths :: EdgeObstacle -> Set PathEdgeNodes -> World -> World
maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
maybeClearDoorPath :: EdgeObstacle -> World -> (Int, Int, PathEdge) -> World
maybeClearDoorPath eo w (x, y, pe)
maybeClearDoorPath :: EdgeObstacle -> World -> PathEdgeNodes -> World
maybeClearDoorPath eo w (PathEdgeNodes x y pe)
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x, y)
| otherwise =