Work on crush rooms

This commit is contained in:
2026-03-27 10:36:48 +00:00
parent ac09ed6629
commit da87e1bccd
2 changed files with 87 additions and 47 deletions
+36 -1
View File
@@ -3,6 +3,7 @@
-- | Rooms containing long doors, probably with a big reveal behind them.
module Dodge.Room.LongDoor where
import Dodge.Base.CardinalPoint
import Dodge.Room.Modify
import qualified Data.IntMap.Strict as IM
import Dodge.Default
@@ -143,6 +144,40 @@ makeDumbSwitch i = defaultButton & btEvent .~ ButtonDumbSwitch i
slowCrushRoom :: RandomGen g => State g Room
slowCrushRoom = do
rm <- shuffleLinks =<< roomRectAutoLights 200 100
let rm' = removeLights rm
& rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
, spanLightI (V2 200 60) (V2 165 100)
]
return $ rm'
& rmLinks %~ setOutLinks (\rl -> blcorner $ rl ^. rlType)
& rmLinks %~ setInLinksByType (OnEdge West)
& rmPmnts .:~
(ps0 (PutTrigger False) $ \i -> Just $
pContID (apos West 5) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
pContID (apos East (-5)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
)
where
blcorner s = (OnEdge East `S.member` s && FromEdge South 0 `S.member` s)
|| (OnEdge South `S.member` s && FromEdge East 0 `S.member` s)
dr = defaultDoor
& drUpdate .~ DoorLerp 0.01
& drZeroPos .~ (V2 65 (-40), 0)
& drOnePos .~ (V2 65 50, 0)
& drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 35 50))
dr1 = dr
& drOnePos .~ (V2 135 (-40), 0)
& drZeroPos .~ (V2 135 50, 0)
apos edge x = (rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ (psRot +~ pi) . (psPos +~ V2 x 0))
t edge rp _ = case _rpType rp of
UnusedLink s -> OnEdge edge `S.member` s
_ -> False
slowCrushRoom' :: RandomGen g => State g Room
slowCrushRoom' = do
rm <- shuffleLinks =<< roomRectAutoLights 200 100
let rm' = removeLights rm
& rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
@@ -168,7 +203,7 @@ slowCrushRoom = do
dr1 = dr
& drOnePos .~ (V2 135 (-40), 0)
& drZeroPos .~ (V2 135 50, 0)
apos edge x = (rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ (psRot +~ pi) . (psPos +~ V2 x 0))
apos edge x = (rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ (psRot +~ pi) . (psPos +~ 5 *^ cardVec edge))
t edge rp _ = case _rpType rp of
UnusedLink s -> OnEdge edge `S.member` s
_ -> False