97 lines
3.3 KiB
Haskell
97 lines
3.3 KiB
Haskell
{- Connecting rooms designed with a pass-through technique in mind. -}
|
|
module Dodge.Room.RoadBlock where
|
|
|
|
import Control.Lens
|
|
import Dodge.Cleat
|
|
import Dodge.Creature
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Block
|
|
import Dodge.Default.Room
|
|
import Dodge.Default.Wall
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.Placement.Instance
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Link
|
|
import Dodge.RoomLink
|
|
import Dodge.Tree
|
|
import Geometry
|
|
import RandomHelp
|
|
|
|
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 =
|
|
foldMap
|
|
doublePairSet
|
|
[ (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 $ cleatOnward $ 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 defaultDirtBlock defaultDirtWall . reverse
|
|
|
|
-- | A single corridor with a destructible block blocking it.
|
|
blockedCorridorCloseBlocks :: RandomGen g => State g Room
|
|
blockedCorridorCloseBlocks = do
|
|
r <- state $ randomR (0, pi)
|
|
r' <- state $ randomR (0, pi)
|
|
theblocks <-
|
|
takeOne
|
|
[ [sPS (V2 20 40) r $ dirtPoly $ square 8]
|
|
, --, [ 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 8
|
|
, sPS (V2 35 20) r' $ dirtPoly $ square 8
|
|
]
|
|
]
|
|
return $ corridor & rmPmnts .~ theblocks
|