justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Non-convex chasms

Browse Source
This commit is contained in:
justin
2026-01-26 10:59:51 +00:00
parent 962df63e62
commit a6976eae8d
11 changed files with 341 additions and 323 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/PlaceSpot.hs
+9 -6
View File
@@ -142,7 +142,8 @@ placeSpotID rid ps pt w = case pt of
PutNothing -> (0, w)
PutID i -> (i, w)
PutWorldUpdate f -> (0, w & f rid ps)
PutChasm ps' -> (0, placeChasm w rid ps' $ map doShift ps')
PutChasm ps' qs -> (0, placeChasm w rid ps' (map (map doShift) ps')
(foldMap loopPairs (map (map doShift) qs)))
PutLabel{} -> (0, w)
where
p@(V2 px py) = _psPos ps
@@ -151,13 +152,15 @@ placeSpotID rid ps pt w = case pt of
doShift = shiftPointBy (p, rot)
pashift = compP2A (p, rot)
placeChasm :: GenWorld -> Int -> [Point2] -> [Point2] -> GenWorld
placeChasm gw rid ps shiftps =
gw & gwWorld . cWorld . chasms .:~ shiftps
& genRooms . ix rid . rmPos %~ filter (\rp -> not $ pointInPoly (_rpPos rp) ps)
placeChasm :: GenWorld -> Int -> [[Point2]] -> [[Point2]] -> [(Point2,Point2)] -> GenWorld
placeChasm gw rid ps shiftps cfs =
gw & gwWorld . cWorld . chasms <>~ shiftps
& gwWorld . cWorld . cliffs <>~ cfs
& genRooms . ix rid . rmPos %~ filter (\rp -> not $ any (pointInPoly (_rpPos rp)) ps)
& gwWorld %~ f
where
f w = foldl' g w (loopPairs shiftps)
--f w = foldl' g w (loopPairs shiftps)
f w = foldl' g w cfs
g w (x, y) = obstructPathsCrossing (S.singleton ChasmObstacle) x y w
placeWallPoly :: [Point2] -> Wall -> World -> World