Improve wall crushing

This commit is contained in:
2026-03-28 21:43:06 +00:00
parent 2db4e9bc6e
commit 08fcc4baab
12 changed files with 176 additions and 106 deletions
+43 -24
View File
@@ -148,18 +148,23 @@ slowCrushRoom = do
& rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
, spanLightI (V2 220 60) (V2 185 100)
]
crs <- takeOne [[]
, [sPS (V2 200 10) (0.8* pi) randC1]
, [sPS (V2 200 10) (0.8* pi) randC1 , sPS (V2 210 20) (0.8* pi) randC1]
, [sPS (V2 200 80) pi randC1]
, [sPS (V2 200 80) pi randC1 , sPS (V2 210 90) pi randC1]
]
return $ rm'
& rmBound .:~ rectNSWE 0 (-50) 0 220
& rmLinks %~ setOutLinks (\rl -> onside East $ rl ^. rlType)
& rmLinks %~ setInLinks (\rl -> onside West $ rl ^. rlType)
& rmPmnts .:~
(ps0 (PutTrigger False) $ \i -> Just $
& rmPmnts <>~
[ps0 (PutTrigger False) $ \i -> Just $
pContID (apos West) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
pContID (apos East) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
)
] <> crs
where
onside x s = (OnEdge x `S.member` s)
|| (OnEdge South `S.member` s && FromEdge x 0 `S.member` s)
@@ -180,36 +185,50 @@ slowCrushRoom = do
UnusedLink s -> onside edge s
_ -> False
slowCrushRoom' :: RandomGen g => State g Room
slowCrushRoom' = do
rm <- shuffleLinks =<< roomRectAutoLights 200 100
slowCrush90 :: RandomGen g => State g Room
slowCrush90 = do
rm <- shuffleLinks =<< roomRectAutoLights 170 100
(ilinks, olinks) <- shufflePair (cornlinks,onside West)
let rm' = removeLights rm
& rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
, spanLightI (V2 200 60) (V2 165 100)
, spanLightL (V2 120 39) (V2 170 39) (V2 120 0)
]
crs <- takeOne [[] ]
return $ rm'
& rmLinks %~ setOutLinksByType (OnEdge East)
& 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 $
& rmBound <>~ [rectNSWE 0 (-55) 0 110
, rectNSWE 100 40 170 220
]
& rmLinks %~ setOutLinks (\rl -> olinks $ rl ^. rlType)
& rmLinks %~ setInLinks (\rl -> ilinks $ rl ^. rlType)
& rmPmnts <>~
[ps0 (PutTrigger False) $ \i -> Just $
pContID (spos ilinks) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
pContID (spos olinks) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
)
] <> crs
where
onside x s = (OnEdge x `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)
cornlinks s =
(OnEdge South `S.member` s && FromEdge East 0 `S.member` s)
|| (OnEdge East `S.member` s && FromEdge South 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))
& drZeroPos .~ (V2 75 (-5), 0)
& drOnePos .~ (V2 75 50, 0)
& drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 34 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
& drOnePos .~ (V2 190 70, 0)
& drZeroPos .~ (V2 140 70, 0)
& drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 30 29))
f ps = case ps of
PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5))
_ -> ps
spos h = (rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f)
t' h rp _ = case _rpType rp of
UnusedLink s -> h s
_ -> False
slowDoorRoom :: RandomGen g => State g Room
+1 -1
View File
@@ -55,7 +55,7 @@ tutAnoTree = do
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor
, tToBTree "slowCrush" . return . cleatOnward <$> slowCrushRoom
, tToBTree "slowCrush" . return . cleatOnward <$> slowCrush90
, corDoor
, chasmSpitTerminal
--a , return $ tToBTree "cor" $ return $ cleatOnward corridor