Move toward moving lights on doors

src/Dodge/Placement/Instance/Door.hs

@@ -15,12 +15,16 @@ import Dodge.LevelGen.Switch
 import qualified Data.IntMap.Strict as IM
 
 putDoubleDoor :: Bool -> Color -> (World -> Bool)  -> Point2 -> Point2 -> Float -> Placement
-putDoubleDoor pathing col cond a b speed = putDoubleDoorThen pathing col cond a b speed Nothing
+putDoubleDoor pathing col cond a b speed 
+    = putDoubleDoorThen pathing col cond a b speed (const $ const Nothing)
 
 putDoubleDoorThen :: Bool -> Color -> (World -> Bool) 
-    -> Point2 -> Point2 -> Float -> Maybe Placement -> Placement
-putDoubleDoorThen pathing col cond a b speed mayp = ps0j (PutSlideDr pathing col cond a half speed)
-    $ Placement (PS (V2 0 0) 0) ( PutSlideDr pathing col cond b half speed) Nothing $ const mayp
+    -> Point2 -> Point2 -> Float 
+    -> (Placement -> Placement -> Maybe Placement)
+    -> Placement
+putDoubleDoorThen pathing col cond a b speed cont = pt0 (PutSlideDr pathing col cond a half speed)
+    $ \pl1 -> Just $ Placement (PS (V2 0 0) 0) ( PutSlideDr pathing col cond b half speed) Nothing 
+    $ \pl2 -> cont pl1 pl2
   where
     half = 0.5 *.* (a +.+ b)
 

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -33,12 +33,10 @@ plDoor col cond pss gw = (drid, gw & gWorld  .~ (addWalls w & doors %~ addDoor))
         , _drStatus = DoorInt 0
         , _drTrigger = cond
         , _drMech   = doorMechanismStepwise nsteps drid wlids pss
-        , _drPos = openp
-        , _drOpenPos = openp
-        , _drClosePos = closep
+        , _drPos = head pss
+        , _drOpenPos = head pss
+        , _drClosePos = last pss
         }
-    openp = 0.5 *.* uncurry (+.+) (head pss)
-    closep = 0.5 *.* uncurry (+.+) (last pss)
     nsteps = length pss - 1
     wlids = take 4 [IM.newKey $ _walls w ..]
     wlps' = uncurry (rectanglePairs 9) $ head pss
@@ -56,6 +54,8 @@ addDoorWall col pathableStatus w (wlid,wlps) = w & walls %~ IM.insert wlid defau
 -- 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
@@ -78,19 +78,20 @@ doorMechanismStepwise nsteps drid wlids pss dr w
 doorMechanism :: Int -> Float -> [(Int,(Point2,Point2),(Point2,Point2))] -> Door -> World -> World
 doorMechanism drid speed wlidOpCps dr w 
     | toOpen     && dstatus /= DoorOpen   = moveUpdate $ foldl' doOpen  w wlidOpCps
-        & doors . ix drid . drPos %~ mvP speed (_drOpenPos dr)
+        & doors . ix drid . drPos %~ mvPs speed (_drOpenPos dr)
     | not toOpen && dstatus /= DoorClosed = moveUpdate $ foldl' doClose w wlidOpCps
-        & doors . ix drid . drPos %~ mvP speed (_drClosePos dr)
+        & doors . ix drid . drPos %~ mvPs speed (_drClosePos dr)
     | otherwise = w
   where
     moveUpdate = playSound . setStatus
-    playSound = soundContinue (WallSound drid) (fst cpos) slideDoorS (Just 1)
+    playSound = soundContinue (WallSound drid) dpos slideDoorS (Just 1)
+    dpos = snd $ _drPos dr
+    dop = snd $ _drOpenPos dr
+    dcp = snd $ _drClosePos dr
     setStatus
-        | dist (_drPos dr) (_drOpenPos dr) < 1 = doors . ix drid . drStatus .~ DoorOpen
-        | dist (_drPos dr) (_drClosePos dr) < 1 = doors . ix drid . drStatus .~ DoorClosed
+        | dist dpos dop < 1 = doors . ix drid . drStatus .~ DoorOpen
+        | dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed
         | otherwise                       = doors . ix drid . drStatus .~ DoorHalfway
-    (wlid',opos,cpos) = head wlidOpCps
-    wlpos   = _wlLine $ _walls w IM.! wlid'
     toOpen  = _drTrigger dr w
     dstatus = _drStatus dr
     doOpen  w' (wlid,opp, _) = moveWallIDToward wlid speed opp w'
@@ -109,9 +110,9 @@ plSlideDoor isPathable col cond a b speed gw = (drid, gw & gWorld .~ (addWalls w
         , _drStatus = DoorClosed
         , _drTrigger = cond
         , _drMech   = doorMechanism drid speed (zip3 wlids shiftedPairs pairs)
-        , _drPos = b
-        , _drOpenPos = shiftLeft b
-        , _drClosePos = b
+        , _drPos = (a,b)
+        , _drOpenPos = (shiftLeft a,shiftLeft b)
+        , _drClosePos = (a,b)
         }
     addWalls w' = foldl' (addDoorWall col isPathable) w' $ zip wlids pairs
     pairs = rectanglePairs 9 a b