Readd some debug drawing (debugDraw itself still commented out)
This commit is contained in:
@@ -120,9 +120,25 @@ drawCreatureDisplayTexts :: World -> Picture
|
||||
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures w)
|
||||
|
||||
drawPathBetween :: World -> Picture
|
||||
drawPathBetween _ = mempty
|
||||
drawPathBetween w = setLayer DebugLayer
|
||||
$ color yellow (foldMap (arrowPath . mapMaybe nodepos) nodelist)
|
||||
<> foldMap (color green . arrow sp) (nodepos =<< nodelist ^? _Just . ix 0)
|
||||
<> foldMap (color cyan . flip arrow ep) (nodepos =<< lastOf traverse =<< nodelist ^? _Just)
|
||||
where
|
||||
nodepos = (`getNodePos` w)
|
||||
nodelist = makePathBetween sp ep w
|
||||
sp = _lSelect w
|
||||
ep = _rSelect w
|
||||
|
||||
drawNodesNearSelect :: World -> Picture
|
||||
drawNodesNearSelect _ = mempty
|
||||
drawNodesNearSelect w = setLayer DebugLayer $
|
||||
runIdentity (S.foldMap_ (drawZone pnZoneSize) (zoneAroundPoint pnZoneSize sp))
|
||||
-- <> color red (foldMap (drawCross . snd) $ nodesNearL sp w)
|
||||
<> color green (drawCross sp)
|
||||
-- <> color cyan (foldMap (drawCross . snd) $ walkableNodeNear sp w)
|
||||
where
|
||||
sp = _lSelect w
|
||||
|
||||
drawInspectWalls :: World -> Picture
|
||||
drawInspectWalls w = foldMap (drawInspectWall w)
|
||||
$ filter (isJust . uncurry (intersectSegSeg a b) . _wlLine)
|
||||
@@ -259,28 +275,28 @@ drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls w)
|
||||
where
|
||||
p = worldPosToScreen w $ 0.5 *.* uncurry (+.+) (_wlLine wl)
|
||||
|
||||
--edgeToPic :: [Point2] -> PathEdge -> Picture
|
||||
--edgeToPic poly pe
|
||||
-- | not (pointInPolygon sp poly) && not (pointInPolygon ep poly) = mempty
|
||||
-- | null $ _peObstacles pe
|
||||
-- = anarrow green
|
||||
-- | hasobstacle BlockObstacle
|
||||
-- = anarrow red
|
||||
-- | hasobstacle AutoDoorObstacle = anarrow yellow
|
||||
-- | otherwise = anarrow cyan
|
||||
-- where
|
||||
-- hasobstacle = (`Set.member` _peObstacles pe)
|
||||
-- anarrow col = color col $ arrow sp ep
|
||||
-- sp = _peStart pe
|
||||
-- ep = _peEnd pe
|
||||
edgeToPic :: [Point2] -> PathEdge -> Picture
|
||||
edgeToPic poly pe
|
||||
| not (pointInPolygon sp poly) && not (pointInPolygon ep poly) = mempty
|
||||
| null $ _peObstacles pe
|
||||
= anarrow green
|
||||
| hasobstacle BlockObstacle
|
||||
= anarrow red
|
||||
| hasobstacle AutoDoorObstacle = anarrow yellow
|
||||
| otherwise = anarrow cyan
|
||||
where
|
||||
hasobstacle = (`Set.member` _peObstacles pe)
|
||||
anarrow col = color col $ arrow sp ep
|
||||
sp = _peStart pe
|
||||
ep = _peEnd pe
|
||||
|
||||
drawPathing :: Configuration -> World -> Picture
|
||||
drawPathing cfig w = setLayer DebugLayer mempty
|
||||
-- $ foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
|
||||
-- <> concatMap dispInc (graphToIncidence gr)
|
||||
-- where
|
||||
-- dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
|
||||
-- gr = _pathGraph w
|
||||
drawPathing cfig w = setLayer DebugLayer
|
||||
$ foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
|
||||
<> concatMap dispInc (graphToIncidence gr)
|
||||
where
|
||||
dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
|
||||
gr = _pathGraph w
|
||||
|
||||
crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String])
|
||||
crDisplayInfo cfig w cr
|
||||
|
||||
Reference in New Issue
Block a user