justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add variable door speed, still buggy

Browse Source
This commit is contained in:
justin
2021-09-10 13:41:46 +01:00
parent 87a9745d37
commit c695767fb0
11 changed files with 99 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/TriggerDoor.hs
+13 -12
View File
@@ -24,12 +24,13 @@ import Control.Lens
import Data.Graph.Inductive hiding ((&))
-- probably don't have to rebuild the entire graph, oh well
addButtonDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> World -> World
addButtonDoor c btp btr a b w = over buttons (IM.insert bid bt)
addButtonDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> Float -> World -> World
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
$ putDoubleDoor c cond a b w
$ putDoubleDoor c cond a b speed w
where
bid = IM.newKey $ _buttons w
cond w' = BtNoLabel == _btState (_buttons w' IM.! bid)
@@ -42,12 +43,12 @@ addButtonDoor c btp btr a b w = over buttons (IM.insert bid bt)
. 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
addSwitchDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> World -> World
addSwitchDoor c btp btr a b w = over buttons (IM.insert bid bt)
addSwitchDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> Float -> World -> 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
$ putDoubleDoor c cond a b w
$ putDoubleDoor c cond a b speed w
where
bid = IM.newKey $ _buttons w
cond w' = BtOn == _btState (_buttons w' IM.! bid)
@@ -75,17 +76,17 @@ putDoor c cond pss = over walls triggerDoor
where
is = [IM.newKey wls..]
putDoubleDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> World -> World
putDoubleDoor c cond a b = over walls triggerDoubleDoor
putDoubleDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> World -> World
putDoubleDoor c cond a b speed = over walls triggerDoubleDoor
where
triggerDoubleDoor wls = IM.union wls $ IM.fromList $ zip is $ mkDoubleDoor c False cond a b is
triggerDoubleDoor wls = IM.union wls $ IM.fromList $ zip is $ mkDoubleDoor c False cond a b speed is
where
is = [IM.newKey wls..]
putSingleDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> World -> World
putSingleDoor c cond a b = over walls putTheDoor
putSingleDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> World -> World
putSingleDoor c cond a b speed = over walls putTheDoor
where
putTheDoor wls = IM.union wls $ IM.fromList $ zip is $ mkSingleDoor c False cond a b is
putTheDoor wls = IM.union wls $ IM.fromList $ zip is $ mkSingleDoor c False cond a b speed is
where
is = [IM.newKey wls..]