Improve doors

src/Dodge/Door.hs

@@ -20,9 +20,10 @@ import Picture.Data
 import Shape.Data
 
 updateDoor :: Door -> World -> (S.Set Int2, World)
-updateDoor dr w
-    | DoorLerp x <- dr ^. drUpdate = doorLerp x dr w
-    | otherwise =
+updateDoor dr w = case dr ^. drUpdate of
+    DoorLerp x -> doorLerp x dr w
+    DoorLerpWithTimer n x -> doorLerpWithTimer n x dr w
+    DoorDoNothing ->
         ( mempty
         , foldl' (doDoorMount (doDoorLerp dr (dr ^. drLerp))) w (dr ^. drMounts)
         )
@@ -68,3 +69,38 @@ doorLerp speed dr w = fromMaybe (mempty, domounts (dr ^. drLerp) w) $ do
             soundContinue (WallSound drid) (fst $ doDoorLerp dr x) slideDoorS (Just 1)
         | otherwise = id
 
+doorLerpWithTimer :: Int -> Float -> Door -> World -> (S.Set Int2, World)
+doorLerpWithTimer n speed dr w = fromMaybe (mempty, domounts (dr ^. drLerp) w & uptimer) $ do
+    x <- newlerp
+    let ps = wlposs x
+        ps' = wlposs (dr ^. drLerp)
+        is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) (ps <> ps')
+    -- it seems possible that this will miss some paths: we don't add zones for the
+    -- old footprint. Seems unlikely, but a possible cause of pathfinding bugs
+    return
+        ( is
+        , domounts x $
+            f x
+                & playSound x
+                & cWorld . lWorld . doors . ix drid . drLerp .~ x
+                & uptimer
+        )
+  where
+    domounts x w' = foldl' (doDoorMount (doDoorLerp dr x)) w' (dr ^. drMounts)
+    f = ifoldl' (flip . moveWallID) w . wlposs
+    wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x)
+    clerp = dr ^. drLerp
+    newlerp
+        | toOpen && clerp < 1 = Just . min 1 $ clerp + speed
+        | clerp > 0 && not toOpen = Just . max 0 $ clerp - speed
+        | otherwise = Nothing
+    uptimer = cWorld . lWorld . doors . ix drid . drUpdate . drLerpTimer %~ updatetimer
+    updatetimer
+        | doWdBl (_drTrigger dr) w = const 20
+        | otherwise = max 0 . subtract 1
+    toOpen = doWdBl (_drTrigger dr) w || n > 0
+    drid = _drID dr
+    playSound x
+        | _drPushedBy dr == PushesItself =
+            soundContinue (WallSound drid) (fst $ doDoorLerp dr x) slideDoorS (Just 1)
+        | otherwise = id