justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Implement different door speeds

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