88 lines
3.0 KiB
Haskell
88 lines
3.0 KiB
Haskell
{- Connecting rooms designed with a pass-through technique in mind. -}
|
|
module Dodge.Room.RoadBlock where
|
|
import Dodge.UseAll
|
|
import Dodge.Data
|
|
import Dodge.RoomLink
|
|
import Geometry
|
|
import Dodge.Default.Room
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Room.Link
|
|
import Dodge.Placement.Instance
|
|
import Dodge.Room.Corridor
|
|
--import Dodge.LevelGen.Data
|
|
--import Dodge.Default.Wall
|
|
import RandomHelp
|
|
import Dodge.Creature
|
|
import Dodge.Tree
|
|
|
|
import Control.Lens
|
|
|
|
armouredCorridor :: RandomGen g => State g Room
|
|
armouredCorridor = fmap (replacePutID 0 [PutCrit $ addArmour autoCrit]) litCorridor90
|
|
|
|
{-
|
|
A corridor of random length with a 90 degree link at the end.
|
|
-}
|
|
litCorridor90 :: RandomGen g => State g Room
|
|
litCorridor90 = do
|
|
h <- state $ randomR (500,800)
|
|
let poly = rectNSWE h 0 0 40
|
|
poly2 = rectNSWE (h-60) (h-100) (-60) 5
|
|
pure $ defaultRoom
|
|
{ _rmPolys = [poly,poly2]
|
|
, _rmLinks =
|
|
[ outLink (V2 40 (h - 80)) (-pi/2)
|
|
, inLink (V2 20 0 ) pi ]
|
|
, _rmPath = concatMap doublePair
|
|
[( V2 20 0 , V2 20 (h-40) )
|
|
,( V2 0 (h-40) , V2 20 (h-40) )
|
|
,( V2 40 (h-40) , V2 20 (h-40) )
|
|
]
|
|
, _rmPmnts =
|
|
[ sPS (V2 20 (h-5)) 0 putLamp
|
|
, spanLightI (V2 0 (0.4*h)) (V2 40 (0.4*h))
|
|
, windowLine (V2 0 (h-20)) (V2 40 (h-20))
|
|
, sPS (V2 (-50) (h-85)) 0 putLamp
|
|
, windowLine (V2 (-40) (h-60)) (V2 (-40) (h-100))
|
|
, sPS (V2 20 (h-40)) 0 $ PutID 0
|
|
, sPS (V2 (-20) (h-80)) 0 $ PutID 2
|
|
]
|
|
, _rmBound = [poly]
|
|
}
|
|
|
|
-- | A random length corridor with a destructible block blocking it.
|
|
longBlockedCorridor :: RandomGen g => Int -> State g (Tree Room)
|
|
longBlockedCorridor maxn = do
|
|
r <- state $ randomR (0,pi)
|
|
n <- state $ randomR (0,maxn)
|
|
let plmnts = [sPS (V2 20 40) r $ dirtPoly $ square 10
|
|
,sPS (V2 20 15) 0 putLamp
|
|
]
|
|
sequence $ treeFromPost (replicate n $ shuffleLinks corridor)
|
|
$ return $ useAll $ set rmPmnts plmnts corridor
|
|
|
|
-- | A single corridor with a destructible block blocking it.
|
|
blockedCorridor :: RandomGen g => State g (Tree Room)
|
|
blockedCorridor = longBlockedCorridor 0
|
|
|
|
dirtPoly :: [Point2] -> PSType
|
|
dirtPoly = PutBlock DirtBlock 1 [] dirtWall . reverse
|
|
|
|
-- | A single corridor with a destructible block blocking it.
|
|
blockedCorridorCloseBlocks :: RandomGen g => State g Room
|
|
blockedCorridorCloseBlocks = do
|
|
r <- state $ randomR (0,pi)
|
|
theblocks <- takeOne
|
|
[ -- [sPS (V2 20 40) r $ dirtPoly $ square 10]
|
|
--, [ sPS (V2 5 40) r $ dirtPoly $ square 10
|
|
-- , sPS (V2 35 40) (r+0.5) $ dirtPoly $ square 10
|
|
-- ]
|
|
--,
|
|
--[ sPS (V2 5 50) r $ dirtPoly $ square 10
|
|
--, sPS (V2 35 35) (r+0.5) $ dirtPoly $ square 10
|
|
[ sPS (V2 6 25) r $ dirtPoly $ square 10
|
|
, sPS (V2 35 20) (r+0.5) $ dirtPoly $ square 10
|
|
]
|
|
]
|
|
return $ corridor & rmPmnts .~ theblocks
|