62 lines
2.2 KiB
Haskell
62 lines
2.2 KiB
Haskell
-- {-# LANGUAGE TupleSections #-}
|
|
module Dodge.Room.Containing where
|
|
|
|
import Control.Monad
|
|
import Dodge.Cleat
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Item.Display
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.PlacementSpot
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Ngon
|
|
import Dodge.Room.Pillar
|
|
import Dodge.Room.Procedural
|
|
import Dodge.Room.Tanks
|
|
import Dodge.Tree
|
|
import Geometry
|
|
import LensHelp
|
|
import RandomHelp
|
|
|
|
roomsContaining :: (RandomGen g) => [Creature] -> [Item] -> State g (MetaTree Room String)
|
|
roomsContaining crs its = tToBTree str <$> roomsContaining' crs its
|
|
where
|
|
str = "roomsContaining " ++ concatMap _crName crs ++ concatMap (head . basicItemDisplay) its
|
|
|
|
roomsContaining' :: (RandomGen g) => [Creature] -> [Item] -> State g (Tree Room)
|
|
roomsContaining' crs its = do
|
|
endroom <-
|
|
join $
|
|
takeOne
|
|
[ roomPillarsSquare <&> rmPmnts ++.~ crsItmsUnused crs its
|
|
, randomFourCornerRoomCrsIts crs its
|
|
, tanksRoom crs its
|
|
, tanksPipesRoom <&> rmPmnts ++.~ crsItmsUnused crs its
|
|
, roomPillarsContaining crs its
|
|
, roomPillarsPassage <&> rmPmnts ++.~ crsItmsUnused crs its
|
|
]
|
|
return (pure $ cleatOnward endroom)
|
|
|
|
roomPillarsContaining :: (RandomGen g) => [Creature] -> [Item] -> State g Room
|
|
roomPillarsContaining crs itms = do
|
|
(w, wn) <- takeOne [(240, 2), (340, 3)]
|
|
(h, hn) <- takeOne [(240, 2), (340, 3)]
|
|
roomPillars 30 w h wn hn <&> rmPmnts .++~ crsItmsUnused crs itms
|
|
|
|
crsItmsUnused :: [Creature] -> [Item] -> [Placement]
|
|
crsItmsUnused crs itms =
|
|
map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) itms
|
|
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
|
|
|
|
pedestalRoom :: (RandomGen g) => Item -> State g Room
|
|
pedestalRoom it = do
|
|
let flit = PutFlIt it
|
|
x <- state $ randomR (150, 250)
|
|
ngon <- state $ randomR (5, 9)
|
|
r <-
|
|
takeOne
|
|
[ shuffleLinks =<< (centerVaultRoom x x 50 <&> rmPmnts .:~ sps0 flit)
|
|
, shuffleLinks =<< (roomRectAutoLights (2 * x) (2 * x) <&> rmPmnts .:~ sPS (V2 x x) 0 flit)
|
|
, shuffleLinks =<< (roomNgon ngon x <&> rmPmnts .:~ sps0 flit)
|
|
]
|
|
r <&> rmName .++~ "ped-"
|