From c583d33b57347a51fcf8940ef29f2fea9d76cf70 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 9 Mar 2022 22:41:17 +0000 Subject: [PATCH] Move toward moving lights on doors --- src/Dodge/Data.hs | 6 ++-- src/Dodge/Placement/Instance/Door.hs | 12 +++++--- src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 31 ++++++++++---------- src/Dodge/Room/Airlock.hs | 2 +- src/Dodge/Room/LongDoor.hs | 3 +- src/Dodge/Wall/Move.hs | 2 +- 6 files changed, 31 insertions(+), 25 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 7689bdfe0..6acab3bc3 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -739,9 +739,9 @@ data Door = Door , _drStatus :: DoorStatus , _drTrigger :: World -> Bool , _drMech :: Door -> World -> World - , _drPos :: Point2 - , _drOpenPos :: Point2 - , _drClosePos :: Point2 + , _drPos :: (Point2,Point2) + , _drOpenPos :: (Point2,Point2) + , _drClosePos :: (Point2,Point2) } data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int deriving (Eq, Ord, Show) diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs index ce5ce43a9..ffc2e8e6b 100644 --- a/src/Dodge/Placement/Instance/Door.hs +++ b/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) diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index cee00f94c..1cb33f5bd 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ 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 diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 0364d53ce..3dfb9d95c 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -29,7 +29,7 @@ airlock0 = defaultRoom , _rmPmnts = [pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id) $ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2 - $ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing + $ \_ _ -> Just $ putDoubleDoor False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 ,spanLightI (V2 (-2) 30) (V2 (-2) 70) ,sps0 $ PutShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50) ] diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 39b42672c..c4448c22b 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -117,7 +117,8 @@ addButtonSlowDoor x h rm = do belowH y = (sndV2 . fst) y < h - 40 aboveH y = (sndV2 . fst) y > h + 40 butDoor _ _ = putLitButOnPos col butPosCond - $ \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2 + $ \btid -> Just $ putDoubleDoorThen False col (cond' btid) (V2 0 h) (V2 x h) 2 + $ \dr1 dr2 -> Nothing butPosCond (UnusedLink (V2 x' y') a' _) _ | y' < 0.5 * h = Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink)) butPosCond _ _ = Nothing diff --git a/src/Dodge/Wall/Move.hs b/src/Dodge/Wall/Move.hs index fd2d12ed0..a227b581d 100644 --- a/src/Dodge/Wall/Move.hs +++ b/src/Dodge/Wall/Move.hs @@ -3,7 +3,7 @@ module Dodge.Wall.Move ( moveWallID , moveWall , moveWallIDToward - , mvP + , mvPs ) where import Dodge.Data import Dodge.Base