154 lines
5.0 KiB
Haskell
154 lines
5.0 KiB
Haskell
module Dodge.Room.RezBox (
|
|
rezBox,
|
|
rezBoxesWpCrit,
|
|
rezColor,
|
|
rezBoxes,
|
|
rezBox',
|
|
) where
|
|
|
|
import Control.Monad
|
|
import qualified Data.Set as S
|
|
import Dodge.Cleat
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Terminal
|
|
import Dodge.Item.Random
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.LightSource
|
|
import Dodge.Placement.Instance
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Procedural
|
|
import Dodge.Room.RoadBlock
|
|
import Dodge.RoomLink
|
|
import Dodge.Terminal
|
|
import Dodge.Tree
|
|
import Geometry
|
|
import LensHelp
|
|
import Padding
|
|
import RandomHelp
|
|
|
|
rezBox :: LightSource -> Room
|
|
rezBox ls =
|
|
roomRect 40 60 1 1
|
|
& rmPmnts
|
|
.~ [ sPS (V2 20 1) 0 $ PutLS ls
|
|
, putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ makeTermPara s <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdDeactivateTerminal)
|
|
& plSpot .~ PS (V2 20 0) 0
|
|
]
|
|
& restrictInLinks (\(V2 _ h, _) -> h < 1)
|
|
& restrictOutLinks (\(V2 _ h, _) -> h > 59)
|
|
& rmName .~ "rezBox"
|
|
where
|
|
s = "RESPAWN POINT SET AT THIS LOCATION."
|
|
|
|
|
|
rezBox' :: RandomGen g => State g (MetaTree Room String)
|
|
rezBox' = do
|
|
col <- rezColor
|
|
return $
|
|
tToBTree "rezBox'" $
|
|
treePost
|
|
[ rezBox col
|
|
, cleatOnward door
|
|
]
|
|
|
|
--rezBoxesWp :: RandomGen g => State g (Tree Room)
|
|
--rezBoxesWp = do
|
|
-- w <- state $ randomR (100, 400)
|
|
-- h <- state $ randomR (40, 40)
|
|
-- theweapon <- randBlockBreakWeapon
|
|
-- thecol <- rezColor
|
|
-- let aroom = rezInvBox thecol -- & rmConnectsTo .~ S.singleton (OnEdge North)
|
|
-- let isnorth = S.member (OnEdge North) . _rlType
|
|
-- centralRoom <-
|
|
-- shuffleLinks $
|
|
-- (roomRectAutoLinks w h){_rmPmnts = []}
|
|
-- & rmLinks %~ setLinkType InLink isnorth
|
|
-- onwardpassage <- shootOutPassage
|
|
-- let n = length $ getLinksOfType (OnEdge North) $ _rmLinks centralRoom
|
|
-- let rezrooms =
|
|
-- map adddoor $
|
|
-- wpAdd theweapon aroom : replicate (n -2) aroom
|
|
-- return $
|
|
-- treeFromTrunk [rezBox thecol, door] $
|
|
-- Node centralRoom (rezrooms ++ [onwardpassage])
|
|
-- where
|
|
-- adddoor rm = treeFromPost [connectsToNorth door] rm
|
|
-- connectsToNorth = rmConnectsTo .~ S.member (OnEdge North)
|
|
|
|
maybeBlockedPassage :: RandomGen g => State g (Tree Room)
|
|
maybeBlockedPassage =
|
|
fmap (pure . cleatOnward) $
|
|
join $ takeOne [return corridor, blockedCorridorCloseBlocks]
|
|
|
|
--shootOutPassage :: RandomGen g => State g (Tree Room)
|
|
--shootOutPassage =
|
|
-- fmap (pure . cleatOnward) $
|
|
-- join $ takeOne [blockedCorridorCloseBlocks]
|
|
|
|
rezBoxesWpCrit :: RandomGen g => State g (Tree Room)
|
|
rezBoxesWpCrit = do
|
|
w <- state $ randomR (200, 400)
|
|
h <- state $ randomR (40, 40)
|
|
thecol <- rezColor
|
|
theweapon <- randBlockBreakWeapon
|
|
let bottomEdgeTest (V2 _ y, _) = y < 1
|
|
aroom = rezInvBox thecol
|
|
centralRoom <- roomRectAutoLinks w h <&> rmPmnts .~ []
|
|
onwardpassage <-
|
|
over root (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage
|
|
let n = length $ filter bottomEdgeTest $ map (\rl -> (rl ^. rlPos, rl ^. rlDir))
|
|
$ _rmLinks centralRoom
|
|
i <- state $ randomR (0, n -3)
|
|
j <- state $ randomR (i, n -2)
|
|
let rezrooms =
|
|
map adddoor $
|
|
insertAt i (wpAdd theweapon aroom) $
|
|
insertAt j (crAdd aroom) $
|
|
replicate (n -3) aroom
|
|
return $
|
|
treeFromTrunk [rezBox thecol, door] $
|
|
Node centralRoom (rezrooms ++ [onwardpassage])
|
|
where
|
|
adddoor rm = treeFromPost [door & rmConnectsTo .~ S.member (OnEdge North)] rm
|
|
|
|
crAdd :: Room -> Room
|
|
crAdd = rmPmnts .:~ sPS (V2 20 10) (0.5 * pi) randC1
|
|
|
|
rezBoxes :: RandomGen g => State g (MetaTree Room String)
|
|
rezBoxes = do
|
|
w <- state $ randomR (100, 400)
|
|
h <- state $ randomR (40, 40)
|
|
thecol <- rezColor
|
|
let bottomEdgeTest = S.member (OnEdge South) . _rlType
|
|
dbox =
|
|
treeFromPost
|
|
[door & rmConnectsTo .~ S.member (OnEdge South)]
|
|
(rezInvBox thecol)
|
|
centralRoom <-
|
|
shuffleLinks =<< (roomRectAutoLinks w h <&> rmPmnts .~ []
|
|
<&> rmLinks %~ setInLinks bottomEdgeTest)
|
|
let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
|
|
return
|
|
. tToBTree "rezBoxes"
|
|
. treeFromTrunk [rezBox thecol, door]
|
|
$ Node centralRoom (replicate (n -1) dbox ++ [Node (cleatOnward door) []])
|
|
|
|
rezColor :: RandomGen g => State g LightSource
|
|
rezColor = do
|
|
col <- takeOne [V3 0.0 0.1 0.5, V3 0.0 0.5 0.1]
|
|
h <- takeOne [30, 50, 80, 90, 90, 90, 90]
|
|
rad <- takeOne [150, 200, 200, 250, 250, 300, 300, 300]
|
|
return $ lsColPosRad col (V3 0 0 h) rad
|
|
|
|
rezInvBox :: LightSource -> Room
|
|
rezInvBox = swapInOutLinks . rezBox
|
|
|
|
wpAdd :: Item -> Room -> Room
|
|
wpAdd wp = rmPmnts %~ f
|
|
where
|
|
f (x : xs) = sPS (V2 15 30) 1 (PutFlIt wp) : g x : xs
|
|
f _ = [sPS (V2 15 30) 1 (PutFlIt wp)]
|
|
g x = x & plIDCont .~ const flickerMod
|