Add pathing infrastructure

src/Dodge/Render/ShapePicture.hs

@@ -34,6 +34,7 @@ import qualified Data.Set as Set
 import Control.Lens
 import Data.Maybe
 import qualified Streaming.Prelude as S
+import qualified Data.Graph.Inductive as FGL
 
 -- TODO only filter out shapes outside the range of the furthest shown light source
 worldSPic :: Configuration -> World -> SPic
@@ -110,7 +111,7 @@ debugDraw' cfig w bl = case bl of
     Cr_status               -> Right $ drawCrInfo cfig w
     Mouse_position          -> Right $ drawMousePosition cfig w
     Walls_info              -> Right $ drawWlIDs cfig w
-    Pathing                 -> Right $ drawPathing w
+    Pathing                 -> Right $ drawPathing cfig w
     Show_nodes_near_select  -> Right $ drawNodesNearSelect w
 
 drawCreatureDisplayTexts :: World -> Picture
@@ -118,7 +119,7 @@ drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures w)
 
 drawNodesNearSelect :: World -> Picture
 drawNodesNearSelect w = setLayer DebugLayer $
-     runIdentity (S.foldMap_ (drawZone phZoneSize) (zoneAroundPoint phZoneSize sp))
+     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)
@@ -264,9 +265,19 @@ drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls w)
       where
         p = worldPosToScreen w $ 0.5 *.* uncurry (+.+) (_wlLine wl)
 
-drawPathing :: World -> Picture
-drawPathing w = setLayer DebugLayer $ 
-        (color green . pictures . map (thickLine 5 . tflat2) $ graphToEdges gr)
+edgeToPic :: [Point2] -> PathEdge -> Picture
+edgeToPic poly pe
+    | not (pointInPolygon sp poly) && not (pointInPolygon ep poly) = mempty
+    | null $ _peObstacles pe 
+                = color green $ arrow sp ep
+    | otherwise = color red   $ arrow sp ep
+  where
+    sp = _peStart pe
+    ep = _peEnd pe
+
+drawPathing :: Configuration -> World -> Picture
+drawPathing cfig w = setLayer DebugLayer $ 
+        (foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) $ FGL.labEdges gr)
         --(color green . pictures . Set.map (thickLine 5 . tflat2) $ _pathGraphP w)
         <> concatMap dispInc (graphToIncidence gr)
   where