Refactor doors

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -2,18 +2,17 @@
 module Dodge.Placement.PlaceSpot.TriggerDoor
     ( plDoor
     , plSlideDoor
+    , maybeClearDoorPaths
     ) where
 import Dodge.Zoning.Wall
 import Dodge.Data
 import Dodge.Base
 import Dodge.Path
 import Dodge.Default.Door
-import Dodge.Wall.Move
 import Dodge.LevelGen.DoorPane
 import Picture
 import Geometry
 import qualified IntMapHelp as IM
-import Dodge.SoundLogic
 import LensHelp
 --import Dodge.LevelGen.LevelStructure
 
@@ -23,7 +22,7 @@ import qualified Data.IntSet as IS
 import qualified Data.Graph.Inductive as FGL
 plDoor :: Color
     -> EdgeObstacle
-    -> (World -> Bool)      -- ^ Opening condition
+    -> WdBl      -- ^ Opening condition
     -> [(Point2,Point2)]   -- ^ Door positions, closed to open.
                     -- Bumped out up and down by 9, not widened
     -> World
@@ -36,7 +35,7 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull
         , _drWallIDs = IS.fromList wlids
         , _drStatus = DoorInt 0
         , _drTrigger = cond
-        , _drMech   = doorMechanismStepwise nsteps drid wlids pss
+        , _drMech   = DrWdMechanismStepwise nsteps wlids pss
         , _drPos = head pss
         , _drOpenPos = head pss
         , _drClosePos = last pss
@@ -57,59 +56,6 @@ addDoorWall eo drid wl w (wlid,wlps) = w'
     & doors . ix drid . drObstructs .++~ es
   where
     (w',es) = uncurry (obstructPathsCrossing eo) wlps w
--- 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
--- perhaps only store intermediate door pos pairs, calculate all wall positions
--- on the fly
-doorMechanismStepwise :: Int -> Int -> [Int] -> [(Point2,Point2)] -> Door -> World -> World
-doorMechanismStepwise nsteps drid wlids pss dr w 
-    | toOpen = case _drStatus dr of
-        DoorInt x | x == nsteps -> w
-        DoorInt x               -> setWalls (x+1)
-        _                       -> w
-    | otherwise = case _drStatus dr of
-        DoorInt 0 -> w
-        DoorInt x -> setWalls (x-1)
-        _         -> w
-  where
-    playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1)
-    toOpen = _drTrigger dr w
-    setWalls n = playSound (foldl' (&) w (zipWith moveWallID wlids newps))
-        & doors . ix drid . drStatus .~ DoorInt n
-      where
-        newps = uncurry (rectanglePairs 9) (pss !! n)
--- it is not at all clear that the zoning selects the correct walls
-
--- TODO sort out why DoorClosed status does not update correctly 22/06/23
-doorMechanism :: Door -> World -> World
-doorMechanism dr w = case mvDir of
-    Just d -> w
-        & flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr)
-        & moveUpdate 
-        & doors . ix drid . drPos . each %~ (+.+ d)
-        & maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr)
-    Nothing -> w
-  where
-    toOpen = _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 = doors . ix drid . drStatus .~ DoorOpen
-        | dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed
-        | otherwise                       = doors . ix drid . drStatus .~ DoorHalfway
 
 maybeClearDoorPaths :: EdgeObstacle -> [(Int,Int,PathEdge)] -> World -> World
 maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
@@ -138,7 +84,7 @@ plSlideDoor dr wl eo shiftOffset a b gw
         { _drID = drid
         , _drWallIDs = IS.fromList wlids
         , _drStatus = DoorClosed
-        , _drMech   = doorMechanism
+        , _drMech   = DoorMechanism
         , _drPos = (a,b)
         , _drOpenPos = (shiftLeft a,shiftLeft b)
         , _drClosePos = (a,b)