Improve debugDraw

src/Dodge/Render/ShapePicture.hs

@@ -82,39 +82,44 @@ extraPics cfig w = pictures (_decorations w)
     <> concatMapPic clDraw (_clouds w      )
     <> concatMapPic ppDraw (_pressPlates w )
     <> viewClipBounds cfig w
---    <> debugDraw cfig w
+    <> debugDraw cfig w
 
 debugDraw :: Configuration -> World -> Picture
-debugDraw cfig w = pic
-    <> setLayer FixedCoordLayer (listPicturesAt (0.5*halfWidth cfig) 0 cfig $ map text ts)
+{-# INLINE debugDraw #-}
+debugDraw cfig w =
+    pic
+    <> 
+    setLayer FixedCoordLayer (listPicturesAt (0.5*halfWidth cfig) 0 cfig $ map text ts)
   where
-    (ts, pic) = foldMap (f . debugDraw' cfig w) (_debug_booleans cfig)
-    f (Left s) = ([s],mempty)
-    f (Right pic') = (mempty,pic')
+    (ts, pic) = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
 
-debugDraw' :: Configuration -> World -> DebugBool -> Either String Picture
+debugDraw' :: Configuration -> World -> DebugBool -> ([String],Picture)
+{-# INLINE debugDraw' #-}
 debugDraw' cfig w bl = case bl of
-    Noclip      -> Left "Noclip"
-    Remove_LOS  -> Left "No line of sight"
-    Cull_more_lights    -> Left "Cull more lights"
-    Close_shape_culling -> Left "Close shape culling"
-    Bound_box_screen    -> Left "bound box screen, this should be moved"
-    Show_ms_frame           -> Right mempty
-    View_boundaries         -> Right $ viewBoundaries w
-    Show_bound_box          -> Right $ drawBoundingBox w
-    Show_wall_search_rays   -> Right $ drawWallSearchRays w
-    Show_dda_test           -> Right $ drawDDATest w
-    Show_far_wall_detect    -> Right $ drawFarWallDetect w
-    Show_select             -> Right $ drawWorldSelect w
-    Inspect_wall            -> Right $ drawInspectWalls w
-    Cr_awareness            -> Right $ drawCreatureDisplayTexts w
-    Show_sound              -> Right $ pictures $ M.map (soundPic cfig w) $ _playingSounds w
-    Cr_status               -> Right $ drawCrInfo cfig w
-    Mouse_position          -> Right $ drawMousePosition cfig w
-    Walls_info              -> Right $ drawWlIDs cfig w
-    Pathing                 -> Right $ drawPathing cfig w
-    Show_nodes_near_select  -> Right $ drawNodesNearSelect w
-    Show_path_between       -> Right $ drawPathBetween w
+    Noclip      -> lstring "Noclip"
+    Remove_LOS  -> lstring "No line of sight"
+    Cull_more_lights    -> lstring "Cull more lights"
+    Close_shape_culling -> lstring "Close shape culling"
+    Bound_box_screen    -> lstring "bound box screen, this should be moved"
+    Show_ms_frame           -> rdraw mempty
+    View_boundaries         -> rdraw $ viewBoundaries w
+    Show_bound_box          -> rdraw $ drawBoundingBox w
+    Show_wall_search_rays   -> rdraw $ drawWallSearchRays w
+    Show_dda_test           -> rdraw $ drawDDATest w
+    Show_far_wall_detect    -> rdraw $ drawFarWallDetect w
+    Show_select             -> rdraw $ drawWorldSelect w
+    Inspect_wall            -> rdraw $ drawInspectWalls w
+    Cr_awareness            -> rdraw $ drawCreatureDisplayTexts w
+    Show_sound              -> rdraw $ pictures $ M.map (soundPic cfig w) $ _playingSounds w
+    Cr_status               -> rdraw $ drawCrInfo cfig w
+    Mouse_position          -> rdraw $ drawMousePosition cfig w
+    Walls_info              -> rdraw $ drawWlIDs cfig w
+    Pathing                 -> rdraw $ drawPathing cfig w
+    Show_nodes_near_select  -> rdraw $ drawNodesNearSelect w
+    Show_path_between       -> rdraw $ drawPathBetween w
+  where
+    lstring str = ([str],mempty)
+    rdraw   pic = (mempty,pic)
 
 drawCreatureDisplayTexts :: World -> Picture
 drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures w)