diff --git a/src/Dodge/LevelGen/MoveDoor.hs b/src/Dodge/LevelGen/MoveDoor.hs index 50f05cfc4..d7c5aa134 100644 --- a/src/Dodge/LevelGen/MoveDoor.hs +++ b/src/Dodge/LevelGen/MoveDoor.hs @@ -3,6 +3,7 @@ module Dodge.LevelGen.MoveDoor ( zoneps , moveDoorToward , changeZonedWall + , mvPs ) where import Dodge.Data import Dodge.Base diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index f26b6afac..8641c1d75 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/src/Dodge/LevelGen/TriggerDoor.hs @@ -9,6 +9,7 @@ import Dodge.Data --import Dodge.Zone import Dodge.Default.Wall import Dodge.Wall.Move +import Dodge.LevelGen.MoveDoor --import Dodge.LevelGen.Switch --import Dodge.LevelGen.Pathing import Dodge.LevelGen.MoveDoor @@ -70,14 +71,10 @@ doorMechanismStepwise nsteps drid wlids pss dr w where playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1) toOpen = _drTrigger dr w - --cpss = uncurry (rectanglePairs 9) (head pss) - setWalls n = playSound (foldl' setWall w (zip wlids newps)) + setWalls n = playSound (foldl' (&) w (zipWith moveWallID wlids newps)) & doors . ix drid . drStatus .~ DoorInt n where newps = uncurry (rectanglePairs 9) (pss !! n) - setWall w' (wlid,ps) = w' & moveWallID wlid ps --- setWall w' (wlid,ps,cps) = w' & walls . ix wlid . wlLine .~ ps --- & (\w'' -> foldr (changeZonedWall (wlLine .~ ps) wlid) w'' (zoneps cps)) -- it is not at all clear that the zoning selects the correct walls -- TODO think about wall zoning, simplify! @@ -99,9 +96,13 @@ doorMechanism drid speed wlidOpCps dr w dstatus = _drStatus dr doOpen w' (wlid,openpos,cp) = mvDoorWithZone w' wlid openpos cp doClose w' (wlid,_,cp) = mvDoorWithZone w' wlid cp cp - mvDoorWithZone w' wlid p zp = w' - & walls . ix wlid %~ moveDoorToward speed p - & (\w'' -> foldr (changeZonedWall (moveDoorToward speed p) wlid) w'' (zoneps zp)) + mvDoorWithZone w' wlid p zp = moveWall wlid wl newwlline w' + where + wl = _walls w' IM.! wlid + newwlline = mvPs speed p (_wlLine wl) + -- w' + -- & walls . ix wlid %~ moveDoorToward speed p + -- & (\w'' -> foldr (changeZonedWall (moveDoorToward speed p) wlid) w'' (zoneps zp)) -- TODO cut pathing if not pathable, reset when opened placeSlideDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> World