Add alcoves for switches in push room

This commit is contained in:
2026-03-29 19:48:31 +01:00
parent 00999f5921
commit 1919757fca
3 changed files with 110 additions and 76 deletions
+8 -1
View File
@@ -7,8 +7,15 @@ import Geometry
cardList :: [CardinalPoint]
cardList = [North, East, South, West]
cardReverse :: CardinalPoint -> CardinalPoint
cardReverse = \case
North -> South
South -> North
East -> West
West -> East
cardVec :: CardinalPoint -> Point2
cardVec cp = case cp of
cardVec = \case
North -> V2 0 1
South -> V2 0 (-1)
East -> V2 1 0
+35 -12
View File
@@ -1,8 +1,11 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
-- | Rooms containing long doors, probably with a big reveal behind them.
module Dodge.Room.LongDoor where
import Dodge.Placement.Instance.Block
import Dodge.Base.CardinalPoint
import Dodge.Room.Modify
import qualified Data.IntMap.Strict as IM
import Dodge.Default
@@ -189,28 +192,42 @@ slowCrushRoom = do
pushCaverns :: RandomGen g => State g Room
pushCaverns = do
rm <- shuffleLinks =<< removeLights <$> roomRectAutoLights 250 100
iside <- takeOne [North,South]
oside <- takeOne [North,South]
crs <- takeOne [[] ]
l <- takeOne
-- [ [MountedLight (V3 55 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 60 0])]
-- , [MountedLight (V3 20 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 22 0])]
[ [MountedLight (V3 30 45 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 45,V2 32 45])]
[ [MountedLight (V3 55 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 60 0])]
, [MountedLight (V3 20 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 22 0])]
, [MountedLight (V3 30 45 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 45,V2 32 45])]
, [MountedLight (V3 55 45 50) 200 0.5
, MountedSPic (noPic $ aBar 55 [V2 10 45,V2 60 45])
, MountedSPic (noPic $ aBar 55 [V2 10 (-45),V2 60 (-45)])]
]
return $ rm
& rmBound <>~ [
]
& rmLinks %~ setInLinks (\rl -> slinks West $ rl ^. rlType)
& rmLinks %~ setOutLinks (\rl -> slinks East $ rl ^. rlType)
& rmPolys <>~ [dorot iside (trapTBH 20 10 10) & each +~ V2 20 (g iside)
,dorot oside (trapTBH 20 10 10) & each +~ V2 230 (g oside)]
& rmBound .~
rectNSWE 100 0 (-10) 260:
[dorot iside (trapTBH 20 10 10) & each +~ V2 20 (g iside)
,dorot oside (trapTBH 20 10 10) & each +~ V2 230 (g oside)]
& rmLinks %~ setInLinks (\rl -> slinks West iside $ rl ^. rlType)
& rmLinks %~ setOutLinks (\rl -> slinks East oside $ rl ^. rlType)
& rmPmnts <>~
[ps0 (PutTrigger False) $ \i -> Just $
pContID (spos (slinks West)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
pContID (spos (slinks East)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
pContID (spos (slinks West $ cardReverse iside) f) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
pContID (spos (slinks East $ cardReverse oside) f) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
sps0 (PutDoor (dr & drTrigger .~ WdTrig i
& drMounts .~ l) defaultDoorWall) & plIDCont . mapped . mapped ?~
sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i
& drMounts .~ (l & each . moPos . _xy %~ rotateV pi)) defaultDoorWall)
, psPtPl (spos (slinks West $ cardReverse iside) f') (lowBlock Stone (greyN 0.5) 10 $ rectWH 20 10)
, psPtPl (spos (slinks East $ cardReverse oside) f') (lowBlock Stone (greyN 0.5) 10 $ rectWH 20 10)
] <> crs
where
slinks x s = (FromEdge x 0 `S.member` s)
dorot = \case
North -> id
_ -> fmap negate
slinks x y s = (FromEdge x 0 `S.member` s) && OnEdge y `S.member` s
dr = defaultDoor
& drUpdate .~ DoorLerp 0.005
& drZeroPos .~ (V2 (-5) 50, 0)
@@ -220,12 +237,18 @@ pushCaverns = do
& drOnePos .~ (V2 255 50, 0)
& drZeroPos .~ (V2 105 50, 0)
f ps = case ps of
PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5))
PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 5)
_ -> ps
spos h = (rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f)
f' ps = case ps of
PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 10)
_ -> ps
spos h f'' = (rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f'')
t' h rp _ = case _rpType rp of
UnusedLink s -> h s
_ -> False
g = \case
North -> 0
_ -> 100
slowCrush90 :: RandomGen g => State g Room