Tweak debug display

src/Dodge/Render/List.hs

@@ -16,6 +16,7 @@ module Dodge.Render.List (
     selSecDrawCursorAt,
     drawTitleBackground, -- should be renamed, made sensible
     drawCursorAt,
+    drawLabelledList,
 ) where
 
 import qualified Data.IntMap.Strict as IM
@@ -208,6 +209,13 @@ renderListAt tx ty = translate tx (- ty)
 drawList :: [Picture] -> Picture
 drawList = drawListYgapScaleYoff 0 1 0
 
+drawLabelledList :: [(String,[String])] -> Picture
+drawLabelledList ((s,ss):xs) 
+    = translate (-10) 0 (drawListYgapScaleYoff 0 1 0 [ textJustifyRight s])
+    <> drawListYgapScaleYoff 0 1 0 (text <$> ss)
+    <> translate 0 (negate $ fromIntegral (max 1 $ length ss) * 20) (drawLabelledList xs)
+drawLabelledList [] = mempty
+
 --TODO put the following functions in an appropriate place
 
 -- | Colour picture and add black drop shadow.

src/Dodge/Render/Picture.hs

@@ -2,8 +2,8 @@
 
 module Dodge.Render.Picture (fixedCoordPictures) where
 
-import Linear (_xy)
 import Control.Lens
+import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base.Coordinate
 import Dodge.Base.Window
@@ -13,6 +13,7 @@ import Dodge.Render.List
 import Dodge.Render.MenuScreen
 import Geometry
 import HelpNum
+import Linear (_xy)
 import Picture
 
 fixedCoordPictures :: Universe -> Picture
@@ -30,18 +31,20 @@ fixedCoordPictures u =
             )
         <> displayFrameTicks u
         <> drawMouseCursor u
-        <> ( toTopLeft cfig . translate (1.3 * halfWidth cfig) 0
-                . drawList
-                . take 50
-                . drop (u ^. uvDebugMessageOffset)
-                . map text
-                $ foldMap _debugMessage (_uvDebug u) -- other debug pics in extraPics
-           )
+        <> toTopLeft
+            cfig
+            ( translate (halfWidth cfig) (10 * fromIntegral (u ^. uvDebugMessageOffset))
+                . drawLabelledList
+                . fmap f
+                . M.toList
+                $ u ^. uvDebug
+            )
   where
     cfig = _uvConfig u
     hw = halfWidth cfig
     hh = halfHeight cfig
     ttl = toTopLeft cfig
+    f (k, l) = (show k, foldMap _debugMessage l)
 
 displayFrameTicks :: Universe -> Picture
 displayFrameTicks u

src/Dodge/Render/ShapePicture.hs

@@ -110,8 +110,8 @@ extraPics cfig u =
         <> _flares lw
         <> foldMap drawLightSource (_lightSources lw)
         <> viewClipBounds cfig w
-        <> showEnabledDebugs cfig
-        <> foldMap _debugPic (_uvDebug u) -- debug messages are in fixed coord pics
+--        <> showEnabledDebugs cfig
+        <> foldMap (foldMap _debugPic) (_uvDebug u) -- debug messages are in fixed coord pics
   where
     w = u ^. uvWorld
     lw = w ^. cWorld . lWorld