Room with doors and central ledge terminal

This commit is contained in:
2026-02-01 22:23:06 +00:00
parent a6976eae8d
commit f3aaf8ba57
7 changed files with 286 additions and 148 deletions
+6
View File
@@ -14,6 +14,7 @@ module Dodge.PlacementSpot (
isUnusedLnk,
isInLnk,
isOutLnk,
isOutLnkNum,
unusedSpotNearInLink,
randDirPS,
unusedSpotAwayFromInLink,
@@ -169,6 +170,11 @@ isOutLnk rp = case _rpType rp of
UsedOutLink{} -> null $ _rpPlacementUse rp
_ -> False
isOutLnkNum :: Int -> RoomPos -> Bool
isOutLnkNum i rp = case _rpType rp of
UsedOutLink{_rplsChildNum = j} | j == i -> null $ _rpPlacementUse rp
_ -> False
useUnusedLnk :: PlacementSpot
useUnusedLnk = rprBool isUnusedLnk
+4
View File
@@ -32,6 +32,10 @@ corridor =
poly = rectNSWE 80 0 0 40
lnks' =
[ outLink (V2 20 70) 0
, outLink (V2 20 70) (pi / 3)
, outLink (V2 20 70) (negate $ pi / 3)
, outLink (V2 20 70) (pi / 4)
, outLink (V2 20 70) (negate $ pi / 4)
, outLink (V2 20 70) (pi / 6)
, outLink (V2 20 70) (negate $ pi / 6)
, inLink (V2 20 10) pi
+5
View File
@@ -11,6 +11,7 @@ module Dodge.Room.Room (
weaponBehindPillar,
critsRoom,
distributerRoom,
critDeadEnd,
) where
import Linear
@@ -251,6 +252,10 @@ weaponLongCorridor = do
critInDeadEnd :: Room
critInDeadEnd = deadEndRoom & rmPmnts .~ [sPS (V2 0 0) 0 randC1]
-- this one should face the inlink door
critDeadEnd :: Room
critDeadEnd = deadEndRoom & rmPmnts .~ [sPS (V2 0 0) (pi/2) randC1]
deadEndRoom :: Room
deadEndRoom =
defaultRoom
+98 -4
View File
@@ -1,6 +1,7 @@
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.Room.Tutorial where
import Dodge.Room.Room
import Dodge.Data.AmmoType
import Dodge.Room.Path
import Dodge.Room.Pillar
@@ -49,7 +50,7 @@ tutAnoTree = do
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
, tToBTree "sdr" . return . cleatOnward <$>
(shuffleLinks =<< distributerRoom BulletAmmo 100000)
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
@@ -67,6 +68,7 @@ tutAnoTree = do
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "door" $ return $ cleatOnward door
, tutHub
, chasmSpitTerminal
, tutLight
, tutDrop
, return $ tToBTree "cor" $ return $ cleatOnward corridor
@@ -179,7 +181,99 @@ midChasm = do
return
[sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
-- dia x y = [sps0 $ PutChasm [V2 ]
midChasmPlatform :: State LayoutVars Room
midChasmPlatform = do
x <- state $ randomR (250, 300)
y <- state $ randomR (250, 300)
r <- roomRectAutoLinks x y
cs <- join $ takeOne [censquare x y]
shuffleLinks $
r
& rmLinks %~ setOutLinks (isMidEdgeLink r North)
& rmLinks %~ setInLinks (isMidEdgeLink r South)
& rmPmnts <>~ cs
where
censquare x y = do
z <- state $ randomR (40, 60)
let (chsms,clfs) = sqPlatformChasm 20 (min x y/2 - z)
--return [sps0 $ putConvexChasm (rectNSWE (y - z) z z (x - z))]
return [sps0 $ PutChasm
(fmap (fmap (+ V2 (x/2) (y/2))) chsms)
(fmap (fmap (+ V2 (x/2) (y/2))) clfs)
]-- (rectNSWE (y - z) z z (x - z))]
-- cenoct x y =
-- return
-- [sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
sqPlatformChasm :: Float -> Float -> ([[Point2]],[[Point2]])
sqPlatformChasm b a =
( [[ibr,obr,otr,itr],[itr,otr,otl,itl],[itl,otl,obl,ibl],[ibl,obl,obr,ibr]]
, [[obr,otr,otl,obl], [ibr,ibl, itl, itr]]
)
where
obr = V2 a (-a)
obl = V2 (-a) (-a)
otl = V2 (-a) a
otr = V2 a a
ibr = V2 b (-b)
ibl = V2 (-b) (-b)
itl = V2 (-b) b
itr = V2 b b
sqSpitChasm :: Float -> Float -> ([[Point2]],[[Point2]])
sqSpitChasm b a =
( [[ibr,obr,otr,itr],[itr,otr,otl,itl],[itl,otl,obl,ibl]]
, [[ibr,obr,otr,otl,obl,ibl,itl,itr]]
)
where
obr = V2 a (-a)
obl = V2 (-a) (-a)
otl = V2 (-a) a
otr = V2 a a
ibr = V2 b (-a)
ibl = V2 (-b) (-a)
itl = V2 (-b) b
itr = V2 b b
midChasmSpit :: State LayoutVars Room
midChasmSpit = do
let x = 300
y = 300
r <- roomRectAutoLinks x y
cs <- join $ takeOne [censquare x y]
shuffleLinks $
r
& rmLinks %~ setOutLinks
(\rl -> isMidEdgeLink r South rl
|| isMidEdgeLink r West rl
|| isMidEdgeLink r East rl
)
& rmLinks %~ setInLinks (isMidEdgeLink r South)
& rmPmnts <>~ cs
where
censquare x y = do
z <- state $ randomR (40, 60)
let (chsms,clfs) = sqSpitChasm 20 (min x y/2 - z)
return [sps0 $ PutChasm
(fmap (fmap (+ V2 (x/2) (y/2))) chsms)
(fmap (fmap (+ V2 (x/2) (y/2))) clfs)
]-- (rectNSWE (y - z) z z (x - z))]
-- cenoct x y =
-- return
-- [sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
chasmSpitTerminal :: State LayoutVars MTRS
chasmSpitTerminal = do
i1 <- nextLayoutInt
y <- midChasmSpit
l3 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnkNum 0 rp
l4 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnkNum 1 rp
let y' = y & rmPmnts <>~ [l3,l4]
return $ tToBTree "chasmTerm" $ Node (addDoorToggleTerminal' i1 (PS 150 0) y')
[treePost [triggerDoorRoom i1, critDeadEnd]
,treePost [triggerDoorRoom i1, critDeadEnd]
,return $ cleatOnward $ triggerDoorRoom i1
]
polyChasm :: Int -> Float -> State LayoutVars Room
polyChasm n x =
@@ -221,7 +315,7 @@ chasmSimpleMaze =
tutLight :: State LayoutVars (MetaTree Room String)
tutLight = do
x <- shuffleRoomPos =<< chasmSimpleMaze
y <- chasmSimpleMaze
y <- midChasmSpit
z <- chasmSimpleMaze
return $
tToBTree "TutLight" $
@@ -231,7 +325,7 @@ tutLight = do
,sps g (PutFlIt battery)
]
, corridor & rmPmnts .~ mempty
, removeLights y
, y
, corridor & rmPmnts .~ mempty
, removeLights z
, door
+13
View File
@@ -2,10 +2,12 @@
module Dodge.Room.Warning (
warningRooms,
addDoorToggleTerminal,
addDoorToggleTerminal',
addDoorAtNthLinkToggleTerminal,
addDoorAtNthLinkToggleInterrupt,
) where
import Dodge.LevelGen.PlacementHelper
import Dodge.Default
import Color
import Control.Monad
@@ -78,6 +80,17 @@ addDoorAtNthLinkToggleTerminal j xs i =
[("DOOR", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))
]
addDoorToggleTerminal' :: Int -> PlacementSpot -> Room -> Room
addDoorToggleTerminal' i pspot rm = rm
& rmPmnts .:~ (pmnt & plExternalID ?~ i)
where
pmnt = ptCont (PutTrigger False) $ \pl -> Just $ putMessageTerminal (
lineOutputTerminal []
& tmToggles
.~ M.fromList
[("DOOR", TerminalToggle (fromJust $ _plMID pl) (BlConst True))
]) & plSpot .~ pspot
addWarningTerminal :: String -> Int -> Room -> Room
addWarningTerminal str =
addDoorToggleTerminal
+8
View File
@@ -19,6 +19,14 @@ rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n]
rectWH :: Float -> Float -> [Point2]
rectWH w h = rectNSWE h (- h) (- w) w
trapTBH :: Float -> Float -> Float -> [Point2]
trapTBH t b h =
[ V2 (-b) (-h)
, V2 b (-h)
, V2 t h
, V2 (-t) h
]
isotriBWH :: Point2 -> Float -> Float -> [Point2]
isotriBWH (V2 x y) w h = [V2 (x - w) y, V2 (x + w) y, V2 x (y + h)]