140 lines
4.7 KiB
Haskell
140 lines
4.7 KiB
Haskell
module Dodge.Room.RezBox where
|
|
|
|
import qualified Data.Set as S
|
|
import Dodge.Cleat
|
|
import Dodge.Data.GenWorld
|
|
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.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]
|
|
& restrictInLinks (\(V2 _ h, _) -> h < 1)
|
|
& restrictOutLinks (\(V2 _ h, _) -> h > 59)
|
|
& rmName .~ "rezBox"
|
|
|
|
rezBox' :: RandomGen g => State g (MetaTree Room String)
|
|
rezBox' = do
|
|
col <- rezColor
|
|
return $
|
|
tToBTree "rezBox'" $
|
|
treePost
|
|
[ roomRect 40 60 1 1
|
|
& rmPmnts .~ [sPS (V2 20 1) 0 $ PutLS col]
|
|
& restrictInLinks (\(V2 _ h, _) -> h < 1)
|
|
& restrictOutLinks (\(V2 _ h, _) -> h > 59)
|
|
& rmName .~ "rezBox"
|
|
, 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
|
|
let centralRoom = (roomRectAutoLinks w h){_rmPmnts = []}
|
|
onwardpassage <-
|
|
over root (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage
|
|
let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _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 $ lsPosColRad (V3 0 0 h) col 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
|