Refactor, try to limit dependencies
This commit is contained in:
+283
-232
@@ -1,111 +1,114 @@
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Room.Room
|
||||
( shootingRange
|
||||
, weaponRoom
|
||||
, roomMiniIntro
|
||||
, roomCCrits
|
||||
, doubleCorridorBarrels
|
||||
, pistolerRoom
|
||||
, spawnerRoom
|
||||
, corDoor
|
||||
) where
|
||||
import Dodge.Cleat
|
||||
import Dodge.Item.Display
|
||||
import Dodge.Data
|
||||
import Dodge.PlacementSpot
|
||||
import Dodge.RoomLink
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Creature
|
||||
import Dodge.Room.Pillar
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.Room.Girder
|
||||
import Dodge.Room.Modify.Girder
|
||||
import Dodge.LevelGen.Data
|
||||
import RandomHelp
|
||||
import Dodge.Tree
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Placement.Random
|
||||
--import Dodge.LevelGen.Data
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.Corridor
|
||||
--import Dodge.Room.Tanks
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Airlock
|
||||
import Geometry
|
||||
import MonadHelp
|
||||
import LensHelp
|
||||
module Dodge.Room.Room (
|
||||
shootingRange,
|
||||
weaponRoom,
|
||||
roomMiniIntro,
|
||||
roomCCrits,
|
||||
doubleCorridorBarrels,
|
||||
pistolerRoom,
|
||||
spawnerRoom,
|
||||
corDoor,
|
||||
) where
|
||||
|
||||
import qualified Data.Set as S
|
||||
import Dodge.Cleat
|
||||
import Dodge.Creature
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Item.Display
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Placement.Random
|
||||
import Dodge.PlacementSpot
|
||||
import Dodge.Room.Airlock
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.Room.Girder
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Modify.Girder
|
||||
import Dodge.Room.Pillar
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.RoomLink
|
||||
import Dodge.Tree
|
||||
import Geometry
|
||||
import LensHelp
|
||||
import MonadHelp
|
||||
import RandomHelp
|
||||
|
||||
roomC :: RandomGen g => Float -> Float -> State g Room
|
||||
roomC w h = do
|
||||
wallf <- takeOne [ crystalLine , windowLine ]
|
||||
wallf <- takeOne [crystalLine, windowLine]
|
||||
maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0]
|
||||
maybeaddgird =<< shuffleLinks (roomRectAutoLinks w h
|
||||
& rmLinks %~
|
||||
( setInLinks (\rl -> S.fromList [FromEdge East 0,OnEdge South] `S.isSubsetOf` _rlType rl)
|
||||
. setOutLinks (\rl -> OnEdge West `S.member` _rlType rl)
|
||||
maybeaddgird
|
||||
=<< shuffleLinks
|
||||
( roomRectAutoLinks w h
|
||||
& rmLinks
|
||||
%~ ( setInLinks (\rl -> S.fromList [FromEdge East 0, OnEdge South] `S.isSubsetOf` _rlType rl)
|
||||
. setOutLinks (\rl -> OnEdge West `S.member` _rlType rl)
|
||||
)
|
||||
& rmPmnts .:~ wallf (V2 (w / 2) 0) (V2 (w / 2) (h -60))
|
||||
& rmPmnts .:~ sps0 (PutDecoration (highMesh (V2 0 0) (V2 0 h) 50))
|
||||
& rmRandPSs .~ [farside]
|
||||
)
|
||||
& rmPmnts .:~ wallf (V2 (w/2) 0) (V2 (w/2) (h-60))
|
||||
& rmPmnts .:~ sps0 (PutDecoration (highMesh (V2 0 0) (V2 0 h) 50))
|
||||
& rmRandPSs .~ [farside]
|
||||
)
|
||||
where
|
||||
farside = do
|
||||
x <- state $ randomR (5, w/2 - 20)
|
||||
x <- state $ randomR (5, w / 2 - 20)
|
||||
y <- state $ randomR (5, h - 70)
|
||||
a <- state $ randomR (0, 2*pi)
|
||||
return (V2 x y,a)
|
||||
a <- state $ randomR (0, 2 * pi)
|
||||
return (V2 x y, a)
|
||||
|
||||
roomPadCut :: [Point2] -> Point2 -> Room
|
||||
roomPadCut ps p = defaultRoom
|
||||
{ _rmPolys = [ps]
|
||||
, _rmLinks = muout [(p,0)] ++ muin [(V2 0 0,pi)]
|
||||
, _rmPath = doublePairSet (V2 0 0,p)
|
||||
}
|
||||
roomPadCut ps p =
|
||||
defaultRoom
|
||||
{ _rmPolys = [ps]
|
||||
, _rmLinks = muout [(p, 0)] ++ muin [(V2 0 0, pi)]
|
||||
, _rmPath = doublePairSet (V2 0 0, p)
|
||||
}
|
||||
|
||||
branchWith :: Room -> [Tree Room] -> Tree Room
|
||||
branchWith r = Node r . (return (cleatOnward door) :)
|
||||
|
||||
glassSwitchBack :: RandomGen g => State g Room
|
||||
glassSwitchBack = do
|
||||
wth <- state $ randomR (200,400)
|
||||
hgt <- state $ randomR (400,600)
|
||||
wllen <- state $ randomR (60,wth/2-40)
|
||||
let hf = hgt/5
|
||||
awindow h xl xr = windowLine (V2 xl h) (V2 xr h)
|
||||
plmnts =
|
||||
[awindow hf (wth-60) wllen
|
||||
,awindow (2*hf) (wth-wllen) 60
|
||||
,awindow (3*hf) (wth-60) wllen
|
||||
,awindow (4*hf) (wth-wllen) 60
|
||||
,blockLine (V2 0 (1*hf)) (V2 wllen (1*hf))
|
||||
,blockLine (V2 (wth-wllen) (2*hf)) (V2 wth (2*hf))
|
||||
,blockLine (V2 0 (3*hf)) (V2 wllen (3*hf))
|
||||
,blockLine (V2 (wth-wllen) (4*hf)) (V2 wth (4*hf))
|
||||
, sPS (V2 (wth/2) (hgt/2)) 0 putLamp
|
||||
wth <- state $ randomR (200, 400)
|
||||
hgt <- state $ randomR (400, 600)
|
||||
wllen <- state $ randomR (60, wth / 2 -40)
|
||||
let hf = hgt / 5
|
||||
awindow h xl xr = windowLine (V2 xl h) (V2 xr h)
|
||||
plmnts =
|
||||
[ awindow hf (wth -60) wllen
|
||||
, awindow (2 * hf) (wth - wllen) 60
|
||||
, awindow (3 * hf) (wth -60) wllen
|
||||
, awindow (4 * hf) (wth - wllen) 60
|
||||
, blockLine (V2 0 (1 * hf)) (V2 wllen (1 * hf))
|
||||
, blockLine (V2 (wth - wllen) (2 * hf)) (V2 wth (2 * hf))
|
||||
, blockLine (V2 0 (3 * hf)) (V2 wllen (3 * hf))
|
||||
, blockLine (V2 (wth - wllen) (4 * hf)) (V2 wth (4 * hf))
|
||||
, sPS (V2 (wth / 2) (hgt / 2)) 0 putLamp
|
||||
]
|
||||
let northPSs = do
|
||||
cry <- randomRanges [3*hf+10,4*hf-10 ,4*hf+10,5*hf-10 ]
|
||||
crx <- state $ randomR (wllen,wth-(wllen+40))
|
||||
return (V2 crx cry,1.5*pi)
|
||||
midPS = return (V2 (wth-20) (hgt/2+40), pi)
|
||||
return $ roomRect wth hgt 2 4
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [northPSs,midPS]
|
||||
& rmName .~ "glassSwitchBack"
|
||||
cry <- randomRanges [3 * hf + 10, 4 * hf -10, 4 * hf + 10, 5 * hf -10]
|
||||
crx <- state $ randomR (wllen, wth - (wllen + 40))
|
||||
return (V2 crx cry, 1.5 * pi)
|
||||
midPS = return (V2 (wth -20) (hgt / 2 + 40), pi)
|
||||
return $
|
||||
roomRect wth hgt 2 4
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [northPSs, midPS]
|
||||
& rmName .~ "glassSwitchBack"
|
||||
|
||||
glassSwitchBackCrits :: RandomGen g => State g Room
|
||||
glassSwitchBackCrits = glassSwitchBack <&> rmPmnts .++~
|
||||
[ spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit)
|
||||
, spNoID (PSRoomRand 1 (uncurry PS)) randC1
|
||||
]
|
||||
glassSwitchBackCrits =
|
||||
glassSwitchBack <&> rmPmnts
|
||||
.++~ [ spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit)
|
||||
, spNoID (PSRoomRand 1 (uncurry PS)) randC1
|
||||
]
|
||||
|
||||
miniTree2 :: RandomGen g => State g (Tree Room)
|
||||
miniTree2 = do
|
||||
rm <- glassSwitchBackCrits >>= shuffleLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70)
|
||||
return $ branchWith rm (replicate 3 $ treePost [door,corridor,critInDeadEnd])
|
||||
return $ branchWith rm (replicate 3 $ treePost [door, corridor, critInDeadEnd])
|
||||
|
||||
-- So, the idea is to attach outer children to the bottommost right nodes
|
||||
-- inside an inner tree
|
||||
@@ -117,217 +120,265 @@ roomMiniIntro = do
|
||||
|
||||
roomCenterPillar :: RandomGen g => State g Room
|
||||
roomCenterPillar = do
|
||||
addHighGirder' =<< (shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst)
|
||||
$ cleatSide
|
||||
$ set rmPmnts plmnts
|
||||
$ set rmName "roomCenterPillar"
|
||||
$ roomRect 240 240 2 2
|
||||
)
|
||||
where
|
||||
plmnts =
|
||||
addHighGirder'
|
||||
=<< ( shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst) $
|
||||
cleatSide $
|
||||
set rmPmnts plmnts $
|
||||
set rmName "roomCenterPillar" $
|
||||
roomRect 240 240 2 2
|
||||
)
|
||||
where
|
||||
plmnts =
|
||||
[ blockLine (V2 115 115) (V2 115 125)
|
||||
, blockLine (V2 125 115) (V2 125 125)
|
||||
-- , mntLightLnkCond useUnusedLnk
|
||||
, mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
|
||||
, mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isOutLnk rp)
|
||||
, -- , mntLightLnkCond useUnusedLnk
|
||||
mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
|
||||
, mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isOutLnk rp)
|
||||
]
|
||||
|
||||
weaponEmptyRoom :: State StdGen (Tree Room)
|
||||
weaponEmptyRoom = do
|
||||
w <- state $ randomR (220,300)
|
||||
h <- state $ randomR (220,300)
|
||||
w <- state $ randomR (220, 300)
|
||||
h <- state $ randomR (220, 300)
|
||||
wp <- randFirstWeapon
|
||||
let plmnts =
|
||||
[sPS (V2 (w/2) (h-40)) 0 $ PutFlIt wp
|
||||
,sPS (V2 20 20) (pi/2) randC1
|
||||
,sPS (V2 (w-20) 20) (pi/2) randC1
|
||||
,mntLightLnkCond useUnusedLnk
|
||||
let plmnts =
|
||||
[ sPS (V2 (w / 2) (h -40)) 0 $ PutFlIt wp
|
||||
, sPS (V2 20 20) (pi / 2) randC1
|
||||
, sPS (V2 (w -20) 20) (pi / 2) randC1
|
||||
, mntLightLnkCond useUnusedLnk
|
||||
]
|
||||
f (V2 x y,a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
|
||||
rm <- addHighGirder >=> shuffleLinks
|
||||
$ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
|
||||
return $ treePost [ corridor, cleatSide $ cleatOnward rm ]
|
||||
|
||||
f (V2 x y, a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
|
||||
rm <-
|
||||
addHighGirder >=> shuffleLinks $
|
||||
restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
|
||||
return $ treePost [corridor, cleatSide $ cleatOnward rm]
|
||||
|
||||
weaponUnderCrits :: RandomGen g => Int -> State g (MetaTree Room String)
|
||||
weaponUnderCrits i = do
|
||||
let addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon)
|
||||
continuationRoom = treePost
|
||||
[ addwpat (V2 20 0) corridorN
|
||||
, addwpat (V2 20 0) corridorN
|
||||
, cleatOnward $ corridorN & rmPmnts .~
|
||||
[ sPS (V2 20 0) (negate $ pi/2) randC1
|
||||
, sPS (V2 20 20) ( pi/2) randC1
|
||||
continuationRoom =
|
||||
treePost
|
||||
[ addwpat (V2 20 0) corridorN
|
||||
, addwpat (V2 20 0) corridorN
|
||||
, cleatOnward $
|
||||
corridorN & rmPmnts
|
||||
.~ [ sPS (V2 20 0) (negate $ pi / 2) randC1
|
||||
, sPS (V2 20 20) (pi / 2) randC1
|
||||
]
|
||||
]
|
||||
]
|
||||
rcp <- roomCenterPillar
|
||||
rmpils <- roomPillars 30 240 240 2 2
|
||||
deadEndRoom' <- takeOne [ addwpat (V2 120 20) rmpils , addwpat (V2 120 20) $ cleatSide rcp]
|
||||
junctionRoom <- takeOne [ tEast, tWest]
|
||||
rToOnward "weaponUnderCrits" $ treeFromTrunk [ corridorN , corridorN]
|
||||
$ Node junctionRoom [continuationRoom ,pure deadEndRoom' ]
|
||||
deadEndRoom' <- takeOne [addwpat (V2 120 20) rmpils, addwpat (V2 120 20) $ cleatSide rcp]
|
||||
junctionRoom <- takeOne [tEast, tWest]
|
||||
rToOnward "weaponUnderCrits" $
|
||||
treeFromTrunk [corridorN, corridorN] $
|
||||
Node junctionRoom [continuationRoom, pure deadEndRoom']
|
||||
|
||||
weaponBehindPillar :: RandomGen g => State g (Tree Room)
|
||||
weaponBehindPillar = do
|
||||
wpa <- state $ randomR (0,pi)
|
||||
wpos <- takeOne [V2 120 160,V2 80 40,V2 160 40,V2 220 200,V2 40 200,V2 120 35]
|
||||
cpos <- takeOne $ [V2 x y | x <- [20,220], y <- [20,40]] ++ [V2 120 160,V2 120 200]
|
||||
weaponBehindPillar = do
|
||||
wpa <- state $ randomR (0, pi)
|
||||
wpos <- takeOne [V2 120 160, V2 80 40, V2 160 40, V2 220 200, V2 40 200, V2 120 35]
|
||||
cpos <- takeOne $ [V2 x y | x <- [20, 220], y <- [20, 40]] ++ [V2 120 160, V2 120 200]
|
||||
rcp <- roomCenterPillar
|
||||
return $ treePost
|
||||
[ corridor
|
||||
, rcp & rmPmnts ++.~
|
||||
[sPS wpos wpa $ RandPS $ fmap PutFlIt randFirstWeapon
|
||||
,sPS cpos (argV $ V2 120 80 -.- cpos) randC1
|
||||
return $
|
||||
treePost
|
||||
[ corridor
|
||||
, rcp & rmPmnts
|
||||
++.~ [ sPS wpos wpa $ RandPS $ fmap PutFlIt randFirstWeapon
|
||||
, sPS cpos (argV $ V2 120 80 -.- cpos) randC1
|
||||
]
|
||||
, cleatOnward $ set rmPmnts [sPS (V2 20 60) (negate $ pi / 2) randC1] corridorN
|
||||
]
|
||||
, cleatOnward $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN
|
||||
]
|
||||
|
||||
weaponBetweenPillars :: State StdGen (MetaTree Room String)
|
||||
weaponBetweenPillars = do
|
||||
(w,wn) <- takeOne [(240,2),(340,3)]
|
||||
(h,hn) <- takeOne [(240,2),(340,3)]
|
||||
let wpPos = rprBool $ \rp r -> and
|
||||
[ rpIsOnPath rp
|
||||
, _rpPlacementUse rp == 0
|
||||
, _rpLinkStatus rp == NotLink
|
||||
, any ((<100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
|
||||
]
|
||||
ncrits <- state $ randomR (1,3)
|
||||
(w, wn) <- takeOne [(240, 2), (340, 3)]
|
||||
(h, hn) <- takeOne [(240, 2), (340, 3)]
|
||||
let wpPos = rprBool $ \rp r ->
|
||||
and
|
||||
[ rpIsOnPath rp
|
||||
, _rpPlacementUse rp == 0
|
||||
, _rpLinkStatus rp == NotLink
|
||||
, any ((< 100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
|
||||
]
|
||||
ncrits <- state $ randomR (1, 3)
|
||||
wp <- randFirstWeapon
|
||||
critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r ->
|
||||
rpIsOnPath rp
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
|
||||
(roomPillars 30 w h wn hn
|
||||
<&> rmPmnts .++~ map (`sps` randC1) critPlacementSpots ++ [ sps wpPos (PutFlIt wp) ]
|
||||
<&> cleatOnward) >>= rToOnward ("weaponBetweenPillars_"++itemString wp) . pure
|
||||
critPlacementSpots <- replicateM ncrits $
|
||||
randDirPS $
|
||||
rprBool $ \rp r ->
|
||||
rpIsOnPath rp
|
||||
&& _rpPlacementUse rp == 0
|
||||
&& all ((> 100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
|
||||
( roomPillars 30 w h wn hn
|
||||
<&> rmPmnts .++~ map (`sps` randC1) critPlacementSpots ++ [sps wpPos (PutFlIt wp)]
|
||||
<&> cleatOnward
|
||||
)
|
||||
>>= rToOnward ("weaponBetweenPillars_" ++ itemString wp) . pure
|
||||
|
||||
weaponLongCorridor :: RandomGen g => State g (Tree Room)
|
||||
weaponLongCorridor = do
|
||||
rt <- takeOne [tEast, tWest]
|
||||
connectingRoom <- takeOne [tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)] ]
|
||||
i1 <- state $ randomR (2,5)
|
||||
i2 <- state $ randomR (2,5)
|
||||
let branch1 = treeFromTrunk (replicate i1 corridorN)
|
||||
(pure . cleatSide . cleatOnward $ putCrs connectingRoom)
|
||||
let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . cleatSide $ putWp corridor)
|
||||
return $ Node rt [branch1,branch2]
|
||||
where
|
||||
putCrs = rmPmnts .++~ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ]
|
||||
putWp = rmPmnts .~ [sPS (V2 20 60) 0 $ RandPS $ fmap PutFlIt randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
|
||||
connectingRoom <- takeOne [tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)]]
|
||||
i1 <- state $ randomR (2, 5)
|
||||
i2 <- state $ randomR (2, 5)
|
||||
let branch1 =
|
||||
treeFromTrunk
|
||||
(replicate i1 corridorN)
|
||||
(pure . cleatSide . cleatOnward $ putCrs connectingRoom)
|
||||
let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . cleatSide $ putWp corridor)
|
||||
return $ Node rt [branch1, branch2]
|
||||
where
|
||||
putCrs = rmPmnts .++~ [sPS (V2 10 40) (- pi / 2) randC1, sPS (V2 (-10) 40) (- pi / 2) randC1]
|
||||
putWp = rmPmnts .~ [sPS (V2 20 60) 0 $ RandPS $ fmap PutFlIt randFirstWeapon, spanLightI (V2 0 40) (V2 40 40)]
|
||||
|
||||
critInDeadEnd :: Room
|
||||
critInDeadEnd = deadEndRoom & rmPmnts .~ [sPS (V2 0 0) 0 randC1]
|
||||
|
||||
deadEndRoom :: Room
|
||||
deadEndRoom = defaultRoom
|
||||
{ _rmPolys = [rectNSWE 40 (-20) (-20) 20 ]
|
||||
, _rmLinks = muout (init lnks) ++ muin [last lnks]
|
||||
, _rmPath = mempty
|
||||
, _rmPmnts = [sPS (V2 0 (-10)) 0 putLamp]
|
||||
, _rmBound = [rectNSWE 20 (-20) (-30) 30]
|
||||
, _rmName = "deadEndRoom"
|
||||
}
|
||||
where
|
||||
lnks = [(V2 0 30 ,0) ]
|
||||
deadEndRoom =
|
||||
defaultRoom
|
||||
{ _rmPolys = [rectNSWE 40 (-20) (-20) 20]
|
||||
, _rmLinks = muout (init lnks) ++ muin [last lnks]
|
||||
, _rmPath = mempty
|
||||
, _rmPmnts = [sPS (V2 0 (-10)) 0 putLamp]
|
||||
, _rmBound = [rectNSWE 20 (-20) (-30) 30]
|
||||
, _rmName = "deadEndRoom"
|
||||
}
|
||||
where
|
||||
lnks = [(V2 0 30, 0)]
|
||||
|
||||
{- A random Either tree with a weapon and melee monster challenge. -}
|
||||
weaponRoom :: Int -> State StdGen (MetaTree Room String)
|
||||
weaponRoom i = join $ takeOne
|
||||
[ weaponEmptyRoom >>= rToOnward "weaponEmptyRoom"
|
||||
, weaponUnderCrits i -- this int is used for PickOnePlacement
|
||||
, weaponBehindPillar >>= rToOnward "weaponBehindPillar"
|
||||
, weaponBetweenPillars-- >>= rToOnward "weaponBetweenPillars"
|
||||
, weaponLongCorridor >>= rToOnward "weaponLongCorridor"
|
||||
]
|
||||
weaponRoom i =
|
||||
join $
|
||||
takeOne
|
||||
[ weaponEmptyRoom >>= rToOnward "weaponEmptyRoom"
|
||||
, weaponUnderCrits i -- this int is used for PickOnePlacement
|
||||
, weaponBehindPillar >>= rToOnward "weaponBehindPillar"
|
||||
, weaponBetweenPillars -- >>= rToOnward "weaponBetweenPillars"
|
||||
, weaponLongCorridor >>= rToOnward "weaponLongCorridor"
|
||||
]
|
||||
|
||||
roomCCrits :: RandomGen g => Int -> State g Room
|
||||
roomCCrits i = roomC 200 200
|
||||
<&> rmPmnts .++~ replicate i (spNoID (PSRoomRand 0 (uncurry PS)) randC1)
|
||||
roomCCrits i =
|
||||
roomC 200 200
|
||||
<&> rmPmnts .++~ replicate i (spNoID (PSRoomRand 0 (uncurry PS)) randC1)
|
||||
|
||||
doubleCorridorBarrels :: RandomGen g => State g Room
|
||||
doubleCorridorBarrels = do
|
||||
h <- state $ randomR (200,300)
|
||||
h <- state $ randomR (200, 300)
|
||||
let cond x = (sndV2 . fst) x < h - 40
|
||||
return $ restrictInLinks cond $ roomRect 100 h 1 1 & rmPmnts .~
|
||||
[blockLine (V2 50 50) (V2 50 h)
|
||||
,sPS (V2 25 (h-25)) (negate pi/2) $ PutCrit $ addArmour autoCrit
|
||||
,sPS (V2 75 (h-80)) 0 putLamp
|
||||
] ++
|
||||
[sPS p 0 $ PutCrit explosiveBarrel
|
||||
| p <- [ V2 75 (h-30) ,V2 75 (h-60) ,V2 85 (h-10) ,V2 85 (h-45) ] ]
|
||||
return $
|
||||
restrictInLinks cond $
|
||||
roomRect 100 h 1 1 & rmPmnts
|
||||
.~ [ blockLine (V2 50 50) (V2 50 h)
|
||||
, sPS (V2 25 (h -25)) (negate pi / 2) $ PutCrit $ addArmour autoCrit
|
||||
, sPS (V2 75 (h -80)) 0 putLamp
|
||||
]
|
||||
++ [ sPS p 0 $ PutCrit explosiveBarrel
|
||||
| p <- [V2 75 (h -30), V2 75 (h -60), V2 85 (h -10), V2 85 (h -45)]
|
||||
]
|
||||
|
||||
shootersRoom' :: RandomGen g => State g Room
|
||||
shootersRoom' = do
|
||||
w <- state $ randomR (200,300)
|
||||
x1 <- state $ randomR (20,w/3-20)
|
||||
x2 <- state $ randomR (w/3+20,2*w/3-20)
|
||||
x3 <- state $ randomR (2*w/3+20,w-20)
|
||||
y1 <- state $ randomR (280,550)
|
||||
y2 <- state $ randomR (280,550)
|
||||
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (280,560)
|
||||
x4 <- state $ randomR (60,w-60)
|
||||
y4 <- state $ randomR (40,150)
|
||||
let bln x y = putBlockN (x+25) (x-25) (y+20) (y+10)
|
||||
blv x y = putBlockV (x+25) (x-25) (y+20) (y+10)
|
||||
plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
|
||||
++ [spanLightI (V2 (-10) 200) (V2 (w/2) 200)
|
||||
,spanLightI (V2 (w/2) 200) (V2 (w+10) 200)
|
||||
]
|
||||
toPS x y = return (V2 x y,-0.5*pi)
|
||||
return $ set rmPmnts plmnts $ roomRectAutoLinks w 600
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [toPS x1 y1,toPS x2 y2,toPS x3 y3]
|
||||
w <- state $ randomR (200, 300)
|
||||
x1 <- state $ randomR (20, w / 3 -20)
|
||||
x2 <- state $ randomR (w / 3 + 20, 2 * w / 3 -20)
|
||||
x3 <- state $ randomR (2 * w / 3 + 20, w -20)
|
||||
y1 <- state $ randomR (280, 550)
|
||||
y2 <- state $ randomR (280, 550)
|
||||
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (280, 560)
|
||||
x4 <- state $ randomR (60, w -60)
|
||||
y4 <- state $ randomR (40, 150)
|
||||
let bln x y = putBlockN (x + 25) (x -25) (y + 20) (y + 10)
|
||||
blv x y = putBlockV (x + 25) (x -25) (y + 20) (y + 10)
|
||||
plmnts =
|
||||
bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
|
||||
++ [ spanLightI (V2 (-10) 200) (V2 (w / 2) 200)
|
||||
, spanLightI (V2 (w / 2) 200) (V2 (w + 10) 200)
|
||||
]
|
||||
toPS x y = return (V2 x y, -0.5 * pi)
|
||||
return $
|
||||
set rmPmnts plmnts $
|
||||
roomRectAutoLinks w 600
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [toPS x1 y1, toPS x2 y2, toPS x3 y3]
|
||||
|
||||
shootersRoom1 :: RandomGen g => State g Room
|
||||
shootersRoom1 = shootersRoom' <&> rmPmnts .:~ RandomPlacement
|
||||
(takeOne $ map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
|
||||
[0,1,2])
|
||||
shootersRoom1 =
|
||||
shootersRoom' <&> rmPmnts
|
||||
.:~ RandomPlacement
|
||||
( takeOne $
|
||||
map
|
||||
(\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
|
||||
[0, 1, 2]
|
||||
)
|
||||
|
||||
shootersRoom :: RandomGen g => State g Room
|
||||
shootersRoom = shootersRoom' <&> rmPmnts .++~
|
||||
map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit)) [0,1,2]
|
||||
shootersRoom =
|
||||
shootersRoom' <&> rmPmnts
|
||||
.++~ map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit)) [0, 1, 2]
|
||||
|
||||
-- TODO stop from spawning on inlinks fromedge
|
||||
pistolerRoom :: RandomGen g => State g Room
|
||||
pistolerRoom = do
|
||||
(w,wn) <- takeOne [(200,3),(255,4)]
|
||||
roomPillars 10 w 200 wn 3 <&> rmPmnts .++~ replicate 3
|
||||
(spNoID (rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp)
|
||||
(PutCrit pistolCrit))
|
||||
(w, wn) <- takeOne [(200, 3), (255, 4)]
|
||||
roomPillars 10 w 200 wn 3 <&> rmPmnts
|
||||
.++~ replicate
|
||||
3
|
||||
( spNoID
|
||||
(rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp)
|
||||
(PutCrit pistolCrit)
|
||||
)
|
||||
|
||||
shootingRange :: RandomGen g => State g (MetaTree Room String)
|
||||
shootingRange = do
|
||||
rm1 <- shootersRoom1 >>= shuffleLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
|
||||
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
rm2 <- shootersRoom >>= shuffleLinks
|
||||
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
||||
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
rm3 <- shootersRoom >>= shuffleLinks
|
||||
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
||||
. restrictOutLinks (\(_,r) -> r == 0)
|
||||
let padcutroom = roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPmnts .:~ spanLightI (V2 (-80) 10) (V2 80 10)
|
||||
rToOnward "shootingRange" $ treePost
|
||||
[ rm1
|
||||
, padcutroom
|
||||
, rm2
|
||||
, padcutroom
|
||||
, cleatOnward rm3
|
||||
]
|
||||
rm1 <-
|
||||
shootersRoom1
|
||||
>>= shuffleLinks . restrictInLinks (\(V2 _ y, _) -> y < 40)
|
||||
. restrictOutLinks (\(V2 _ y, r) -> y > 200 && r /= 0)
|
||||
rm2 <-
|
||||
shootersRoom
|
||||
>>= shuffleLinks
|
||||
. restrictInLinks (\(V2 x y, _) -> y < 10 && x > 20 && x < 180)
|
||||
. restrictOutLinks (\(V2 _ y, r) -> y > 200 && r /= 0)
|
||||
rm3 <-
|
||||
shootersRoom
|
||||
>>= shuffleLinks
|
||||
. restrictInLinks (\(V2 x y, _) -> y < 10 && x > 20 && x < 180)
|
||||
. restrictOutLinks (\(_, r) -> r == 0)
|
||||
let padcutroom =
|
||||
roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPmnts .:~ spanLightI (V2 (-80) 10) (V2 80 10)
|
||||
rToOnward "shootingRange" $
|
||||
treePost
|
||||
[ rm1
|
||||
, padcutroom
|
||||
, rm2
|
||||
, padcutroom
|
||||
, cleatOnward rm3
|
||||
]
|
||||
|
||||
spawnerRoom :: RandomGen g => State g (Tree Room)
|
||||
spawnerRoom = do
|
||||
x <- state $ randomR (250,300)
|
||||
y <- state $ randomR (300,400)
|
||||
roomWithSpawner <- roomC x y <&> rmPmnts .:~ spNoID
|
||||
(rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp
|
||||
&& xV2 (_rpPos rp) < x/2 && yV2 (_rpPos rp) < y/2 )
|
||||
(PutCrit spawnerCrit)
|
||||
x <- state $ randomR (250, 300)
|
||||
y <- state $ randomR (300, 400)
|
||||
roomWithSpawner <-
|
||||
roomC x y <&> rmPmnts
|
||||
.:~ spNoID
|
||||
( rprBool $ \rp _ ->
|
||||
_rpPlacementUse rp == 0 && rpIsOnPath rp
|
||||
&& xV2 (_rpPos rp) < x / 2
|
||||
&& yV2 (_rpPos rp) < y / 2
|
||||
)
|
||||
(PutCrit spawnerCrit)
|
||||
aRoom <- airlock
|
||||
return $ treeFromTrunk [ aRoom, corridor] $ pure $ cleatOnward roomWithSpawner
|
||||
return $ treeFromTrunk [aRoom, corridor] $ pure $ cleatOnward roomWithSpawner
|
||||
|
||||
corDoor :: State StdGen (MetaTree Room String)
|
||||
corDoor = do
|
||||
cor <- shuffleLinks (cleatOnward corridor) <&> rmPmnts .~ []
|
||||
return $ tToBTree "corDoor" $ treePost [door,cor]
|
||||
return $ tToBTree "corDoor" $ treePost [door, cor]
|
||||
|
||||
-- cor <- shuffleLinks corridor
|
||||
-- return $ tToBTree "corDoor" $ treePost [door,cor,cleatOnward door]
|
||||
|
||||
Reference in New Issue
Block a user