Make chasms remove RoomPos within their boundaries

This commit is contained in:
2025-10-07 10:43:15 +01:00
parent 4cc5477f07
commit e9178f9643
12 changed files with 280 additions and 256 deletions
+3
View File
@@ -25,6 +25,7 @@ roomNgon n x = do
, _rmBound = [poly]
, _rmFloor = Tiled [makeTileFromPoly poly 2]
, _rmName = show n ++ "gon"
, _rmPos = poss
}
where
rot = 2 * pi / fromIntegral n
@@ -34,6 +35,8 @@ roomNgon n x = do
path2 = concat $ zipWith g path1 (tail path1 <> [head path1])
path3 = loopPairs path2 <> fmap (,V2 0 0) path2
path4 = concatMap doublePair path3
poss = map (\p -> RoomPos p 0 mempty (NotLink True) mempty)
(V2 0 0 : path1)
g z y = [z, 0.5 * (z + y)]
lnks =
sortOn ((\(V2 a b) -> (negate b, a)) . fst . snd)
+5 -5
View File
@@ -87,8 +87,8 @@ roomPillarsSquare = do
++ concatMap (replicate nlns . makepill) [East, West]
where
makepill edge = sps (rprBool $ \rp _ -> t edge rp) smallPillar
t edge rp = any (f edge) (_rpType rp) && null (_rpPlacementUse rp)
f edge rpt = maybe False (PathFromEdge edge 0 `S.member`) (rpt ^? offPathFromEdges)
t edge rp = any (f edge) (_rpFlags rp) && null (_rpPlacementUse rp)
f edge rpt = maybe False (PathFromEdge edge 0 `S.member`) (rpt ^? offGridFromEdges)
roomPillarsPassage :: RandomGen g => State g Room
roomPillarsPassage = do
@@ -106,16 +106,16 @@ roomPillarsPassage = do
roomPillars :: RandomGen g => Float -> Float -> Float -> Int -> Int -> State g Room
roomPillars pillarsize w h wn hn = do
let rm = roomRect w h wn hn
npillars = length $ filter rpIsOffPath $ _rmPos rm
npillars = length $ filter rpIsOffGrid $ _rmPos rm
plmnts =
replicate
npillars
( blockPillar (0.5 * pilw) (0.5 * pilh) & plSpot
.~ rprBool
( \rp _ ->
rpIsOffPath rp
rpIsOffGrid rp
&& null (_rpPlacementUse rp)
&& _rpLinkStatus rp == NotLink
&& notLink (_rpType rp)
)
)
addGirderLights $
+5 -5
View File
@@ -98,7 +98,7 @@ roomRect x y xn yn =
pth = linksGridToPath lnks
$ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
makeonpos (p, a) = RoomPos p 0 (S.singleton $ RoomPosOnGrid $ makerpedges a)
NotLink mempty
(NotLink True) mempty
makerpedges (a, b) =
S.fromList
[ PathFromEdge South b
@@ -109,7 +109,7 @@ roomRect x y xn yn =
posps = map (over _1 (+.+ V2 20 20)) $ gridPoints'' xd (xn + 1) yd (yn + 1)
interposps = map (over _1 (+.+ V2 (20 + xd / 2) (20 + yd / 2))) $ gridPoints'' xd xn yd yn
makeoffpos (p, a) = RoomPos
p 0 (S.singleton $ RoomPosOffGrid $ makerpedges' a) NotLink mempty
p 0 (S.singleton $ RoomPosOffGrid $ makerpedges' a) (NotLink False) mempty
makerpedges' (a, b) =
S.fromList
[ PathFromEdge South b
@@ -206,8 +206,8 @@ quarterRoomTri w = do
]
, _rmPmnts = b ++ [mntLS iShape (V2 (w -20) w) (V3 (w -20) (w -20) 70)]
, _rmPos =
[ RoomPos (V2 (w -20) (w -20)) pi S.empty NotLink mempty
, RoomPos (V2 (w -15) (w -25)) pi S.empty NotLink mempty
[ RoomPos (V2 (w -20) (w -20)) pi S.empty (NotLink False) mempty
, RoomPos (V2 (w -15) (w -25)) pi S.empty (NotLink False) mempty
]
, _rmBound = [[V2 0 0, V2 w w, V2 (- w) w]]
}
@@ -255,7 +255,7 @@ quarterRoomSquare w = do
]
, _rmPmnts = b ++ [blockLine (V2 (w / 2) (w / 2)) (V2 0 w)]
, _rmPos =
[ RoomPos p pi S.empty NotLink mempty
[ RoomPos p pi S.empty (NotLink False) mempty
| p <- [V2 20 (2 * w -40), V2 25 (2 * w -45)]
]
, --, _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
+2 -2
View File
@@ -77,7 +77,7 @@ glassSwitchBack = do
l2 <-
mntLightLnkCond $
rprBool $ \rp _ ->
rp ^. rpLinkStatus . rplsType . at (OnEdge West) == Just ()
rp ^. rpType . rplsType . at (OnEdge West) == Just ()
&& null (rp ^. rpPlacementUse)
let hf = hgt / 5
awindow h xl xr = windowLine (V2 xl h) (V2 xr h)
@@ -207,7 +207,7 @@ weaponBetweenPillars = do
and
[ rpIsOnGrid rp
, null $ _rpPlacementUse rp
, _rpLinkStatus rp == NotLink
, notLink (_rpType rp)
, any ((< 100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
]
ncrits <- state $ randomR (1, 3)
+14 -2
View File
@@ -1,6 +1,5 @@
module Dodge.Room.Tutorial where
import Dodge.Room.Pillar
import Dodge.Item.Held.Utility
import Control.Monad
import qualified Data.IntMap.Strict as IM
@@ -39,12 +38,25 @@ import TreeHelp
--import Data.List (intersperse)
testf = PSPos (\x _ -> f x) (\_ -> id) Nothing
where
f x = case _rpType x of
NotLink{} -> Just (PS (_rpPos x) (_rpDir x), x)
_ -> Nothing
tutAnoTree :: State LayoutVars MTRS
tutAnoTree = do
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor
, tToBTree "x" . return . cleatOnward <$> roomPillarsSquare
, tToBTree "test" . return . cleatOnward <$> (roomRectAutoLinks 100 100
<&> rmPmnts <>~
[sps0 $ PutChasm $ rectNSWE 70 30 30 70
, Placement testf (PutFlIt led) Nothing Nothing (const $ const Nothing)
]
<&> rmPos .~[RoomPos 35 0 mempty (NotLink False) mempty]
-- <&> rmPos .~[]
)
, corDoor
, tutHub
, tutLight
+1 -1
View File
@@ -69,7 +69,7 @@ lineOutputTerminal tls = defaultTerminal & tmBootLines .~ textInputBlurb tls
moveToSideNthOutLink :: S.Set UsedPos
-> Int -> RoomPos -> Room -> Maybe ((Point2, Float), S.Set UsedPos)
moveToSideNthOutLink xs i rp rm = do
j <- rp ^? rpLinkStatus . rplsChildNum
j <- rp ^? rpType . rplsChildNum
guard $ i == j
let rppos = _rpPos rp
rpdir = _rpDir rp