Room with doors and central ledge terminal
This commit is contained in:
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)]
|
||||
|
||||
|
||||
Reference in New Issue
Block a user