145 lines
5.2 KiB
Haskell
145 lines
5.2 KiB
Haskell
module Dodge.Room.RezBox where
|
|
import Dodge.LevelGen.Data
|
|
--import Dodge.PlacementSpot
|
|
--import Dodge.Room.RunPast
|
|
import Dodge.RoomLink
|
|
import Dodge.LightSource
|
|
--import Dodge.Room.LasTurret
|
|
import Dodge.Data
|
|
import Dodge.Default
|
|
--import Dodge.RoomLink
|
|
import Dodge.Tree
|
|
import Dodge.RandomHelp
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Corridor
|
|
--import Dodge.Room.Room
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Procedural
|
|
--import Dodge.Room.Foreground
|
|
import Dodge.Room.RoadBlock
|
|
import Dodge.Placement.Instance
|
|
import Dodge.Item.Random
|
|
--import Dodge.Item.Weapon.BulletGuns
|
|
--import Dodge.Item.Weapon.Utility
|
|
--import Dodge.LevelGen.Data
|
|
--import Geometry.Data
|
|
import Geometry
|
|
import Padding
|
|
--import Color
|
|
--import Shape
|
|
|
|
import qualified Data.Set as S
|
|
--import Data.Maybe
|
|
import Data.Tree
|
|
import Control.Monad.State
|
|
import Control.Lens
|
|
import System.Random
|
|
|
|
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)
|
|
|
|
rezBoxesWp :: RandomGen g => State g (SubCompTree 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 <- maybeBlockedPassage
|
|
let n = length $ getLinksOfType (OnEdge North) $ _rmLinks centralRoom
|
|
let rezrooms = map adddoor
|
|
$ wpAdd theweapon aroom : replicate (n-2) aroom
|
|
return $ treeFromTrunk [PassDown $ rezBox thecol
|
|
, PassDown door
|
|
]
|
|
(Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
|
|
where
|
|
adddoor rm = treeFromPost [PassDown $ connectsToNorth door ] (PassDown rm)
|
|
connectsToNorth = rmConnectsTo .~ S.singleton (OnEdge North)
|
|
maybeBlockedPassage :: RandomGen g => State g (SubCompTree Room)
|
|
maybeBlockedPassage = fmap singleUseAll $ join $ takeOne [return corridor, blockedCorridorCloseBlocks]
|
|
rezBoxesWpCrit :: RandomGen g => State g (SubCompTree Room)
|
|
rezBoxesWpCrit = do
|
|
w <- state $ randomR (200,400)
|
|
h <- state $ randomR (40,40)
|
|
thecol <- rezColor
|
|
theweapon <- randBlockBreakWeapon
|
|
--horedge <- takeOne [OnEdge North,OnEdge South]
|
|
let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
|
|
onwardpassage <-
|
|
applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West)) <$> maybeBlockedPassage
|
|
let bottomEdgeTest (V2 _ y,_) = y < 1
|
|
aroom = rezInvBox thecol
|
|
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 [PassDown $ rezBox thecol
|
|
, PassDown door
|
|
]
|
|
(Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
|
|
where
|
|
adddoor rm = treeFromPost [PassDown door] (PassDown rm)
|
|
|
|
crAdd :: Room -> Room
|
|
crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :)
|
|
|
|
corridorLRbranches :: RandomGen g => State g (SubCompTree Room)
|
|
corridorLRbranches = do
|
|
w <- state $ randomR (100,400)
|
|
h <- state $ randomR (40,40)
|
|
thecol <- rezColor
|
|
let bottomEdgeTest (V2 _ y,_) = y < 1
|
|
dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
|
|
centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest
|
|
((roomRectAutoLinks w h) {_rmPmnts = []})
|
|
let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom
|
|
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
|
|
return $ treeFromTrunk [PassDown $ rezBox thecol
|
|
, PassDown door
|
|
]
|
|
(Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
|
|
|
|
rezBoxes :: RandomGen g => State g (SubCompTree Room)
|
|
rezBoxes = do
|
|
w <- state $ randomR (100,400)
|
|
h <- state $ randomR (40,40)
|
|
thecol <- rezColor
|
|
let bottomEdgeTest (V2 _ y,_) = y < 1
|
|
dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
|
|
centralRoom <- shuffleLinks $ setInLinksPD bottomEdgeTest
|
|
((roomRectAutoLinks w h) {_rmPmnts = []})
|
|
let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom
|
|
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
|
|
return $ treeFromTrunk [PassDown $ rezBox thecol
|
|
, PassDown door
|
|
]
|
|
(Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll 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 .~ flickerMod
|