Allow more debug interaction

This commit is contained in:
2025-10-16 10:45:37 +01:00
parent 315e6b1c04
commit df85624a49
6 changed files with 306 additions and 202 deletions
+12 -4
View File
@@ -198,17 +198,25 @@ drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p :
drawCreatureDisplayTexts :: World -> Picture
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
drawPathBetween :: World -> Picture
drawPathBetween w = concat $ do
sp <- w ^. input . heldWorldPos . at ButtonLeft
ep <- w ^. input . heldWorldPos . at ButtonRight
drawPathBetween :: Universe -> Picture
drawPathBetween u = concat $ do
sp <- case u ^. uvDebugPathShowType of
PathBetweenLeftRightClick -> w ^. input . heldWorldPos . at ButtonLeft
PathBetweenDebugV2s -> u ^? uvDebugV2_1
ep <- case u ^. uvDebugPathShowType of
PathBetweenLeftRightClick -> w ^. input . heldWorldPos . at ButtonRight
PathBetweenDebugV2s -> u ^? uvDebugV2_2
let nodepos = (`getNodePos` w)
nodelist = makePathBetween sp ep w
return . setLayer DebugLayer $
color rose (foldMap (arrowPath . mapMaybe nodepos) nodelist)
<> drawCrossCol green sp
<> drawCrossCol cyan ep
<> foldMap (color green . arrow sp) (nodepos =<< walkableNodeNear w sp)
<> foldMap (color cyan . flip arrow ep) (nodepos =<< walkableNodeNear w ep)
<> foldMap (color orange . arrow sp) (pointTowardsImpulse sp ep w)
where
w = u ^. uvWorld
drawWallsNearYou :: World -> Picture
drawWallsNearYou w = concat $ do