From c2cc38a6421299e9b16ac4f328f191b9b4218c24 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 25 Oct 2025 09:57:13 +0100 Subject: [PATCH] Implement different door speeds --- src/Dodge/Default/Door.hs | 2 +- src/Dodge/LevelGen/PlacementHelper.hs | 8 -- src/Dodge/Placement/Instance/Door.hs | 2 +- src/Dodge/Room/Airlock.hs | 136 ++++++++++++-------------- src/Dodge/Room/LongDoor.hs | 6 +- src/Dodge/Room/Tutorial.hs | 5 + src/Dodge/Update/WallDamage.hs | 2 +- 7 files changed, 72 insertions(+), 89 deletions(-) diff --git a/src/Dodge/Default/Door.hs b/src/Dodge/Default/Door.hs index a513cde3f..775933ccf 100644 --- a/src/Dodge/Default/Door.hs +++ b/src/Dodge/Default/Door.hs @@ -7,7 +7,7 @@ defaultDoor = Door { _drID = 0 , _drTrigger = WdBlConst False - , _drUpdate = DoorDoNothing + , _drUpdate = DoorLerp 1 , _drZeroPos = (0, 0) , _drOnePos = (0, 0) , _drLerp = 0 diff --git a/src/Dodge/LevelGen/PlacementHelper.hs b/src/Dodge/LevelGen/PlacementHelper.hs index e4e682a55..232742961 100644 --- a/src/Dodge/LevelGen/PlacementHelper.hs +++ b/src/Dodge/LevelGen/PlacementHelper.hs @@ -83,11 +83,3 @@ ps0PushPS pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $ ps0PushPSw :: PSType -> (GenWorld -> Placement -> Maybe Placement) -> Placement ps0PushPSw pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $ \w pl -> f w pl & _Just . plSpot %~ const (_plSpot pl) - -addPlmnt :: Placement -> Placement -> Placement -addPlmnt pl pl2 = case pl2 of --- (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp - (Placement ps pt mi mj f) -> Placement ps pt mi mj (fmap (fmap g) f) - where - g Nothing = Just pl - g (Just pl') = Just $ addPlmnt pl pl' diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs index 56a02c407..0d29c81b4 100644 --- a/src/Dodge/Placement/Instance/Door.hs +++ b/src/Dodge/Placement/Instance/Door.hs @@ -58,7 +58,7 @@ doorBetween wl cond soff pa pb speed g = case divideLine 40 pa pb of adoor = defaultDoor & drTrigger .~ cond - & drUpdate . drLerpSpeed .~ speed + & drUpdate .~ DoorLerp speed divideDoorPane :: diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 47c0b5543..53d41f88b 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -3,22 +3,21 @@ {- Rooms that contain two doors and a switch alternating both. -} module Dodge.Room.Airlock where -import Dodge.PlacementSpot -import Dodge.LevelGen.DoorPane -import Dodge.Default.Door -import qualified Data.IntMap.Strict as IM -import Dodge.Default.Wall -import Dodge.Room.Path import Control.Lens import Control.Monad +import qualified Data.IntMap.Strict as IM import Data.Maybe import Dodge.Data.GenWorld +import Dodge.Default.Door import Dodge.Default.Room +import Dodge.Default.Wall +import Dodge.LevelGen.DoorPane import Dodge.LevelGen.PlacementHelper import Dodge.LevelGen.Switch import Dodge.Placement.Instance import Dodge.Placement.Instance.Analyser import Dodge.Room.Foreground +import Dodge.Room.Path import Dodge.RoomLink import Geometry import Picture @@ -30,6 +29,11 @@ airlock = join $ takeOne [return airlock0, return airlock90, return airlockCrystal, airlockZ] +xSwitch :: PSType +xSwitch = PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect + where + col = dim $ dim $ bright red + decontamRoom :: Int -> Room decontamRoom i = defaultRoom @@ -37,7 +41,7 @@ decontamRoom i = & rmLinks .~ muout lnks ++ muin [last lnks] & rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)] & rmPmnts - .~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $ + .~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) xSwitch $ \btid -> Just $ putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $ \_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2 @@ -68,7 +72,6 @@ decontamRoom i = [ (V2 20 95, 0) , (V2 20 5, pi) ] - col = dim $ dim $ bright red -- | Straight airlock airlock0 :: Room @@ -78,7 +81,7 @@ airlock0 = , _rmLinks = muout lnks ++ muin [last lnks] , _rmPath = foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)] , _rmPmnts = - [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $ + [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) xSwitch $ \btid -> Just $ putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $ \_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2 @@ -94,7 +97,6 @@ airlock0 = [ (V2 20 95, 0) , (V2 20 5, pi) ] - col = dim $ dim $ bright red airlockDoubleDoor :: WdBl -> @@ -112,61 +114,62 @@ putDoor :: WdBl -> Float -> Point2A -> Point2A -> PSType putDoor cond l p1 p2 = PutDoor dr wl where wl = defaultDoorWall - dr = defaultDoor - & drTrigger .~ cond - & drUpdate .~ DoorLerp 0.01 - & drZeroPos .~ p1 - & drOnePos .~ p2 - & drFootPrint .~ IM.fromList (zip [0..] $ wlps') + dr = + defaultDoor + & drTrigger .~ cond + & drUpdate .~ DoorLerp 0.01 + & drZeroPos .~ p1 + & drOnePos .~ p2 + & drFootPrint .~ IM.fromList (zip [0 ..] wlps') wlps' = rectanglePairs 9 0 (V2 l 0) airlockSimple :: RandomGen g => State g Room airlockSimple = do - light1 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp - light2 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp - return $ defaultRoom - { _rmPolys = - [rectNSWE 120 0 0 180] - , _rmLinks = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks] - , _rmPath = foldMap (doublePairSet . (V2 90 30,) . fst) lnks - , _rmPmnts = - [ light1,light2, - pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $ - \btid -> - airlockDoubleDoor - (WdBlBtOn btid) - 55 - (0, pi / 2) - (0, 0) - (V2 180 0, pi / 2) - (V2 180 0, pi) - -- outDoorps inDoorps - ] - , _rmBound = - [rectNSWE 120 0 0 180] - } + light1 <- mntLightLnkCond $ PS (V2 90 120) 0 + return $ + defaultRoom + { _rmPolys = [rectNSWE 120 0 0 180] + , _rmLinks = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks] + , _rmPath = foldMap (doublePairSet . (V2 90 30,) . fst) lnks + , _rmPmnts = + [ light1 + , pContID (PS (V2 90 115) pi) xSwitch $ + \btid -> + airlockDoubleDoor + (WdBlBtOn btid) + 55 + (0, pi / 2) + (0, 0) + (V2 180 0, pi) + (V2 180 0, pi / 2) + ] + , _rmBound = [rectNSWE 120 0 0 180] + } where lnks = [ (V2 0 30, pi / 2) , (V2 180 30, 1.5 * pi) ] - col = dim $ dim $ bright red airlockZ :: RandomGen g => State g Room airlockZ = do - let cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50) + let cenlight = + [ mntLS vShape (V2 90 60) (V3 90 40 50) + , mntLS vShape (V2 90 60) (V3 90 80 50) + ] cornlight = - mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50) - `addPlmnt` sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90))) + [ mntLS vShape (V2 0 120) (V3 30 90 50) + , mntLS vShape (V2 180 120) (V3 150 90 50) + , sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90))) + ] lighting <- takeOne [cenlight, cornlight] return defaultRoom - { _rmPolys = - [rectNSWE 120 0 0 180] + { _rmPolys = [rectNSWE 120 0 0 180] , _rmLinks = lnks , _rmPath = linksGridToPath' lnks $ loopPairs $ rectNSWE 100 40 40 140 , _rmPmnts = - [ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $ + [ pContID (PS (V2 90 115) pi) xSwitch $ \btid -> airlockDoubleDoor (WdBlBtOn btid) @@ -176,14 +179,12 @@ airlockZ = do (V2 180 60, - pi) (V2 180 60, - pi / 2) , sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall - , lighting ] - , _rmBound = - [rectNSWE 120 0 0 180] + <> lighting + , _rmBound = [rectNSWE 120 0 0 180] } where lnks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)] - col = dim $ dim $ bright red airlock90 :: Room airlock90 = @@ -200,36 +201,31 @@ airlock90 = , (100, 10) ] ] - , _rmLinks = muout [(V2 0 40, pi / 2)] ++ muin [(V2 40 0, pi)] - , _rmPath = doublePairSet (V2 0 40, V2 40 0) + , _rmLinks = lnks + , _rmPath = linksGridToPath' lnks $ doublePairSet (V2 40 40, V2 80 80) , _rmPmnts = [ pContID (PS (V2 120 120) (3 * pi / 4)) - (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) + xSwitch $ \btid -> jsps (V2 5 5) 0 $ putDoor (WdBlBtOn btid) l1 x1 y1 , mntLS vShape (V2 35 35) (V3 70 70 50) ] , _rmBound = - [ map - toV2 - [ (10, 10) - , (10, 100) - , (100, 150) - , (150, 100) - , (100, 10) + pure + [ V2 10 10 + , V2 10 100 + , V2 100 150 + , V2 150 100 + , V2 100 10 ] - ] , _rmName = "airlock90" } where - --cond w = or $ M.lookup (DoorNumOpen n) (_worldState w) - col = dim $ dim $ bright red + lnks = muout [(V2 0 40, pi / 2)] ++ muin [(V2 40 0, pi)] l1 = 55 y1 = (0, 0) x1 = (0, pi / 2) --- pss = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 0 55) - airlockCrystal :: Room airlockCrystal = defaultRoom @@ -239,7 +235,7 @@ airlockCrystal = , _rmPmnts = [ pContID (PS (V2 145 70) (pi / 2)) - (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) + xSwitch $ \btid -> jsps (V2 40 70) 0 $ putDoor (WdBlBtOn btid) l1 x1 y1 , crystalLine (V2 0 70) (V2 40 70) , mntLS vShape (V2 150 70) (V3 110 70 70) @@ -248,14 +244,6 @@ airlockCrystal = } where switchcutout = orderPolygon $ map toV2 [(39, 20), (150, 60), (150, 80), (39, 120)] - col = dim $ dim $ bright red l1 = 55 x1 = (0, pi / 2) y1 = (V2 0 (-55), pi / 2) - ---pss :: [(Point2, Point2)] ---pss = --- reverse $ --- fmap --- ((\x -> (V2 50 (x - 10), V2 50 (x + 60))) . fromIntegral) --- [20 :: Int, 22 .. 70] diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 4398ee18f..6997c69bf 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -132,19 +132,17 @@ addButtonSlowDoor x h rm = do .++~ [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)] -- TODO make the height of this light source and of other mounted lights -- be taken from a single consistent source - --thewall = switchWallCol red - thewall = defaultDoorWall butDoor = putLitButOnPos col (rprBool (isUnusedLnkType InLink)) $ \btplmnt -> Just $ putDoubleDoorThen - thewall + defaultDoorWall (WdBlBtOn $ fromJust $ _plMID btplmnt) 30 (V2 0 h) (V2 x h) - 2 + 0.5 $ \dr1 dr2 -> amountedlight dr1 50 $ amountedlight dr1 (-50) $ diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index 67f9d3c5d..7a07732a5 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/src/Dodge/Room/Tutorial.hs @@ -45,6 +45,11 @@ tutAnoTree = do foldMTRS [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox , corDoor + , return $ tToBTree "cor" $ return $ cleatOnward corridor + , return $ tToBTree "cor" $ return $ cleatOnward airlock90 + , return $ tToBTree "cor" $ return $ cleatOnward corridor + , return $ tToBTree "cor" $ return $ cleatOnward airlock0 + , return $ tToBTree "cor" $ return $ cleatOnward corridor , tToBTree "x" . return . cleatOnward <$> airlockSimple -- , tToBTree "lastun" . return . cleatOnward <$> tanksRoom [] [] -- , return $ tToBTree "cor" $ return $ cleatOnward corridor diff --git a/src/Dodge/Update/WallDamage.hs b/src/Dodge/Update/WallDamage.hs index f0d3f36ba..01ef2a1d6 100644 --- a/src/Dodge/Update/WallDamage.hs +++ b/src/Dodge/Update/WallDamage.hs @@ -39,5 +39,5 @@ updateEdgeWallObs w (i, j) = fromMaybe w $ do let wlflags = foldMap (^. _2 . to getWallPathing) $ wlsHitUnsorted s e w return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i, j) where - f x y = (S.map WallObstacle x) `S.union` + f x y = S.map WallObstacle x `S.union` (y S.\\ (S.fromList $ map WallObstacle [minBound..maxBound]))