Move towards unifying door movement

src/Dodge/DrWdWd.hs

@@ -1,5 +1,8 @@
 module Dodge.DrWdWd where
 
+import Dodge.ShiftPoint
+import Linear
+import Data.IntMap.Merge.Strict
 import Control.Lens
 import Data.Foldable
 import qualified Data.IntSet as IS
@@ -19,6 +22,7 @@ doDrWdWd dww = case dww of
     DrWdMakeDoorDebris -> makeDoorDebris
     DrWdMechanismStepwise nsteps wlids pss -> doorMechanismStepwise nsteps wlids pss
     DoorMechanism -> doorMechanism
+    DoorLerp -> doorLerp
 
 -- TODO sort out why DoorClosed status does not update correctly 22/06/23
 doorMechanism :: Door -> World -> World
@@ -51,6 +55,46 @@ doorMechanism dr w = case mvDir of
         | dist dpos dcp < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorClosed
         | otherwise = cWorld . lWorld . doors . ix drid . drStatus .~ DoorHalfway
 
+doorLerp :: Door -> World -> World
+doorLerp dr w = case newlerp of
+    Just x ->
+        w
+            & cWorld . lWorld . walls %~ merge dropMissing preserveMissing f 
+                (wlposs x)
+            & moveUpdate
+            & cWorld . lWorld . doors . ix drid . drLerp .~ x
+    Nothing -> w
+  where
+    f = zipWithMatched $ \_ l wl -> wl & wlLine .~ l
+    (zp,za) = dr^. drZeroPos
+    (yp,ya) = dr^. drOnePos
+    p2a x = (zp + x *^ (yp - zp) , za + x * diffAngles ya za)
+    wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (p2a x)
+    clerp = dr ^. drLerp
+    newlerp
+        | toOpen && clerp < 1 = Just . min 1 $ clerp + 0.1
+        | clerp > 0 = Just . max 1 $ clerp - 0.1
+        | otherwise = Nothing
+    toOpen = doWdBl (_drTrigger dr) w
+    mvDir
+        | toOpen && _drStatus dr == DoorOpen = Nothing -- Not sure why necessary
+        | toOpen && dist dpos dop > 0.5 = Just $ vecBetweenSpeed speed dpos dop
+        | dist dpos dcp > 0.5 = Just $ vecBetweenSpeed speed dpos dcp
+        | otherwise = Nothing
+    speed = _drSpeed dr
+    drid = _drID dr
+    moveUpdate = playSound . setStatus
+    playSound
+        | _drPushedBy dr == PushesItself = soundContinue (WallSound drid) dpos slideDoorS (Just 1)
+        | otherwise = id
+    dpos = snd $ _drPos dr
+    dop = snd $ _drOpenPos dr
+    dcp = snd $ _drClosePos dr
+    setStatus
+        | dist dpos dop < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorOpen
+        | dist dpos dcp < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorClosed
+        | otherwise = cWorld . lWorld . doors . ix drid . drStatus .~ DoorHalfway
+
 -- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
 -- TODO update _drPos
 -- perhaps also remove use of DoorInt in favour of DoorOpen/DoorClosed