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

Initial replacement of FGL with incidence representation, use A*

Browse Source
This commit is contained in:
justin
2025-10-21 11:47:49 +01:00
parent c250448d57
commit 0b997579ad
5 changed files with 97 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files
package.yaml
+1
View File
@@ -55,6 +55,7 @@ dependencies:
- tasty-quickcheck
- list-tries
- Hclip
- search-algorithms
library:
source-dirs: src
src/Dodge/Debug/Picture.hs
+11 -2
View File
@@ -404,8 +404,8 @@ drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls
p = worldPosToScreen (w ^. wCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
drawPathing :: Config -> World -> Picture
drawPathing cfig w =
drawPathing' :: Config -> World -> Picture
drawPathing' cfig w =
setLayer DebugLayer $
foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
<> foldMap dispInc (graphToIncidence gr)
@@ -413,6 +413,15 @@ drawPathing cfig w =
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
gr = w ^. cWorld . pathGraph
drawPathing :: Config -> World -> Picture
drawPathing cfig w =
setLayer DebugLayer $ ifoldMap f $ w ^. cWorld . incGraph
where
inodes = w ^. cWorld . incNode
f i = foldMap (g i)
g i (j,se) = edgeToPic (screenPolygon cfig (w ^.wCam))
(PathEdge (inodes ^?! ix i) (inodes ^?! ix j) 0 (se ^. seObstacles))
edgeToPic :: [Point2] -> PathEdge -> Picture
edgeToPic poly pe
| not (pointInPoly sp poly) && not (pointInPoly ep poly) = mempty
src/Dodge/Path.hs
+47 -7
View File
@@ -13,10 +13,12 @@ module Dodge.Path (
pairsToIncGraph,
) where
import Control.Lens
import qualified Algorithm.Search as AS
import Dodge.Zoning.Common
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV
import Control.Lens
import Data.Bifunctor
--import Data.Bifunctor
import Data.Foldable
import Data.Graph.Inductive hiding ((&))
import Data.List (sortOn)
@@ -36,24 +38,52 @@ import qualified IntMapHelp as IM
getNodePos :: Int -> World -> Maybe Point2
getNodePos i w = (w ^. cWorld . pathGraph) `lab` i
makePathUsing :: (PathEdge -> Bool) -> Point2 -> Point2 -> World -> Maybe [Int]
--makePathUsing' :: (PathEdge -> Bool) -> Point2 -> Point2 -> World -> Maybe [Int]
--makePathUsing' t s e w = do
-- na <- walkableNodeNear w s
-- nb <- walkableNodeNear w e
-- sp na nb . second _peDist . efilter (^. _3 . to t) $ w ^. cWorld . pathGraph
makePathUsing :: (Set.Set EdgeObstacle -> Bool) -> Point2 -> Point2 -> World -> Maybe [Int]
makePathUsing t s e w = do
na <- walkableNodeNear w s
nb <- walkableNodeNear w e
sp na nb . second _peDist . efilter (^. _3 . to t) $ w ^. cWorld . pathGraph
let f i = getes i
h i = distance (getn nb) (getn i)
(na :) . snd <$> AS.aStarAssoc f h (==nb) na
where
g (i,SimpleEdge c o)
| t o = Just (i,c)
| otherwise = Nothing
getes i = mapMaybe g $ w ^?! cWorld . incGraph . ix i
getn i = w ^?! cWorld . incNode . ix i
-- sp na nb . second _peDist . efilter (^. _3 . to t) $ w ^. cWorld . pathGraph
makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
makePathBetween = makePathUsing $ not . pathEdgeObstructed
pathEdgeObstructed :: PathEdge -> Bool
pathEdgeObstructed pe =
pathEdgeObstructed' :: PathEdge -> Bool
pathEdgeObstructed' pe =
any
(`Set.member` _peObstacles pe)
[DoorObstacle, BlockObstacle, ChasmObstacle]
pathEdgeObstructed :: Set.Set EdgeObstacle -> Bool
pathEdgeObstructed pe =
any
(`Set.member` pe)
[DoorObstacle, BlockObstacle, ChasmObstacle]
walkableNodeNear :: World -> Point2 -> Maybe Int
{-# INLINE walkableNodeNear #-}
walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
where
nodesNear = zonesExtract (w ^. incNodeZoning) . snailAround $ zoneOfPoint pnZoneSize p
walkableNodeNear' :: World -> Point2 -> Maybe Int
{-# INLINE walkableNodeNear' #-}
walkableNodeNear' w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
where
nodesNear = zonesExtract (w ^. pnZoning) . snailAround $ zoneOfPoint pnZoneSize p
@@ -130,7 +160,8 @@ pairsToIncGraph :: Set.Set (Point2,Point2)
, V.Vector [(Int,SimpleEdge)]
, [(Int,Int)]
)
pairsToIncGraph pairs = (inodes,incgraph,undefined)
pairsToIncGraph pairs = (inodes,incgraph
,Set.toList pairs & each . each %~ (\i -> pstons ^?! ix i . _head))
where
incgraph = V.generate (length im) (\i -> im ^?! ix i)
im = IM.fromListWith (<>) . fmap toedge $ Set.toList pairs
@@ -178,9 +209,18 @@ obstructPathsCrossing ::
(World, Set PathEdgeNodes)
obstructPathsCrossing obstacletype sp' ep w =
( w & cWorld . pathGraph %~ updateedges
& cWorld . incGraph %~ updateincedges
, es
)
where
updateincedge :: V.Vector [(Int,SimpleEdge)] -> (Int,Int) -> V.Vector [(Int,SimpleEdge)]
updateincedge gr (i,j) = gr & ix i . each %~ g j
g j (k,o) | j == k = (k,o & seObstacles . at obstacletype ?~ ())
| otherwise = (k,o)
updateincedges gr = foldl' updateincedge gr inces
inces = filter inedgecrosses $ nearSeg peZoneSize _incEdgeZoning sp' ep w
inedgecrosses (i,j) = isJust $ intersectSegSeg sp' ep (f i) (f j)
f i = w ^?! cWorld . incNode . ix i
es = Set.filter edgecrosses $ pesNearSeg sp' ep w
edgecrosses (PathEdgeNodes _ _ pe) =
isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe)
src/Dodge/Room/Room.hs
+3 -3
View File
@@ -399,9 +399,9 @@ critsRoom :: Int -> State LayoutVars (Tree Room)
critsRoom i =
join $
takeOne
[ return <$> roomCCrits i
, return <$> critsPillarRoom i
, return <$> glassSwitchBackCrits i
-- [ return <$> roomCCrits i
-- , return <$> critsPillarRoom i
[ return <$> glassSwitchBackCrits i
]
-- cor <- shuffleLinks corridor
tags
+35 -31
View File
@@ -2531,7 +2531,7 @@ addDepth src/Picture/Base.hs 133;" f
addDoorAtNthLinkToggleTerminal src/Dodge/Room/Warning.hs 40;" f
addDoorToggleTerminal src/Dodge/Room/Warning.hs 37;" f
addDoorWall src/Dodge/Placement/PlaceSpot/TriggerDoor.hs 53;" f
addEdges src/Dodge/Path.hs 154;" f
addEdges src/Dodge/Path.hs 188;" f
addGib4 src/Dodge/Prop/Gib.hs 52;" f
addGibAt src/Dodge/Prop/Gib.hs 63;" f
addGibAtDir src/Dodge/Prop/Gib.hs 69;" f
@@ -2546,7 +2546,7 @@ addGirderNS' src/Dodge/Room/Modify/Girder.hs 55;" f
addHighGirder src/Dodge/Room/Modify/Girder.hs 132;" f
addHighGirder' src/Dodge/Room/Modify/Girder.hs 142;" f
addIndefiniteArticle src/StringHelp.hs 17;" f
addNodes src/Dodge/Path.hs 147;" f
addNodes src/Dodge/Path.hs 181;" f
addPane src/Dodge/Placement/PlaceSpot.hs 183;" f
addPlmnt src/Dodge/LevelGen/PlacementHelper.hs 87;" f
addPointPolygon src/Geometry/Polygon.hs 134;" f
@@ -2702,7 +2702,7 @@ battery src/Dodge/Item/Ammo.hs 63;" f
batteryPack src/Dodge/Item/Equipment.hs 46;" f
belowNumX src/Dodge/Combine/Graph.hs 86;" f
beltMag src/Dodge/Item/Ammo.hs 39;" f
bfsNodePoints src/Dodge/Path.hs 72;" f
bfsNodePoints src/Dodge/Path.hs 102;" f
bfsThenReturn src/Dodge/Creature/ReaderUpdate.hs 225;" f
bgateCalc src/Dodge/Inventory/SelectionList.hs 118;" f
bgunSound src/Dodge/HeldUse.hs 514;" f
@@ -3238,8 +3238,8 @@ doFloatFloat src/Dodge/FloatFunction.hs 5;" f
doGenFloat src/Dodge/HeldUse.hs 1158;" f
doGravityPU src/Dodge/Projectile/Update.hs 34;" f
doHeldUseEffect src/Dodge/HeldUse.hs 351;" f
doInPlacements src/Dodge/Layout.hs 88;" f
doIndividualPlacements src/Dodge/Layout.hs 102;" f
doInPlacements src/Dodge/Layout.hs 90;" f
doIndividualPlacements src/Dodge/Layout.hs 104;" f
doInputScreenInput src/Dodge/Update/Input/ScreenLayer.hs 28;" f
doItemTimeScroll src/Dodge/Update.hs 193;" f
doLoop src/Loop.hs 60;" f
@@ -3252,7 +3252,7 @@ doQuickload src/Dodge/Save.hs 82;" f
doQuicksave src/Dodge/Save.hs 77;" f
doRandImpulse src/Dodge/RandImpulse.hs 7;" f
doRegexInput src/Dodge/Update/Input/InGame.hs 447;" f
doRoomPlacements src/Dodge/Layout.hs 105;" f
doRoomPlacements src/Dodge/Layout.hs 107;" f
doRoomShift src/Dodge/Room/Link.hs 33;" f
doScopeZoom src/Dodge/Update/Scroll.hs 91;" f
doSectionSize src/Dodge/DisplayInventory.hs 211;" f
@@ -3371,7 +3371,8 @@ drawMovingShapeCol src/Dodge/Prop/Draw.hs 87;" f
drawOptions src/Dodge/Render/MenuScreen.hs 22;" f
drawPathBetween src/Dodge/Debug/Picture.hs 201;" f
drawPathEdge src/Dodge/Debug/Picture.hs 266;" f
drawPathing src/Dodge/Debug/Picture.hs 407;" f
drawPathing src/Dodge/Debug/Picture.hs 416;" f
drawPathing' src/Dodge/Debug/Picture.hs 407;" f
drawPlus src/Dodge/Render/Picture.hs 165;" f
drawPointLabel src/Dodge/Render/Label.hs 13;" f
drawProjectile src/Dodge/Projectile/Draw.hs 13;" f
@@ -3451,7 +3452,7 @@ ebEffect src/Dodge/EnergyBall.hs 45;" f
ebFlicker src/Dodge/EnergyBall.hs 70;" f
ebtToDamage src/Dodge/EnergyBall.hs 93;" f
edgeFormatting src/Dodge/Combine/Graph.hs 131;" f
edgeToPic src/Dodge/Debug/Picture.hs 416;" f
edgeToPic src/Dodge/Debug/Picture.hs 425;" f
effectOnEquip src/Dodge/Equipment.hs 32;" f
effectOnRemove src/Dodge/Equipment.hs 19;" f
eitType src/Dodge/Data/EquipType.hs 15;" f
@@ -3596,9 +3597,9 @@ gLauncher src/Dodge/Item/Held/Launcher.hs 24;" f
gRandify src/Dodge/Randify.hs 11;" f
gadgetEffect src/Dodge/HeldUse.hs 47;" f
gameOverMenu src/Dodge/Menu.hs 207;" f
gameRoomFromRoom src/Dodge/Layout.hs 153;" f
gameRoomFromRoom src/Dodge/Layout.hs 155;" f
gameRoomViewpoints src/Dodge/Viewpoints.hs 35;" f
gameRoomsFromRooms src/Dodge/Layout.hs 150;" f
gameRoomsFromRooms src/Dodge/Layout.hs 152;" f
gameplayMenu src/Dodge/Menu.hs 154;" f
gameplayMenuOptions src/Dodge/Menu.hs 157;" f
gasType src/Dodge/HeldUse.hs 1115;" f
@@ -3636,7 +3637,7 @@ getLaserPhaseV src/Dodge/HeldUse.hs 701;" f
getLinksOfType src/Dodge/RoomLink.hs 41;" f
getMaxLinesTM src/Dodge/Terminal/Type.hs 6;" f
getMenuMouseContext src/Dodge/Update.hs 388;" f
getNodePos src/Dodge/Path.hs 36;" f
getNodePos src/Dodge/Path.hs 38;" f
getPJStabiliser src/Dodge/HeldUse.hs 1251;" f
getPretty src/AesonHelp.hs 8;" f
getPromptTM src/Dodge/Terminal/Type.hs 3;" f
@@ -3646,7 +3647,7 @@ getRootItemInvID src/Dodge/Inventory/Location.hs 35;" f
getSelectedCloseObj src/Dodge/SelectedClose.hs 14;" f
getSmoothScrollValue src/Dodge/SmoothScroll.hs 21;" f
getSplitString src/Dodge/Debug/Terminal.hs 129;" f
getTiles src/Dodge/Layout.hs 200;" f
getTiles src/Dodge/Layout.hs 202;" f
getViewpoints src/Dodge/Viewpoints.hs 29;" f
getVolleyBurst src/Dodge/HeldUse.hs 126;" f
getWallSPic src/Dodge/Render/Walls.hs 51;" f
@@ -4116,9 +4117,9 @@ makeIntInterval src/Dodge/Zoning/Base.hs 35;" f
makeMovingEB src/Dodge/EnergyBall.hs 60;" f
makeMuzzleFlare src/Dodge/HeldUse.hs 656;" f
makeParagraph src/Justify.hs 6;" f
makePathBetween src/Dodge/Path.hs 45;" f
makePathBetweenPs src/Dodge/Path.hs 69;" f
makePathUsing src/Dodge/Path.hs 39;" f
makePathBetween src/Dodge/Path.hs 63;" f
makePathBetweenPs src/Dodge/Path.hs 99;" f
makePathUsing src/Dodge/Path.hs 47;" f
makePoisonExplosionAt src/Dodge/WorldEvent/Explosion.hs 25;" f
makeRect src/Grid.hs 82;" f
makeSelectionListPictures src/Dodge/Render/List.hs 66;" f
@@ -4322,7 +4323,7 @@ numShads src/Picture/Data.hs 40;" f
numSubElements src/Shader/Parameters.hs 39;" f
numTraversable src/TreeHelp.hs 184;" f
obstacleColor src/Dodge/Debug/Picture.hs 271;" f
obstructPathsCrossing src/Dodge/Path.hs 170;" f
obstructPathsCrossing src/Dodge/Path.hs 204;" f
oldMachineBootS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 698;" f
onEquipWristShield src/Dodge/Equipment.hs 37;" f
onRemoveWristShield src/Dodge/Equipment.hs 24;" f
@@ -4370,8 +4371,8 @@ p src/ShortShow.hs 48;" f
pContID src/Dodge/LevelGen/PlacementHelper.hs 15;" f
pairInPolys src/Dodge/Room/Path.hs 45;" f
pairPolyPointsIntersect src/Geometry/ConvexPoly.hs 68;" f
pairsToGraph src/Dodge/Path.hs 140;" f
pairsToIncGraph src/Dodge/Path.hs 128;" f
pairsToGraph src/Dodge/Path.hs 174;" f
pairsToIncGraph src/Dodge/Path.hs 158;" f
pairsToIncidence src/Dodge/Graph.hs 20;" f
pairsToSCC src/Dodge/Graph.hs 32;" f
paletteToColor src/Color.hs 58;" f
@@ -4379,7 +4380,8 @@ parseItem src/Dodge/Debug/Terminal.hs 62;" f
parseNum src/Dodge/Debug/Terminal.hs 77;" f
passthroughLockKeyLists src/Dodge/Floor.hs 120;" f
pathConnected src/Dodge/Room/CheckConsistency.hs 13;" f
pathEdgeObstructed src/Dodge/Path.hs 48;" f
pathEdgeObstructed src/Dodge/Path.hs 72;" f
pathEdgeObstructed' src/Dodge/Path.hs 66;" f
pauseAndFloatCam src/Dodge/Camera.hs 10;" f
pauseGame src/Dodge/Update/Input/InGame.hs 525;" f
pauseMenu src/Dodge/Menu.hs 59;" f
@@ -4465,7 +4467,7 @@ pointInOrOnPolygon src/Geometry/Polygon.hs 78;" f
pointInPoly src/Geometry/Polygon.hs 86;" f
pointIsInCone src/Geometry.hs 375;" f
pointIsOnScreen src/Dodge/Base/Window.hs 59;" f
pointTowardsImpulse src/Dodge/Path.hs 77;" f
pointTowardsImpulse src/Dodge/Path.hs 107;" f
pointerToItem src/Dodge/Item/Location.hs 39;" f
pointerToItemID src/Dodge/Item/Location.hs 42;" f
pointerYourRootItem src/Dodge/Item/Location.hs 33;" f
@@ -4651,7 +4653,7 @@ randSpark src/Dodge/Spark.hs 69;" f
randSparkExtraVel src/Dodge/Spark.hs 92;" f
randWallReflect src/Dodge/Update.hs 643;" f
randomChallenges src/Dodge/Room/Start.hs 63;" f
randomCompass src/Dodge/Layout.hs 61;" f
randomCompass src/Dodge/Layout.hs 63;" f
randomFourCornerRoom src/Dodge/Room/Procedural.hs 268;" f
randomFourCornerRoomCrsIts src/Dodge/Room/Procedural.hs 280;" f
randomLightPositions src/Dodge/Room/Modify/Girder.hs 152;" f
@@ -4912,8 +4914,8 @@ setShaderSource src/Shader/Compile.hs 290;" f
setShadowLimits src/Dodge/Shadows.hs 11;" f
setSoundVolume src/Sound.hs 157;" f
setTargetMv src/Dodge/Creature/ReaderUpdate.hs 82;" f
setTile src/Dodge/Layout.hs 71;" f
setTiles src/Dodge/Layout.hs 68;" f
setTile src/Dodge/Layout.hs 73;" f
setTiles src/Dodge/Layout.hs 70;" f
setToggle src/Dodge/Prop/Update.hs 44;" f
setTreeInts src/Dodge/Room/Tutorial.hs 72;" f
setViewDistance src/Dodge/Update/Camera.hs 236;" f
@@ -4937,7 +4939,7 @@ setupVBOStatic src/Shader/Compile.hs 116;" f
setupVBOVAO src/Shader/Compile.hs 200;" f
setupVertexAttribPointer src/Shader/Compile.hs 224;" f
setupVertexAttribs src/Shader/Compile.hs 218;" f
setupWorldBounds src/Dodge/Layout.hs 117;" f
setupWorldBounds src/Dodge/Layout.hs 119;" f
sfInvColor src/Dodge/Item/InventoryColor.hs 12;" f
shadVBOptr src/Shader.hs 40;" f
shaderTypeExt src/Shader/Compile.hs 172;" f
@@ -5008,7 +5010,7 @@ shrinkPolyOnEdges src/Geometry/Polygon.hs 174;" f
shrinkVert src/Geometry/Polygon.hs 178;" f
shuffle src/RandomHelp.hs 49;" f
shuffleLinks src/Dodge/Room/Link.hs 30;" f
shuffleRoomPos src/Dodge/Layout.hs 83;" f
shuffleRoomPos src/Dodge/Layout.hs 85;" f
shuffleTail src/RandomHelp.hs 59;" f
sigmoid src/Dodge/Base.hs 151;" f
simpleCrSprings src/Dodge/Update.hs 861;" f
@@ -5040,11 +5042,11 @@ smallGlass3S src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 518;" f
smallGlass4S src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 466;" f
smallPillar src/Dodge/Room/Pillar.hs 37;" f
smallRoom src/Dodge/Room/RunPast.hs 31;" f
smallSnailInt2 src/Dodge/Path.hs 63;" f
smallSnailInt2 src/Dodge/Path.hs 93;" f
smg src/Dodge/Item/Held/Stick.hs 58;" f
smokeReducer src/Dodge/Item/Scope.hs 162;" f
snailAround src/Dodge/Path.hs 60;" f
snapToGrid src/Dodge/Path.hs 188;" f
snailAround src/Dodge/Path.hs 90;" f
snapToGrid src/Dodge/Path.hs 231;" f
sndV2 src/Geometry/Data.hs 73;" f
sniperRifle src/Dodge/Item/Held/Rod.hs 44;" f
someCrits src/Dodge/LockAndKey.hs 120;" f
@@ -5236,7 +5238,7 @@ thingsHitZ src/Dodge/WorldEvent/ThingsHit.hs 44;" f
threeLineDecoration src/Dodge/Placement/TopDecoration.hs 61;" f
throwItem src/Dodge/Creature/Action.hs 190;" f
tileTexCoords src/Tile.hs 11;" f
tilesFromRooms src/Dodge/Layout.hs 197;" f
tilesFromRooms src/Dodge/Layout.hs 199;" f
tilesToLine src/Shader/AuxAddition.hs 66;" f
timeFlowUpdate src/Dodge/Update.hs 169;" f
timeScroller src/Dodge/Item/Held/Utility.hs 42;" f
@@ -5574,13 +5576,14 @@ vocalizationTest src/Dodge/Creature/Vocalization.hs 42;" f
volleyGun src/Dodge/Item/Held/Cane.hs 15;" f
volleyGunShape src/Dodge/Item/Draw/SPic.hs 357;" f
walkNozzle src/Dodge/HeldUse.hs 809;" f
walkableNodeNear src/Dodge/Path.hs 54;" f
walkableNodeNear src/Dodge/Path.hs 78;" f
walkableNodeNear' src/Dodge/Path.hs 84;" f
wallBlips src/Dodge/RadarSweep.hs 99;" f
wallBuffer src/Dodge/WallCreatureCollisions.hs 53;" f
wallIsZeroLength src/Dodge/LevelGen/StaticWalls.hs 179;" f
wallLine src/Dodge/Placement/Instance/Wall.hs 71;" f
wallToSurface src/Dodge/Base/Collide.hs 182;" f
wallsFromRooms src/Dodge/Layout.hs 138;" f
wallsFromRooms src/Dodge/Layout.hs 140;" f
wallsToDraw src/Dodge/Render/Walls.hs 17;" f
warmupSound src/Dodge/HeldUse.hs 1376;" f
warningRooms src/Dodge/Room/Warning.hs 30;" f
@@ -5684,6 +5687,7 @@ zoneCreatures src/Dodge/Update.hs 512;" f
zoneDust src/Dodge/Zoning/Cloud.hs 48;" f
zoneDusts src/Dodge/Update.hs 480;" f
zoneExtract src/Dodge/Zoning/Base.hs 52;" f
zoneIncPe src/Dodge/Zoning/Pathing.hs 66;" f
zoneMonoid src/Dodge/Zoning/Base.hs 83;" f
zoneOfCirc src/Dodge/Zoning/Base.hs 24;" f
zoneOfCl src/Dodge/Zoning/Cloud.hs 24;" f