Refactor sliding door movement

src/Dodge/LevelGen/MoveDoor.hs

@@ -3,6 +3,7 @@ module Dodge.LevelGen.MoveDoor
     ( zoneps
     , moveDoorToward
     , changeZonedWall
+    , mvPs
     ) where
 import Dodge.Data
 import Dodge.Base

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' (&) w (zipWith moveWallID wlids newps))
-    setWalls n = playSound (foldl' setWall w (zip 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'
+    mvDoorWithZone w' wlid p zp = moveWall wlid wl newwlline w'
-        & walls . ix wlid %~ moveDoorToward speed p
+      where
-        & (\w'' -> foldr (changeZonedWall (moveDoorToward speed p) wlid) w'' (zoneps zp))
+        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