Add quicksave
This commit is contained in:
@@ -19,10 +19,10 @@ pairsToGraph f pairs =
|
||||
in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM nodes' >> insMapEdgesM pairs'
|
||||
|
||||
removePathsCrossing :: Point2 -> Point2 -> World -> World
|
||||
removePathsCrossing a b w = set pathGraph newGraph $ set pathGraph' pg'
|
||||
removePathsCrossing a b w = set pathGraph newGraph $ set pathGraphP 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)) $ _pathGraphP w
|
||||
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
|
||||
newGraph = pairsToGraph dist pg'
|
||||
|
||||
@@ -29,17 +29,17 @@ addButtonDoor c btp btr a b speed w
|
||||
= over buttons (IM.insert bid bt)
|
||||
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
|
||||
$ set pathGraph newGraph
|
||||
$ set pathGraph' newGraphPairs
|
||||
$ set pathGraphP newGraphPairs
|
||||
$ putDoubleDoor c cond a b speed w
|
||||
where
|
||||
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))
|
||||
$ _pathGraph' w
|
||||
$ _pathGraphP w
|
||||
newGraph = pairsToGraph dist newGraphPairs
|
||||
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
|
||||
eff w' = over pathGraph' (removedPairs ++)
|
||||
eff w' = over pathGraphP (removedPairs ++)
|
||||
. over pathGraph (flip run_ $ insMapEdgesM $ map f removedPairs) $ w'
|
||||
f (x,y) = (x,y,dist x y)
|
||||
-- this has been repeated at least three times: TO BE UNIFIED, REFACTORED
|
||||
@@ -47,20 +47,20 @@ addSwitchDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> Float -> World
|
||||
addSwitchDoor c btp btr a b speed w = over buttons (IM.insert bid bt)
|
||||
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
|
||||
$ set pathGraph newGraph
|
||||
$ set pathGraph' newGraphPairs
|
||||
$ set pathGraphP newGraphPairs
|
||||
$ putDoubleDoor c cond a b speed w
|
||||
where
|
||||
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))
|
||||
$ _pathGraph' w
|
||||
$ _pathGraphP w
|
||||
newGraph = pairsToGraph dist newGraphPairs
|
||||
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
|
||||
openDoor w' = over pathGraph' (removedPairs ++)
|
||||
openDoor w' = over pathGraphP (removedPairs ++)
|
||||
. over pathGraph (flip run_ $ insMapEdgesM $ map f removedPairs) $ w'
|
||||
f (x,y) = (x,y,dist x y)
|
||||
closeDoor w' = over pathGraph' (\\ removedPairs)
|
||||
closeDoor w' = over pathGraphP (\\ removedPairs)
|
||||
. over pathGraph (flip run_ $ delMapEdgesM removedPairs) $ w'
|
||||
|
||||
putDoor
|
||||
|
||||
Reference in New Issue
Block a user