57 lines
2.0 KiB
Haskell
57 lines
2.0 KiB
Haskell
module Dodge.Room.Tanks where
|
|
import Dodge.Data
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.RandomHelp
|
|
import Dodge.Room.Procedural
|
|
import Dodge.Room.Foreground
|
|
import Dodge.Room.Modify.Girder
|
|
--import Dodge.Room.RoadBlock
|
|
import Dodge.Placement.Instance
|
|
import Dodge.Placement.TopDecoration
|
|
import Dodge.PlacementSpot
|
|
--import Padding
|
|
import Color
|
|
--import Shape
|
|
import LensHelp
|
|
--import Geometry
|
|
|
|
--import Data.Maybe
|
|
--import Data.Tree
|
|
import Control.Monad.State
|
|
import System.Random
|
|
--import qualified Data.Set as S
|
|
|
|
randomTank :: RandomGen g => State g Placement
|
|
randomTank = takeOne $ map (\f -> f (dim orange) orange)
|
|
[ tankSquareDec fourEmbossDecoration
|
|
, tankSquareDec midBarDecoration
|
|
, tankSquareDec squareDecoration
|
|
, roundTank
|
|
, roundTankCross
|
|
, tankSquareDec plusDecoration
|
|
]
|
|
|
|
tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
|
|
tanksRoom crs its = do
|
|
w <- state $ randomR (100,400)
|
|
h <- state $ randomR (200,400)
|
|
ntanks <- state $ randomR (3,6)
|
|
thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
|
|
let room = roomRectAutoLinks w h
|
|
let plmnts =
|
|
map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
|
|
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
|
|
++ replicate ntanks thetank
|
|
-- , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
|
|
hgshape <- takeOne [girder 96 20 10, girderZ 96 20 10, girderV 96 20 10]
|
|
addhighgirds <- takeOne $
|
|
[ addGirderEW hgshape black >=> addGirderEW hgshape black
|
|
, addGirderEW hgshape black
|
|
, addGirderNS hgshape black >=> addGirderNS hgshape black
|
|
, addGirderNS hgshape black
|
|
] ++ replicate 4 return
|
|
lgshape <- takeOne [girder 60 20 10, girderZ 60 20 10, girderV 60 20 10]
|
|
addlowgirds <- takeOne $ addGirderNS lgshape red : replicate 4 return
|
|
(addlowgirds >=> addhighgirds) $ room & rmPmnts .++~ plmnts
|
|
& rmName .~ "tanksRoom"
|