Somewhat simplify RoomPos types

This commit is contained in:
2025-10-05 20:47:28 +01:00
parent 43db5a2ebc
commit 4cc5477f07
5 changed files with 17 additions and 22 deletions
+3 -4
View File
@@ -64,6 +64,7 @@ data RPLinkStatus
, _rplsInRoomID :: Int , _rplsInRoomID :: Int
} }
| UnusedLink {_rplsType :: S.Set RoomLinkType} | UnusedLink {_rplsType :: S.Set RoomLinkType}
| PathNodeRP
| NotLink | NotLink
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
@@ -71,10 +72,8 @@ data PathFromEdge = PathFromEdge CardinalPoint Int
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
data RoomPosType data RoomPosType
= RoomPosOnPath {_onPathFromEdges :: S.Set PathFromEdge} = RoomPosOnGrid {_onPathFromEdges :: S.Set PathFromEdge}
| RoomPosOffPath {_offPathFromEdges :: S.Set PathFromEdge} | RoomPosOffGrid {_offPathFromEdges :: S.Set PathFromEdge}
| RoomPosExLink
| RoomPosLab Int
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
data UsedPos data UsedPos
+5 -12
View File
@@ -2,10 +2,9 @@
module Dodge.PlacementSpot ( module Dodge.PlacementSpot (
atFstLnkOut, atFstLnkOut,
atNthLnkOutShiftBy, atNthLnkOutShiftBy,
rpIsOnPath, rpIsOnGrid,
rpIsOffPath, rpIsOffPath,
rpOffPathFromEdge, rpOffPathFromEdge,
rpOnPathFromEdge,
useUnusedLnk, useUnusedLnk,
psRandRanges, psRandRanges,
useRoomPosCond, useRoomPosCond,
@@ -73,16 +72,16 @@ psposAddLabel lab = psSelect %~ (\f rp r -> f rp r & _Just . _2 . rpType %~ S.in
rprBool :: (RoomPos -> Room -> Bool) -> PlacementSpot rprBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
rprBool t = PSPos (useRoomPosRoomCond (S.singleton UsedPosLow) t) (const id) Nothing rprBool t = PSPos (useRoomPosRoomCond (S.singleton UsedPosLow) t) (const id) Nothing
rpIsOnPath :: RoomPos -> Bool rpIsOnGrid :: RoomPos -> Bool
rpIsOnPath = any f . _rpType rpIsOnGrid = any f . _rpType
where where
f RoomPosOnPath{} = True f RoomPosOnGrid{} = True
f _ = False f _ = False
rpIsOffPath :: RoomPos -> Bool rpIsOffPath :: RoomPos -> Bool
rpIsOffPath = any f . _rpType rpIsOffPath = any f . _rpType
where where
f RoomPosOffPath{} = True f RoomPosOffGrid{} = True
f _ = False f _ = False
rpOffPathFromEdge :: PathFromEdge -> RoomPos -> Bool rpOffPathFromEdge :: PathFromEdge -> RoomPos -> Bool
@@ -90,12 +89,6 @@ rpOffPathFromEdge pe = any f . _rpType
where where
f rt = maybe False (pe `elem`) (rt ^? offPathFromEdges) f rt = maybe False (pe `elem`) (rt ^? offPathFromEdges)
-- test whether a roomPos is on the path with a given from edge value
rpOnPathFromEdge :: PathFromEdge -> RoomPos -> Bool
rpOnPathFromEdge pe = any f . _rpType
where
f rt = maybe False (pe `elem`) (rt ^? onPathFromEdges)
resetPLUse :: PlacementSpot -> PlacementSpot resetPLUse :: PlacementSpot -> PlacementSpot
resetPLUse (PSPos f g fallback) = PSPos f' g fallback resetPLUse (PSPos f g fallback) = PSPos f' g fallback
where where
+2 -2
View File
@@ -97,7 +97,7 @@ roomRect x y xn yn =
. zipCountDown . zipCountDown
pth = linksGridToPath lnks pth = linksGridToPath lnks
$ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn) $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
makeonpos (p, a) = RoomPos p 0 (S.singleton $ RoomPosOnPath $ makerpedges a) makeonpos (p, a) = RoomPos p 0 (S.singleton $ RoomPosOnGrid $ makerpedges a)
NotLink mempty NotLink mempty
makerpedges (a, b) = makerpedges (a, b) =
S.fromList S.fromList
@@ -109,7 +109,7 @@ roomRect x y xn yn =
posps = map (over _1 (+.+ V2 20 20)) $ gridPoints'' xd (xn + 1) yd (yn + 1) 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 interposps = map (over _1 (+.+ V2 (20 + xd / 2) (20 + yd / 2))) $ gridPoints'' xd xn yd yn
makeoffpos (p, a) = RoomPos makeoffpos (p, a) = RoomPos
p 0 (S.singleton $ RoomPosOffPath $ makerpedges' a) NotLink mempty p 0 (S.singleton $ RoomPosOffGrid $ makerpedges' a) NotLink mempty
makerpedges' (a, b) = makerpedges' (a, b) =
S.fromList S.fromList
[ PathFromEdge South b [ PathFromEdge South b
+4 -4
View File
@@ -205,7 +205,7 @@ weaponBetweenPillars = do
(h, hn) <- takeOne [(240, 2), (340, 3)] (h, hn) <- takeOne [(240, 2), (340, 3)]
let wpPos = rprBool $ \rp r -> let wpPos = rprBool $ \rp r ->
and and
[ rpIsOnPath rp [ rpIsOnGrid rp
, null $ _rpPlacementUse rp , null $ _rpPlacementUse rp
, _rpLinkStatus rp == NotLink , _rpLinkStatus rp == NotLink
, any ((< 100) . dist (_rpPos rp)) (usedRoomInLinkPoss r) , any ((< 100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
@@ -215,7 +215,7 @@ weaponBetweenPillars = do
critPlacementSpots <- replicateM ncrits $ critPlacementSpots <- replicateM ncrits $
randDirPS $ randDirPS $
rprBool $ \rp r -> rprBool $ \rp r ->
rpIsOnPath rp rpIsOnGrid rp
&& null (_rpPlacementUse rp) && null (_rpPlacementUse rp)
&& all ((> 100) . dist (_rpPos rp)) (usedRoomLinkPoss r) && all ((> 100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
( roomPillars 30 w h wn hn ( roomPillars 30 w h wn hn
@@ -334,7 +334,7 @@ pistolerRoom = do
.++~ replicate .++~ replicate
3 3
( psPtPl ( psPtPl
(rprBool $ \rp _ -> null (_rpPlacementUse rp) && rpIsOnPath rp) (rprBool $ \rp _ -> null (_rpPlacementUse rp) && rpIsOnGrid rp)
(PutCrit chaseCrit) (PutCrit chaseCrit)
) )
@@ -374,7 +374,7 @@ spawnerRoom = do
roomC x y <&> rmPmnts roomC x y <&> rmPmnts
.:~ psPtPl .:~ psPtPl
( rprBool $ \rp _ -> ( rprBool $ \rp _ ->
null (_rpPlacementUse rp) && rpIsOnPath rp null (_rpPlacementUse rp) && rpIsOnGrid rp
&& xV2 (_rpPos rp) < x / 2 && xV2 (_rpPos rp) < x / 2
&& yV2 (_rpPos rp) < y / 2 && yV2 (_rpPos rp) < y / 2
) )
+3
View File
@@ -1,5 +1,6 @@
module Dodge.Room.Tutorial where module Dodge.Room.Tutorial where
import Dodge.Room.Pillar
import Dodge.Item.Held.Utility import Dodge.Item.Held.Utility
import Control.Monad import Control.Monad
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
@@ -43,6 +44,8 @@ tutAnoTree = do
foldMTRS foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor , corDoor
, tToBTree "x" . return . cleatOnward <$> roomPillarsSquare
, corDoor
, tutHub , tutHub
, tutLight , tutLight
, tutDrop , tutDrop