Refactor, try to limit dependencies
This commit is contained in:
+64
-58
@@ -1,23 +1,21 @@
|
||||
{- Connecting rooms designed with a pass-through technique in mind. -}
|
||||
module Dodge.Room.RoadBlock where
|
||||
import Dodge.Default.Wall
|
||||
import Dodge.Default.Block
|
||||
import Dodge.Cleat
|
||||
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
|
||||
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.Data
|
||||
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
|
||||
@@ -27,41 +25,47 @@ 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)
|
||||
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]
|
||||
}
|
||||
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
|
||||
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
|
||||
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)
|
||||
@@ -73,18 +77,20 @@ 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
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user