Unify debug pictures

src/Dodge/Debug/Picture.hs

@@ -4,7 +4,6 @@ module Dodge.Debug.Picture where
 import Control.Lens
 import Data.Foldable
 import qualified Data.Graph.Inductive as FGL
-import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Set as S
 import Dodge.Base
@@ -151,48 +150,47 @@ drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p :
         zipWith (+.+) (square 1) $
             map ((s *.*) . (each %~ fromIntegral)) [V2 x y, V2 (x + 1) y, V2 (x + 1) (y + 1), V2 x (y + 1)]
 
-debugDraw :: Config -> World -> Picture
-{-# INLINE debugDraw #-}
-debugDraw cfig w
+showEnabledDebugs :: Config -> Picture
+{-# INLINE showEnabledDebugs #-}
+showEnabledDebugs cfig
     | Enable_debug `S.member` _debug_booleans cfig =
-        pic
-            <> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ drawList $ map text ts))
+        setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ drawList $ map text ts))
     | otherwise = mempty
   where
-    pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
+--    pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
     ts = map show (S.toList $ _debug_booleans cfig)
 
-debugDraw' :: Config -> World -> DebugBool -> Picture
-{-# INLINE debugDraw' #-}
-debugDraw' cfig w bl = case bl of
-    Enable_debug -> mempty
-    Noclip -> mempty
-    Remove_LOS -> mempty
-    Cull_more_lights -> mempty
-    Close_shape_culling -> mempty
-    Bound_box_screen -> mempty
-    Show_ms_frame -> mempty
-    View_boundaries -> viewBoundaries w
-    Show_bound_box -> drawBoundingBox w
-    Show_wall_search_rays -> drawWallSearchRays w
-    Show_dda_test -> drawDDATest w
-    Show_far_wall_detect -> drawFarWallDetect w
-    Show_walls_near_point_cursor -> mempty
-    Show_walls_near_segment -> mempty
-    Show_walls_near_point_you -> drawWallsNearYou w
-    Show_zone_near_point_cursor -> drawZoneNearPointCursor w
-    Inspect_wall -> drawInspectWalls w
-    Cr_awareness -> drawCreatureDisplayTexts w
-    Show_sound -> fold $ M.map (soundPic cfig w) $ _playingSounds w
-    Cr_status -> drawCrInfo cfig w
-    Mouse_position -> drawMousePosition w
-    Walls_info -> drawWlIDs w
-    Pathing -> drawPathing cfig w
-    Show_nodes_near_select -> undefined --drawNodesNearSelect w
-    Show_path_between -> drawPathBetween w
-    Collision_test -> mempty
-    Circ_collision_test -> mempty
-    Select_creature -> mempty
+--debugDraw' :: Config -> World -> DebugBool -> Picture
+--{-# INLINE debugDraw' #-}
+--debugDraw' cfig w bl = case bl of
+--    Enable_debug -> mempty
+--    Noclip -> mempty
+--    Remove_LOS -> mempty
+--    Cull_more_lights -> mempty
+--    Close_shape_culling -> mempty
+--    Bound_box_screen -> mempty
+--    Show_ms_frame -> mempty
+--    View_boundaries -> mempty
+--    Show_bound_box -> mempty
+--    Show_wall_search_rays -> mempty
+--    Show_dda_test -> mempty
+--    Show_far_wall_detect -> mempty
+--    Show_walls_near_point_cursor -> mempty
+--    Show_walls_near_segment -> mempty
+--    Show_walls_near_point_you -> drawWallsNearYou w
+--    Show_zone_near_point_cursor -> drawZoneNearPointCursor w
+--    Show_zone_circ -> drawZoneCirc w
+--    Inspect_wall -> drawInspectWalls w
+--    Cr_awareness -> drawCreatureDisplayTexts w
+--    Show_sound -> fold $ M.map (soundPic cfig w) $ _playingSounds w
+--    Cr_status -> drawCrInfo cfig w
+--    Mouse_position -> drawMousePosition w
+--    Walls_info -> drawWlIDs w
+--    Pathing -> drawPathing cfig w
+--    Show_path_between -> drawPathBetween w
+--    Collision_test -> mempty
+--    Circ_collision_test -> mempty
+--    Select_creature -> mempty
 
 drawCreatureDisplayTexts :: World -> Picture
 drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
@@ -288,6 +286,19 @@ drawZoneNearPointCursor w =
     mwp = mouseWorldPos (w ^. input) (w ^. wCam)
     ps = [zoneOfPoint 50 mwp]
 
+drawZoneCirc :: World -> Picture
+drawZoneCirc w = concat $ do
+    a <- w ^. input . clickWorldPos . at ButtonLeft
+    b <- w ^. input . heldWorldPos . at ButtonLeft
+    return $ 
+        setLayer DebugLayer (uncurryV translate a $ color red $ circle (dist a b))
+            <> 
+        setLayer DebugLayer (color green $ line [a, b])
+--    foldMap (drawZoneCol orange 50) ps
+--  where
+--    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
+--    ps = [zoneOfPoint 50 mwp]
+
 drawDDATest :: World -> Picture
 drawDDATest w =
     foldMap (drawZoneCol orange 50) ps