Move debug pictures out of data

src/Dodge/Data/Universe.hs

@@ -49,8 +49,7 @@ data Universe = Universe
     }
 
 data DebugItem = DebugItem
-    { _debugPic :: Picture
-    , _debugMessage :: [String]
+    { _debugMessage :: [String]
     , _debugInfo :: DebugInfo
     }
 

src/Dodge/Debug.hs

@@ -1,8 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Dodge.Debug (debugEvents) where
-
---import Dodge.Render.InfoBox
+module Dodge.Debug (debugEvents,drawDebug) where
 
 import AesonHelp
 import Control.Lens
@@ -26,8 +24,6 @@ import Picture.Base
 import qualified SDL
 import ShortShow
 
---import Data.Foldable (fold)
-
 debugEvents :: Universe -> Universe
 debugEvents u = case dbools ^. at Enable_debug of
     Nothing -> u
@@ -36,42 +32,38 @@ debugEvents u = case dbools ^. at Enable_debug of
     dbools = u ^. uvConfig . debug_booleans
 
 debugEvent :: DebugBool -> Universe -> Universe
-debugEvent db u = u & uvDebug . at db .~ debugItem db u
+debugEvent db u = u & uvDebug . at db ?~ debugItem db u
 
-debugItem :: DebugBool -> Universe -> Maybe [DebugItem]
+debugItem :: DebugBool -> Universe -> [DebugItem]
 debugItem = \case
-    Collision_test -> constDPic (drawCollisionTest . _uvWorld)
-    Circ_collision_test -> constDPic (drawCircCollisionTest . _uvWorld)
-    Select_creature -> Just . return . selectCreatureDebugItem
-    Show_walls_near_point_cursor -> constDPic (drawWallsNearCursor . _uvWorld)
-    Show_walls_near_segment -> constDPic (drawWallsNearSegment . _uvWorld)
-    Enable_debug -> const Nothing
-    Noclip -> const Nothing
-    Remove_LOS -> const Nothing
-    Cull_more_lights -> const Nothing
-    Close_shape_culling -> const Nothing
-    Bound_box_screen -> const Nothing
-    Show_ms_frame -> const Nothing
-    View_boundaries -> constDPic (viewBoundaries . _uvWorld)
-    Show_bound_box -> constDPic (drawBoundingBox . _uvWorld)
-    Show_wall_search_rays -> constDPic $ drawWallSearchRays . _uvWorld
-    Show_dda_test -> constDPic $ drawDDATest . _uvWorld
-    Show_far_wall_detect -> constDPic $ drawFarWallDetect . _uvWorld
-    Show_walls_near_point_you -> constDPic $ drawWallsNearYou . _uvWorld
-    Show_zone_near_point_cursor -> constDPic $ drawZoneNearPointCursor . _uvWorld
-    Show_zone_circ -> constDPic $ drawZoneCirc . _uvWorld
-    Inspect_wall -> constDPic $ drawInspectWalls . _uvWorld
-    Cr_awareness -> constDPic $ drawCreatureDisplayTexts . _uvWorld
-    Show_sound -> constDPic $ \u ->
-        fold (M.map (soundPic (u ^. uvConfig) (u ^. uvWorld)) $ u ^. uvWorld . playingSounds)
-    Cr_status -> Just . drawCrInfo
-    Mouse_position -> constDPic $ drawMousePosition . _uvWorld
-    Walls_info -> constDPic $ drawWlIDs . _uvWorld
-    Pathing -> constDPic $ \u -> drawPathing (u ^. uvConfig) (u ^. uvWorld)
-    Show_path_between -> constDPic $ drawPathBetween . _uvWorld
-
-constDPic :: (Universe -> Picture) -> Universe -> Maybe [DebugItem]
-constDPic p u = Just [DebugItem (p u) mempty NoDebugInfo]
+    Collision_test -> mempty
+    Circ_collision_test -> mempty
+    Select_creature -> return . selectCreatureDebugItem
+    Show_walls_near_point_cursor -> mempty
+    Show_walls_near_segment -> mempty
+    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_you -> mempty
+    Show_zone_near_point_cursor -> mempty
+    Show_zone_circ -> mempty
+    Inspect_wall -> mempty
+    Cr_awareness -> mempty
+    Show_sound -> mempty
+    Cr_status -> drawCrInfo
+    Mouse_position -> mempty
+    Walls_info -> mempty
+    Pathing -> mempty
+    Show_path_between -> mempty
 
 drawCrInfo :: Universe -> [DebugItem]
 drawCrInfo u = mapMaybe f . IM.elems $ w ^. cWorld . lWorld . creatures
@@ -84,7 +76,6 @@ drawCrInfo u = mapMaybe f . IM.elems $ w ^. cWorld . lWorld . creatures
                 && cr ^. crID /= 0
         Just $
             DebugItem
-                mempty
                 ( catMaybes
                     [ g show "crID" $ cr ^? crID
                     , g show "crHP" $ cr ^? crHP . _HP
@@ -132,8 +123,7 @@ drawCrInfo u = mapMaybe f . IM.elems $ w ^. cWorld . lWorld . creatures
 selectCreatureDebugItem :: Universe -> DebugItem
 selectCreatureDebugItem u =
     DebugItem
-        { _debugPic = mempty
-        , _debugMessage = debugSelectCreatureMessage u
+        { _debugMessage = debugSelectCreatureMessage u
         , _debugInfo = scrollDebugInfoInt (length $ debugSelectCreatureList 0 u) u $ clickGetCreature u
         }
 
@@ -194,3 +184,35 @@ closestCreatureID u =
         $ _uvWorld u
   where
     mwp = mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)
+
+drawDebug :: Universe -> DebugBool -> Picture
+drawDebug u = \case
+    Collision_test -> drawCollisionTest $ _uvWorld u
+    Circ_collision_test -> drawCircCollisionTest $ _uvWorld u
+    Select_creature -> mempty
+    Show_walls_near_point_cursor -> drawWallsNearCursor $ _uvWorld u
+    Show_walls_near_segment -> drawWallsNearSegment $ _uvWorld u
+    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 $ _uvWorld u
+    Show_bound_box -> drawBoundingBox $ _uvWorld u
+    Show_wall_search_rays -> drawWallSearchRays $ _uvWorld u
+    Show_dda_test ->  drawDDATest $ _uvWorld u
+    Show_far_wall_detect ->  drawFarWallDetect $ _uvWorld u
+    Show_walls_near_point_you ->  drawWallsNearYou $ _uvWorld u
+    Show_zone_near_point_cursor ->  drawZoneNearPointCursor $ _uvWorld u
+    Show_zone_circ ->  drawZoneCirc $ _uvWorld u
+    Inspect_wall ->  drawInspectWalls $ _uvWorld u
+    Cr_awareness ->  drawCreatureDisplayTexts $ _uvWorld u
+    Show_sound -> fold 
+        $ M.map (soundPic (u ^. uvConfig) (u ^. uvWorld)) $ u ^. uvWorld . playingSounds
+    Cr_status -> mempty
+    Mouse_position ->  drawMousePosition $ _uvWorld u
+    Walls_info ->  drawWlIDs $ _uvWorld u
+    Pathing -> drawPathing (u ^. uvConfig) (u ^. uvWorld)
+    Show_path_between ->  drawPathBetween $ _uvWorld u

src/Dodge/Render/ShapePicture.hs

@@ -1,5 +1,8 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Render.ShapePicture (worldSPic) where
 
+import Dodge.Debug
+import qualified Data.Map.Strict as M
 import Control.Lens
 import Data.Foldable
 import Data.Strict.Tuple
@@ -110,8 +113,7 @@ extraPics cfig u =
         <> _flares lw
         <> foldMap drawLightSource (_lightSources lw)
         <> viewClipBounds cfig w
---        <> showEnabledDebugs cfig
-        <> foldMap (foldMap _debugPic) (_uvDebug u) -- debug messages are in fixed coord pics
+        <> foldMap (drawDebug u) (M.keys $ _uvDebug u)
   where
     w = u ^. uvWorld
     lw = w ^. cWorld . lWorld
@@ -124,14 +126,10 @@ floorItemSPic itm flit =
             (itemSPic itm)
 
 btSPic :: Button -> SPic
-btSPic bt =
-    uncurryV translateSPxy (_btPos bt) $
-        rotateSP (_btRot bt) (drawButton bt)
+btSPic bt = uncurryV translateSPxy (_btPos bt) $ rotateSP (_btRot bt) (drawButton bt)
 
 mcSPic :: CWorld -> Machine -> SPic
-mcSPic cw mc =
-    uncurryV translateSPxy (_mcPos mc) $
-        rotateSP (_mcDir mc) (drawMachine cw mc)
+mcSPic cw mc = uncurryV translateSPxy (_mcPos mc) $ rotateSP (_mcDir mc) (drawMachine cw mc)
 
 drawBullet :: Bullet -> Picture
 drawBullet pt =