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

Add variations to slowCrushRoom

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