This commit is contained in:
2022-06-19 10:26:18 +01:00
parent 55d2fcc8d0
commit 075d4b1164
+16 -4
View File
@@ -44,12 +44,24 @@ randEdgeTank = do
& plSpot .~ rprBool (\rp _ -> _rpPlacementUse rp == 0
&& rpOffPathEdge (PathFromEdge edge 0) rp)
randEdgeTanks :: RandomGen g => Int -> State g [Placement]
randEdgeTanks i = do
edge <- takeOne cardList
basetank <- randomTank
return $ replicate i $ basetank
& plType . putBlock . blDraw
%~ fmap (<> noPic ( colorSH orange (verticalPipe 80
<> horPipe 80 0 (70 *.* cardVec edge))))
-- 70 is a guess, the true value depends on the distance to the wall
& plSpot .~ rprBool (\rp _ -> _rpPlacementUse rp == 0
&& rpOffPathEdge (PathFromEdge edge 0) rp)
tanksPipesRoom :: RandomGen g => State g Room
tanksPipesRoom = do
w <- state $ randomR (200,400)
h <- state $ randomR (200,400)
i <- state $ randomR (1,5)
tanks <- replicateM i randEdgeTank
w <- state $ randomR (200,300)
h <- state $ randomR (200,300)
i <- state $ randomR (2,5)
tanks <- randEdgeTanks i
return $ roomRectAutoLinks w h & rmPmnts .++~ tanks
tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room