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

Single source of truth for wall pathing

Browse Source
This commit is contained in:
justin
2025-10-24 14:25:19 +01:00
parent 0eeae7e6bc
commit 488428b1ef
19 changed files with 156 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/PlaceSpot/Block.hs
+2 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Placement.PlaceSpot.Block (
plLineBlock,
) where
import Dodge.Wall.Pathing
import qualified Data.Set as S
import Control.Lens
import qualified Data.IntSet as IS
@@ -115,6 +116,6 @@ insertWalls wls w = foldl' (flip insertWall) w wls
insertWall :: Wall -> World -> World
insertWall wl =
uncurry (obstructPathsCrossing (S.map WallObstacle $ wl ^. wlPathFlag))
uncurry (obstructPathsCrossing (S.map WallObstacle $ getWallPathing wl))
(_wlLine wl)
. (cWorld . lWorld . walls . at (_wlID wl) ?~ wl)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+28 -17
View File
@@ -4,20 +4,21 @@ module Dodge.Placement.PlaceSpot.TriggerDoor (
updateDoorEdges,
) where
import Dodge.Default.Wall
import qualified Data.Set as S
import Dodge.ShiftPoint
import Linear
import Dodge.Data.GenWorld
import Data.List
import qualified Data.Set as S
import Dodge.Data.GenWorld
import Dodge.Default.Door
import Dodge.Default.Wall
import Dodge.LevelGen.DoorPane
import Dodge.Path
import Dodge.ShiftPoint
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Linear
plDoor ::
Bool ->
S.Set EdgeObstacle ->
-- | Opening condition
WdBl ->
@@ -28,7 +29,7 @@ plDoor ::
Point2A ->
GenWorld ->
(Int, GenWorld)
plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
plDoor isauto eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
where
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
addDoor =
@@ -45,12 +46,20 @@ plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
wlps' = rectanglePairs 9 0 (V2 l 0)
--addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
addWalls w' = foldl' (addDoorWall eo drid defaultDoorWall) w' $ zip wlids
$ wlps' & each . each %~ shiftPointBy p1
addWalls w' =
foldl' (addDoorWall isauto eo drid defaultDoorWall) w' $
zip wlids $
wlps' & each . each %~ shiftPointBy p1
addDoorWall :: S.Set EdgeObstacle
-> Int -> Wall -> World -> (Int, (Point2, Point2)) -> World
addDoorWall eo drid wl w (wlid, wlps) =
addDoorWall ::
Bool ->
S.Set EdgeObstacle ->
Int ->
Wall ->
World ->
(Int, (Point2, Point2)) ->
World
addDoorWall isauto eo drid wl w (wlid, wlps) =
w'
& cWorld . lWorld . walls
%~ IM.insert
@@ -58,23 +67,25 @@ addDoorWall eo drid wl w (wlid, wlps) =
wl
{ _wlLine = wlps
, _wlID = wlid
, _wlStructure = DoorPart drid
, _wlStructure = DoorPart drid isauto
}
where
w' = uncurry (obstructPathsCrossing eo) wlps w
updateDoorEdges :: EdgeObstacle -> [(Int,Int)] -> World -> World
updateDoorEdges :: EdgeObstacle -> [(Int, Int)] -> World -> World
updateDoorEdges eo es w = foldl' (updateDoorEdge eo) w es
updateDoorEdge :: EdgeObstacle -> World -> (Int,Int) -> World
updateDoorEdge :: EdgeObstacle -> World -> (Int, Int) -> World
--updateDoorEdge eo w (i,j) = w
updateDoorEdge _ w _ = w
-- | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
-- w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x, y)
-- | otherwise =
-- w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x, y)
plSlideDoor ::
Bool ->
Door ->
Wall ->
S.Set EdgeObstacle ->
@@ -83,7 +94,7 @@ plSlideDoor ::
Point2 ->
GenWorld ->
(Int, GenWorld)
plSlideDoor dr wl eo shiftOffset a b gw =
plSlideDoor isauto dr wl eo shiftOffset a b gw =
(drid, over gwWorld addDoorWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
where
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
@@ -95,9 +106,9 @@ plSlideDoor dr wl eo shiftOffset a b gw =
, _drZeroPos = (a, 0)
, _drOnePos = (shiftLeft a, 0)
, _drLerp = 0
, _drFootPrint = IM.fromList $ zip wlids $ rectanglePairs 9 0 (b-a)
, _drFootPrint = IM.fromList $ zip wlids $ rectanglePairs 9 0 (b - a)
}
addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs
addDoorWalls w' = foldl' (addDoorWall isauto eo drid wl) w' $ zip wlids pairs
pairs = rectanglePairs 9 a b
shiftLeft = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]