Make Placement into a product type

This commit is contained in:
2025-09-02 12:31:55 +01:00
parent dc13c61dca
commit f278af0f30
29 changed files with 168 additions and 168 deletions
+22 -22
View File
@@ -41,13 +41,13 @@ roomC w h = do
maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0]
maybeaddgird
=<< shuffleLinks
( roomRectAutoLinks w h
& rmLinks
=<< ( 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))
& rmRandPSs .~ [farside]
<&> rmPmnts .:~ wallf (V2 (w / 2) 0) (V2 (w / 2) (h -60))
<&> rmRandPSs .~ [farside]
)
where
farside = do
@@ -118,6 +118,14 @@ roomMiniIntro = do
roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = do
l1 <- mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
l2 <- mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isOutLnk rp)
let plmnts =
[ blockLine (V2 115 115) (V2 115 125)
, blockLine (V2 125 115) (V2 125 125)
, l1
, l2
]
addHighGirder'
=<< ( shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst) $
cleatSide $
@@ -126,24 +134,18 @@ roomCenterPillar = do
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)
]
weaponEmptyRoom :: State StdGen (Tree Room)
weaponEmptyRoom = do
w <- state $ randomR (220, 300)
h <- state $ randomR (220, 300)
wp <- randFirstWeapon
thelight <- 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
, thelight
]
f (V2 x y, a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
rm <-
@@ -153,7 +155,7 @@ weaponEmptyRoom = do
weaponUnderCrits :: RandomGen g => State g (MetaTree Room String)
weaponUnderCrits = do
let addwpat p = rmPmnts .:~(sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon)
let addwpat p = rmPmnts .:~ (sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon)
continuationRoom =
treePost
[ addwpat (V2 20 0) corridorN
@@ -296,21 +298,19 @@ shootersRoom' = do
, 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]
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 $
shootersRoom1 = do
pl <- ( takeOne $
map
(\i -> psPtPl (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
[0, 1, 2]
)
shootersRoom' <&> rmPmnts
.:~ pl
shootersRoom :: RandomGen g => State g Room
shootersRoom =