Readd some debug drawing (debugDraw itself still commented out)

src/Dodge/Data.hs

@@ -150,7 +150,7 @@ data World = World
     , _clickMousePos        :: Point2
     , _pathGraph            :: Gr Point2 PathEdge
     , _pathGraphP           :: S.Set (Point2,Point2)
-    , _phZoning             :: Zoning [] (Int,Point2)
+    , _pnZoning             :: Zoning [] (Int,Point2)
     , _hud                  :: HUD
     , _lightSources         :: IM.IntMap LightSource
     , _tempLightSources     :: [TempLightSource]

src/Dodge/Default/World.hs

@@ -76,7 +76,7 @@ defaultWorld = World
     , _clickMousePos = V2 0 0
     , _pathGraph = Data.Graph.Inductive.Graph.empty
     , _pathGraphP   = mempty
-    , _phZoning     = Zoning mempty wlZoneSize (zonePos snd)
+    , _pnZoning     = Zoning mempty wlZoneSize (zonePos snd)
     , _hud = HUD
         { _hudElement = DisplayInventory NoSubInventory
         , _carteCenter = V2 0 0

src/Dodge/Layout.hs

@@ -5,6 +5,7 @@ module Dodge.Layout
 import Data.Tile
 import Dodge.Data
 import Dodge.Path
+import Dodge.Zone.Update
 import Dodge.ShiftPoint
 import Dodge.Placement.PlaceSpot
 --import Dodge.LevelGen.Data
@@ -21,6 +22,7 @@ import qualified IntMapHelp as IM
 import Tile
 import RandomHelp
 
+import Data.Graph.Inductive (labNodes,labEdges)
 import Data.List (nubBy)
 import Data.Traversable
 import Control.Lens
@@ -44,6 +46,10 @@ generateLevelFromRoomList gr' w = initWallZoning
         , _pathGraph    = path
         , _pathGraphP   = pairPath
         }
+        & pnZoning   %~ (\zn -> foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty)
+            (labNodes path))
+--        & peZoning   %~ (\zn -> foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty)
+--            (labEdges (_pgGraph path)))
   where
     path = pairsToGraph pairPath
     pairPath = foldMap _rmPath rs

src/Dodge/Path.hs

@@ -1,9 +1,11 @@
+--{-# LANGUAGE TupleSections #-}
 module Dodge.Path 
     ( pointTowardsImpulse
     , makePathBetween
     , makePathBetweenPs
     , removePathsCrossing
     , pairsToGraph
+    , getNodePos
     ) where
 import Dodge.Data
 import Dodge.Base.Collide
@@ -24,6 +26,9 @@ import qualified Streaming.Prelude as S
 --import Data.Graph.Inductive.PatriciaTree
 --import Data.Graph.Inductive.Graph hiding ((&))
 
+getNodePos :: Int -> World -> Maybe Point2
+getNodePos i w = _pathGraph w `lab` i
+
 makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
 makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w)
     na <- walkableNodeNear a
@@ -31,7 +36,7 @@ makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w)
     sp na nb (second _peDist (_pathGraph w))
   where
     --nodesNear p = concat $ lookLookups (zoneNearPointIP p) (_pathPoints w)
-    nodesNear p = runIdentity . S.toList_ $ nearPoint _phZoning p w
+    nodesNear p = runIdentity . S.toList_ $ nearPoint _pnZoning p w
     walkableNodeNear p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear p
 
 --walkableNodeNear :: Point2 -> World -> Maybe Point2

src/Dodge/Render/ShapePicture.hs

@@ -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 :: [Point2] -> PathEdge -> Picture
---edgeToPic poly pe
+edgeToPic poly pe
---    | not (pointInPolygon sp poly) && not (pointInPolygon ep poly) = mempty
+    | not (pointInPolygon sp poly) && not (pointInPolygon ep poly) = mempty
---    | null $ _peObstacles pe 
+    | null $ _peObstacles pe 
---                = anarrow green
+                = anarrow green
---    | hasobstacle BlockObstacle  
+    | hasobstacle BlockObstacle  
---                = anarrow red
+                = anarrow red
---    | hasobstacle AutoDoorObstacle = anarrow yellow
+    | hasobstacle AutoDoorObstacle = anarrow yellow
---    | otherwise = anarrow cyan
+    | otherwise = anarrow cyan
---  where
+  where
---    hasobstacle = (`Set.member` _peObstacles pe)
+    hasobstacle = (`Set.member` _peObstacles pe)
---    anarrow col = color col $ arrow sp ep
+    anarrow col = color col $ arrow sp ep
---    sp = _peStart pe
+    sp = _peStart pe
---    ep = _peEnd pe
+    ep = _peEnd pe
 
 drawPathing :: Configuration -> World -> Picture
-drawPathing cfig w = setLayer DebugLayer mempty
+drawPathing cfig w = setLayer DebugLayer
---    $  foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
+    $  foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
---    <> concatMap dispInc (graphToIncidence gr)
+    <> concatMap dispInc (graphToIncidence gr)
---  where
+  where
---    dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
+    dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
---    gr = _pathGraph w
+    gr = _pathGraph w
 
 crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String])
 crDisplayInfo cfig w cr