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

Cleanup door placement/auto path generation

Browse Source
This commit is contained in:
justin
2025-10-24 20:51:38 +01:00
parent b0d519c69d
commit f94b914ceb
9 changed files with 83 additions and 155 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+63 -82
View File
@@ -1,17 +1,15 @@
module Dodge.Placement.PlaceSpot.TriggerDoor (
plDoor,
plSlideDoor,
updateDoorEdges,
) where
import Dodge.Placement.PlaceSpot.Block
import Data.List
import qualified Data.Set as S
--import Data.List
import Dodge.Data.GenWorld
import Dodge.Default.Door
import Dodge.Default.Wall
import Dodge.LevelGen.DoorPane
import Dodge.Path
--import Dodge.Path
import Dodge.Placement.PlaceSpot.Block
import Dodge.ShiftPoint
import Geometry
import qualified IntMapHelp as IM
@@ -19,6 +17,7 @@ import LensHelp
import Linear
plDoor ::
-- | Is door automatic?
Bool ->
-- | Opening condition
WdBl ->
@@ -29,75 +28,72 @@ plDoor ::
Point2A ->
GenWorld ->
(Int, GenWorld)
plDoor isauto cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
plDoor isauto cond l p1 p2 gw =
( drid
, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors . at drid ?~ addDoor
-- carefull with the ordering of addWalls
)
where
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
addDoor =
IM.insert drid $
defaultDoor
{ _drID = drid
, _drTrigger = cond
, _drUpdate = DoorLerp 0.01
, _drZeroPos = p1
, _drOnePos = p2
, _drLerp = 0
, _drFootPrint = IM.fromList . zip wlids $ wlps'
}
wlids = take 4 [wlid..]
defaultDoor
{ _drID = drid
, _drTrigger = cond
, _drUpdate = DoorLerp 0.01
, _drZeroPos = p1
, _drOnePos = p2
, _drLerp = 0
, _drFootPrint = IM.fromList . zip wlids $ wlps'
}
wlids = take 4 [wlid ..]
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
wlps' = rectanglePairs 9 0 (V2 l 0)
addWalls = insertStructureWalls (`DoorPart` isauto) defaultDoorWall
(map fst wlps' & each %~ shiftPointBy p1) drid wlid
--addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
-- foldl' (addDoorWall isauto eo drid defaultDoorWall) w' $
-- zip wlids $
-- wlps' & each . each %~ shiftPointBy p1
addWalls =
insertStructureWalls
(`DoorPart` isauto)
defaultDoorWall
(map fst wlps' & each %~ shiftPointBy p1)
drid
wlid
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
wlid
wl
{ _wlLine = wlps
, _wlID = wlid
, _wlStructure = DoorPart drid isauto
}
where
w' = uncurry (obstructPathsCrossing eo) wlps w
--addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
-- foldl' (addDoorWall isauto eo drid defaultDoorWall) w' $
-- zip wlids $
-- wlps' & each . each %~ shiftPointBy p1
updateDoorEdges :: EdgeObstacle -> [(Int, Int)] -> World -> World
updateDoorEdges eo es w = foldl' (updateDoorEdge eo) w es
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)
--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
-- wlid
-- wl
-- { _wlLine = wlps
-- , _wlID = wlid
-- , _wlStructure = DoorPart drid isauto
-- }
-- where
-- w' = uncurry (obstructPathsCrossing eo) wlps w
plSlideDoor ::
Bool ->
Door ->
Wall ->
S.Set EdgeObstacle ->
Float ->
Point2 ->
Point2 ->
GenWorld ->
(Int, GenWorld)
plSlideDoor isauto dr wl eo shiftOffset a b gw =
(drid, over gwWorld addDoorWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
plSlideDoor isauto dr wl shiftOffset a b gw =
--(drid, over gwWorld addDoorWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
(drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
where
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
addDoor =
@@ -110,30 +106,15 @@ plSlideDoor isauto dr wl eo shiftOffset a b gw =
, _drLerp = 0
, _drFootPrint = IM.fromList $ zip wlids $ rectanglePairs 9 0 (b - a)
}
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)) ..]
-- old code that may help with pathing
--import Dodge.LevelGen.Pathing
--import Data.Graph.Inductive hiding ((&))
--addButtonDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> Float -> World -> (Int, World)
--addButtonDoor c btp btr a b speed w
-- = (,) 0
-- . over buttons (IM.insert bid bt)
-- $ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
-- $ set pathGraph newGraph
-- $ set pathGraphP newGraphPairs
-- $ snd (placeSlideDoor False c cond a b speed w)
-- where
-- bid = IM.newKey $ _buttons w
-- cond w' = BtNoLabel == _btState (_buttons w' IM.! bid)
-- bt = (makeButton c eff) {_btPos = btp, _btRot = btr, _btID = bid}
-- (newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg a b))
-- $ _pathGraphP w
-- newGraph = pairsToGraph dist newGraphPairs
-- insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
-- eff w' = over pathGraphP (removedPairs ++)
-- . over pathGraph (flip run_ $ insMapEdgesM $ map f removedPairs) $ w'
-- f (x,y) = (x,y,dist x y)
wlids = take 4 [wlid ..]
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
addWalls =
insertStructureWalls
(`DoorPart` isauto)
wl
(map fst pairs)
drid
wlid
-- addDoorWalls w' = foldl' (addDoorWall isauto eo drid wl) w' $ zip wlids pairs