Remove requirement for external door ids

This commit is contained in:
2021-09-30 15:52:01 +01:00
parent c88f88004d
commit cb23960bd7
3 changed files with 15 additions and 16 deletions
+2 -2
View File
@@ -70,8 +70,8 @@ initialRoomTree = do
---- ] ---- ]
---- ,[Corridor] ---- ,[Corridor]
---- ,[Corridor] ---- ,[Corridor]
-- --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers 30] -- --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers]
,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 30 80 200 40)] ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
,[Corridor] ,[Corridor]
,[DoorAno] ,[DoorAno]
,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit 50] ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit 50]
+3
View File
@@ -6,5 +6,8 @@ import Dodge.LevelGen.Data
jsps0 :: PSType -> Maybe Placement jsps0 :: PSType -> Maybe Placement
jsps0 pst = Just $ sPS (V2 0 0) 0 pst jsps0 pst = Just $ sPS (V2 0 0) 0 pst
jspsJ :: PSType -> Placement -> Maybe Placement
jspsJ pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm
place0 :: PSType -> (Int -> Maybe Placement) -> Placement place0 :: PSType -> (Int -> Maybe Placement) -> Placement
place0 pst = Placement (PS (V2 0 0) 0 pst) place0 pst = Placement (PS (V2 0 0) 0 pst)
+10 -14
View File
@@ -24,16 +24,14 @@ import System.Random
import Control.Lens import Control.Lens
import Control.Monad.State import Control.Monad.State
import Data.Tree import Data.Tree
import qualified Data.Map as M
import qualified Data.IntMap as IM import qualified Data.IntMap as IM
twinSlowDoorRoom twinSlowDoorRoom
:: Int -- ^ Door id :: Float -- ^ Half width
-> Float -- ^ Half width
-> Float -- ^ Half height -> Float -- ^ Half height
-> Float -- ^ Inner width -> Float -- ^ Inner width
-> Room -> Room
twinSlowDoorRoom drid w h x = defaultRoom twinSlowDoorRoom w h x = defaultRoom
{ _rmPolys = ps { _rmPolys = ps
, _rmLinks = , _rmLinks =
[ (V2 w (h/2) , negate $ pi/2) [ (V2 w (h/2) , negate $ pi/2)
@@ -42,11 +40,9 @@ twinSlowDoorRoom drid w h x = defaultRoom
] ]
, _rmPath = [] , _rmPath = []
, _rmPS = , _rmPS =
[ sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 x 1) (V2 x h) 1 [ Placement (PS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red id id)
, sPS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red $ \btid -> jspsJ (PutSingleDoor col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
(worldState %~ M.insert (DoorNumOpen drid) True ) $ place0 (PutSingleDoor col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
(worldState %~ M.insert (DoorNumOpen drid) False)
, place0 (PutSingleDoor col cond (V2 (-x) 1) (V2 (-x) h) 1)
$ \did -> Just $ place0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0)) $ \did -> Just $ place0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
$ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight $ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
] ]
@@ -54,6 +50,7 @@ twinSlowDoorRoom drid w h x = defaultRoom
, _rmName = "twinSlowDoorRoom" , _rmName = "twinSlowDoorRoom"
} }
where where
wlSpeed = 0.5
addColorChange lsid drid' = over pjUpdate $ chain $ const f addColorChange lsid drid' = over pjUpdate $ chain $ const f
where where
f w' | _drStatus (_doors w' IM.! drid') == DoorHalfway f w' | _drStatus (_doors w' IM.! drid') == DoorHalfway
@@ -65,19 +62,18 @@ twinSlowDoorRoom drid w h x = defaultRoom
[rectNSWE h 0 (-w) w [rectNSWE h 0 (-w) w
,rectNSWE 20 (-h) (negate x) x ,rectNSWE 20 (-h) (negate x) x
] ]
cond w' = or $ M.lookup (DoorNumOpen drid) (_worldState w') cond' btid w' = (_btState $ _buttons w' IM.! btid) == BtOn
col = dim $ dim $ bright red col = dim $ dim $ bright red
twinSlowDoorChasers twinSlowDoorChasers
:: RandomGen g :: RandomGen g
=> Int -- ^ Door id => State g Room
-> State g Room twinSlowDoorChasers = do
twinSlowDoorChasers drid = do
let lps = V2 (-65) <$> [20,40 .. 180] let lps = V2 (-65) <$> [20,40 .. 180]
rps = V2 65 <$> [20,40 .. 180] rps = V2 65 <$> [20,40 .. 180]
ps <- takeN 4 $ lps ++ rps ps <- takeN 4 $ lps ++ rps
let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++) return $ twinSlowDoorRoom 80 200 40 & rmPS %~ (plmnts ++)
slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room)) slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
slowDoorRoom = do slowDoorRoom = do