Partially working mounts on lerp doors

src/Dodge/DrWdWd.hs

@@ -1,15 +1,13 @@
 module Dodge.DrWdWd (doDrWdWd) where
 
-import Dodge.Wall.Move
-import Dodge.ShiftPoint
-import Linear
-import Data.IntMap.Merge.Strict
 import Control.Lens
+import Data.Maybe
 import Dodge.Block.Debris
 import Dodge.Data.World
+import Dodge.ShiftPoint
 import Dodge.SoundLogic
+import Dodge.Wall.Move
 import Dodge.WorldBool
-import Geometry
 
 doDrWdWd :: DrWdWd -> Door -> World -> World
 doDrWdWd dww = case dww of
@@ -18,20 +16,15 @@ doDrWdWd dww = case dww of
     DoorLerp -> doorLerp
 
 doorLerp :: Door -> World -> World
-doorLerp dr w = case newlerp of
-    Just x ->
-        w' x
---            & cWorld . lWorld . walls %~ merge dropMissing preserveMissing f 
---                (wlposs x)
-            & moveUpdate
+doorLerp dr w = fromMaybe w $ do
+    x <- newlerp
+    return $
+        f x
+            & playSound x
             & cWorld . lWorld . doors . ix drid . drLerp .~ x
-    Nothing -> w
   where
-    w' = ifoldl' (\i v p -> moveWallID i p v) w . wlposs
---    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)
+    f = ifoldl' (flip . moveWallID) w . wlposs
+    p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos)
     wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (p2a x)
     clerp = dr ^. drLerp
     newlerp
@@ -39,21 +32,10 @@ doorLerp dr w = case newlerp of
         | clerp > 0 && not toOpen = Just . max 0 $ clerp - speed
         | 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)
+    playSound x
+        | _drPushedBy dr == PushesItself =
+            soundContinue (WallSound drid) (fst $ p2a x) 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
+--    dpos = snd $ _drPos dr