This commit is contained in:
2022-06-11 14:37:05 +01:00
parent 9c9ec9c553
commit de71c61409
18 changed files with 107 additions and 134 deletions
+35 -52
View File
@@ -57,11 +57,11 @@ roomPadCut ps p = defaultRoom
}
branchWith :: Room -> [Tree Room] -> Tree Room
branchWith r ts = Node r $ return (useAll door) : ts
branchWith r ts = Node r $ return (cleatOnward door) : ts
manyDoors :: Int -> Tree Room
manyDoors i = treeFromPost (replicate i door) $ useAll door
manyDoors i = treeFromPost (replicate i door) $ cleatOnward door
glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do
@@ -108,21 +108,14 @@ miniRoom3 = do
w <- state $ randomR (300,400)
h <- state $ randomR (300,400)
let cp = V2 0 (h/2+40)
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60)
,( 10,-60)
,( 10,-80)
,(-10,-80)
]
let plmnts =
[ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
| i <- [0..7::Int]
] ++
[ sPS cp (pi/8+fromIntegral i*pi/4) b
| i <- [0..7::Int]
] ++
[ sPS cp 0 $ PutCrit miniGunCrit
, sPS (V2 (w/2) (h/2)) 0 putLamp ]
fmap (pure . useAll) $ shuffleLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ rectNSEW 10 (-10) (-60) (-80)
-- baseBlockPlane might need a reverse...
let plmnts = concatMap
(\i -> [ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
, sPS cp (pi/8+fromIntegral i*pi/4) b]
) [0..7::Int]
++ [ sPS cp 0 $ PutCrit miniGunCrit , sPS (V2 (w/2) (h/2)) 0 putLamp ]
pure <$> shuffleLinks (cleatOnward $ set rmPmnts plmnts $ roomRectAutoLinks w h)
rot90Around :: Point2 -> Point2 -> Point2
rot90Around cen p = cen +.+ vNormal (p -.- cen)
@@ -197,7 +190,7 @@ weaponEmptyRoom = do
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 $ treeFromTrunk [ corridor] (pure $ useAll rm )
return $ treeFromTrunk [ corridor] (pure $ cleatOnward rm )
weaponUnderCrits :: RandomGen g => Int -> State g (LabTree Room)
weaponUnderCrits i = do
@@ -207,23 +200,17 @@ weaponUnderCrits i = do
,sPS (V2 20 20) ( pi/2) randC1
]
addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS randFirstWeapon)
let continuationRoom = treeFromTrunk
[ addwpat (V2 20 0) corridorN, addwpat (V2 20 0) corridorN]
(pure $ useAll (set rmPmnts plmnts corridorN))
let continuationRoom = treePost
[ addwpat (V2 20 0) corridorN
, addwpat (V2 20 0) corridorN
, cleatOnward (set rmPmnts plmnts corridorN)
]
rcp <- roomCenterPillar
rmpils <- roomPillars 30 240 240 2 2
deadEndRoom' <- takeOne
[ addwpat (V2 120 20) rmpils
, addwpat (V2 120 20) rcp]
deadEndRoom' <- takeOne [ addwpat (V2 120 20) rmpils , addwpat (V2 120 20) rcp]
junctionRoom <- takeOne [ tEast, tWest]
let thetree = treeFromTrunk
--[ $ corridorN & rmPmnts .:~ mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
[ corridorN
, corridorN]
$ Node junctionRoom
[continuationRoom
,pure deadEndRoom'
]
let thetree = treeFromTrunk [ corridorN , corridorN]
$ Node junctionRoom [continuationRoom ,pure deadEndRoom' ]
return (toOnward "weaponUnderCrits" , thetree )
-- TODO addSubmessages
@@ -254,7 +241,7 @@ weaponBehindPillar = do
--, $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp
, over rmPmnts (++ plmnts1) rcp
]
(pure . useAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
(pure . cleatOnward $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
weaponBetweenPillars :: RandomGen g => State g (Tree Room)
weaponBetweenPillars = do
@@ -268,23 +255,21 @@ weaponBetweenPillars = do
]
ncrits <- state $ randomR (1,3)
critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r ->
RoomPosOnPath `S.member` _rpType rp
&& _rpPlacementUse rp == 0
&& all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
theRoom <- roomPillars 30 w h wn hn <&> rmPmnts .++~
sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
return $ pure $ useAll theRoom
RoomPosOnPath `S.member` _rpType rp
&& _rpPlacementUse rp == 0
&& all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
fmap pure $ roomPillars 30 w h wn hn
<&> rmPmnts .++~ sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
<&> cleatOnward
weaponLongCorridor :: RandomGen g => State g (Tree Room)
weaponLongCorridor = do
rt <- takeOne [tEast, tWest]
connectingRoom <- takeOne
[tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)]
]
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 . useAll $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . useSide $ putWp corridor)
let branch1 = treeFromTrunk (replicate i1 corridorN) (pure . cleatOnward $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . cleatSide $ putWp corridor)
return $ Node rt [branch1,branch2]
where
putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
@@ -414,30 +399,28 @@ pistolerRoom = pillarGrid
shootingRange :: RandomGen g => State g (LabTree Room)
shootingRange = do
rm1 <- shootersRoom1 >>= shuffleLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
. 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)
return ( toOnward "shootingRange"
,treeFromPost
rToOnward "shootingRange" $ treePost
[ rm1
, roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
, rm2
, roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
]
(useAll rm3)
)
, 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 (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit) :)
rmPmnts .:~ spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit)
aRoom <- airlock
return $ treeFromTrunk [ aRoom, corridor] $ pure $ useAll roomWithSpawner
return $ treeFromTrunk [ aRoom, corridor] $ pure $ cleatOnward roomWithSpawner