Commit before door refactor

src/Dodge/Placement/Instance/Door.hs

@@ -30,6 +30,13 @@ putDoubleDoorThen pathing col cond soff a b speed cont
     doorbetween pa pb = pt0 $ PutSlideDr pathing col cond soff pa pb speed
     half = 0.5 *.* (a +.+ b)
 
+--doorBetween pathing col cond soff pa pb speed g = case divideLine 80 pa pb of
+--    [x,y] -> \_ -> Just (pt0 (PutSlideDr pathing col cond soff x y speed) g)
+--    (x:y:zs) -> foldr f g (zip (x:y:zs) (y:zs))
+--      where
+--        f :: (Point2,Point2) -> (Placement -> Maybe Placement) -> (Placement -> Maybe Placement)
+--        f (a,b) h = \pl -> Just (pt0 (PutSlideDr pathing col cond (soff - dist y pb) a b speed) h)
+
 putAutoDoor :: Point2 -> Point2 -> Placement
 putAutoDoor a b = PlacementUsingPos (addZ 0 a)
     $ \az -> PlacementUsingPos (addZ 0 b)

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -4,6 +4,7 @@ module Dodge.Placement.PlaceSpot.TriggerDoor
     , plSlideDoor
     ) where
 import Dodge.Data
+import Dodge.Base
 import Dodge.Default.Wall
 import Dodge.Default.Door
 import Dodge.Wall.Move
@@ -74,14 +75,21 @@ doorMechanismStepwise nsteps drid wlids pss dr w
         newps = uncurry (rectanglePairs 9) (pss !! n)
 -- it is not at all clear that the zoning selects the correct walls
 
-doorMechanism :: Int -> Float -> [(Int,(Point2,Point2),(Point2,Point2))] -> Door -> World -> World
-doorMechanism drid speed wlidOpCps dr w 
+doorMechanism :: [(Int,(Point2,Point2),(Point2,Point2))] -> Door -> World -> World
+doorMechanism wlidOpCps dr w 
     | toOpen     && dstatus /= DoorOpen   = moveUpdate $ foldl' doOpen  w wlidOpCps
         & doors . ix drid . drPos %~ mvPs speed (_drOpenPos dr)
     | not toOpen && dstatus /= DoorClosed = moveUpdate $ foldl' doClose w wlidOpCps
         & doors . ix drid . drPos %~ mvPs speed (_drClosePos dr)
     | otherwise = w
   where
+    toOpen  = _drTrigger dr w
+    mvDir 
+        | toOpen && dist dpos dop > 1 = Just $ mvPointTowardAtSpeed speed dop dpos
+        | dist dpos dcp > 1 = Just $ mvPointTowardAtSpeed speed dcp dpos
+        | otherwise = Nothing
+    speed = _drSpeed dr
+    drid = _drID dr
     moveUpdate = playSound . setStatus
     playSound = soundContinue (WallSound drid) dpos slideDoorS (Just 1)
     dpos = snd $ _drPos dr
@@ -91,7 +99,6 @@ doorMechanism drid speed wlidOpCps dr w
         | dist dpos dop < 1 = doors . ix drid . drStatus .~ DoorOpen
         | dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed
         | otherwise                       = doors . ix drid . drStatus .~ DoorHalfway
-    toOpen  = _drTrigger dr w
     dstatus = _drStatus dr
     doOpen  w' (wlid,opp, _) = moveWallIDToward wlid speed opp w'
     doClose w' (wlid,_ ,clp) = moveWallIDToward wlid speed clp w'
@@ -116,10 +123,11 @@ plSlideDoor isPathable col cond shiftOffset a b speed gw
         , _drWallIDs = IS.fromList wlids
         , _drStatus = DoorClosed
         , _drTrigger = cond
-        , _drMech   = doorMechanism drid speed (zip3 wlids shiftedPairs pairs)
+        , _drMech   = doorMechanism (zip3 wlids shiftedPairs pairs)
         , _drPos = (a,b)
         , _drOpenPos = (shiftLeft a,shiftLeft b)
         , _drClosePos = (a,b)
+        , _drSpeed = speed
         }
     addDoorWalls w' = foldl' (addDoorWall drid col isPathable) w' $ zip wlids pairs
     pairs = rectanglePairs 9 a b