Improve line zoning
This commit is contained in:
@@ -23,6 +23,6 @@ removePathsCrossing a b w = set pathGraph newGraph $ set pathGraph' pg'
|
||||
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
|
||||
w
|
||||
where
|
||||
pg' = filter (isNothing . uncurry (intersectSegSeg' a b)) $ _pathGraph' w
|
||||
pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraph' w
|
||||
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
|
||||
newGraph = pairsToGraph dist pg'
|
||||
|
||||
@@ -30,7 +30,7 @@ addButtonDoor c btp btr a b w = over buttons (IM.insert bid bt)
|
||||
bid = IM.newKey $ _buttons w
|
||||
cond w' = BtNoLabel == _btState (_buttons w' IM.! bid)
|
||||
bt = (makeButton c eff) {_btPos = btp, _btRot = btr, _btID = bid}
|
||||
(newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg' a b))
|
||||
(newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg a b))
|
||||
$ _pathGraph' w
|
||||
newGraph = pairsToGraph dist newGraphPairs
|
||||
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
|
||||
@@ -49,7 +49,7 @@ addSwitchDoor c btp btr a b w = over buttons (IM.insert bid bt)
|
||||
bid = IM.newKey $ _buttons w
|
||||
cond w' = BtOn == _btState (_buttons w' IM.! bid)
|
||||
bt = (makeSwitch c openDoor closeDoor) {_btPos = btp, _btRot = btr, _btID = bid}
|
||||
(newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg' a b))
|
||||
(newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg a b))
|
||||
$ _pathGraph' w
|
||||
newGraph = pairsToGraph dist newGraphPairs
|
||||
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
|
||||
|
||||
Reference in New Issue
Block a user