Tweak debug display

src/Dodge/Data/Config.hs

@@ -48,9 +48,9 @@ data Config = Config
     , _graphics_world_resolution :: ResFactor
     , _graphics_distortion_resolution :: ResFactor
     , _graphics_num_shadow_casters :: NumShadowCasters
-    , _windowX :: Int
+    , _windowX :: Int --size
     , _windowY :: Int
-    , _windowPosX :: Int
+    , _windowPosX :: Int --position in os
     , _windowPosY :: Int
     , _gameplay_rotate_to_wall :: Bool
     , _debug_view_clip_bounds :: RoomClipping

src/Dodge/Data/Input.hs

@@ -5,6 +5,7 @@
 
 module Dodge.Data.Input where
 
+import Dodge.Data.Config
 import Dodge.Data.Terminal.Status
 import Control.Lens
 import qualified Data.Map.Strict as M
@@ -28,6 +29,7 @@ data MouseContext
     | OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
     | OutsideTerminal
     | MouseGameRotate
+    | OverDebug {_mcoDBBool :: DebugBool, _mcoDBInt :: Int}
     deriving (Show)
 
 data Input = Input

src/Dodge/Debug.hs

@@ -18,11 +18,18 @@ import ShortShow
 
 debugEvents :: Universe -> Universe
 debugEvents u = case dbools ^. at Display_debug of
-    Nothing -> u
+    Nothing -> u & uvDebug .~ mempty
     Just () -> S.foldr debugEvent (u & uvDebug .~ mempty) dbools
+        & overDebugEvent
   where
     dbools = u ^. uvConfig . debug_booleans
 
+overDebugEvent :: Universe -> Universe
+overDebugEvent u = fromMaybe u $ do
+    OverDebug db i <- u ^? uvWorld . input . mouseContext
+    DebugItem s f <- u ^? uvDebug . ix db . ix i
+    return $ f s u
+
 debugEvent :: DebugBool -> Universe -> Universe
 debugEvent db u = u & uvDebug . at db .~ debugItem db u
 
@@ -50,12 +57,17 @@ debugItem = \case
     Inspect_wall -> mempty
     Cr_awareness -> mempty
     Show_sound -> mempty
-    Cr_status -> Just . drawCrInfo
+    Cr_status -> drawCrInfo'
     Mouse_position -> mempty
     Walls_info -> mempty
     Pathing -> mempty
     Show_path_between -> mempty
 
+drawCrInfo' :: Universe -> Maybe [DebugItem]
+drawCrInfo' u = case drawCrInfo u of
+    [] -> Nothing
+    xs -> Just xs
+
 drawCrInfo :: Universe -> [DebugItem]
 drawCrInfo u = foldMap f . IM.elems $ w ^. cWorld . lWorld . creatures
   where

src/Dodge/Menu.hs

@@ -4,14 +4,13 @@ module Dodge.Menu (
     splashMenu,
 ) where
 
-import Dodge.Combine.Graph
-import System.Directory
-import qualified Data.Text.IO as TIO
 import Control.Monad
 import qualified Data.Aeson.Encode.Pretty as AEP
 import Data.ByteString.Lazy.Char8 (unpack)
 import Data.Maybe
+import qualified Data.Text.IO as TIO
 import Dodge.Base.Coordinate
+import Dodge.Combine.Graph
 import Dodge.Concurrent
 import Dodge.Config
 import Dodge.Data.Universe
@@ -28,6 +27,7 @@ import Padding
 import Preload.Update
 import qualified SDL
 import System.Clipboard
+import System.Directory
 import Text.Read
 
 splashMenu :: Universe -> ScreenLayer
@@ -96,13 +96,12 @@ seedStartOptions =
 trySeedFromClipboard :: Universe -> IO Universe
 trySeedFromClipboard u = do
     mcstr <- getClipboardString
-    case mcstr >>= readMaybe of
+    return $ case mcstr >>= readMaybe of
         Nothing ->
-            return $
-                pushScreen
-                    (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
-                    (u & uvScreenLayers %~ tail)
-        Just i -> return $ startSeedGame 0 i u
+            pushScreen
+                (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
+                (u & uvScreenLayers %~ tail)
+        Just i -> startSeedGame 0 i u
 
 titleOptionsMenu :: String -> [MenuOption] -> Universe -> ScreenLayer
 titleOptionsMenu = initializeOptionMenuBO "BACK" (popScreen . writeConfig)
@@ -141,8 +140,9 @@ debugMenuOptions =
     g bd _ = (show bd, "True")
 
 logOptions :: [MenuOption]
-logOptions = 
-    [ Toggle (uvIOEffects %~ \f u -> generateGraphs >> f u) 
+logOptions =
+    [ Toggle
+        (uvIOEffects %~ \f u -> generateGraphs >> f u)
         (const $ MODString "Create item combination graph")
     ]
 
@@ -151,7 +151,6 @@ generateGraphs = do
     createDirectoryIfMissing True "generated/graph"
     TIO.writeFile "generated/graph/itemCombinations.gv" combinationsDotGraph
 
-
 gameplayMenu :: Universe -> ScreenLayer
 gameplayMenu = titleOptionsMenu "OPTIONS:GAMEPLAY" gameplayMenuOptions
 
@@ -229,8 +228,13 @@ unpause u' =
 
 -- note that this won't update after it is first loaded
 displayConfig :: Universe -> ScreenLayer
-displayConfig u = titleOptionsNoWrite "CONFIG" (map (Toggle id . const . MODString) 
-    $ listConfig u) u
+displayConfig u =
+    titleOptionsNoWrite
+        "CONFIG"
+        ( map (Toggle id . const . MODString) $
+            listConfig u
+        )
+        u
 
 listConfig :: Universe -> [String]
 listConfig =

src/Dodge/Render/Picture.hs

@@ -118,6 +118,8 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     OverTerminal _ ts -> drawCursorByTerminalStatus ts
     OutsideTerminal -> rotate (pi / 4) $ drawPlus 5
     MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
+    OverDebug {} -> drawPlus 5 <> rotate (pi/4) (drawPlus 5)
+    --OverDebug db i -> scale 0.1 0.1 $ text (show db ++ show i)
   where
     w = u ^. uvWorld
     selsec = u ^? uvWorld . hud . diSelection . _Just . slSec

src/Dodge/Update.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
 
 module Dodge.Update (updateUniverse) where
 
+import qualified Data.Set as S
 import Color
 import Control.Applicative
 import Control.Monad
@@ -340,6 +342,7 @@ updateMouseContextGame cfig u = \case
         return MouseGameRotate
     aimcontext
         | ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
+        | Display_debug `S.member` (cfig ^. debug_booleans) = getDebugMouseOver u
         | otherwise = MouseInGame
     mpos = w ^. input . mousePos
     disss = w ^. hud . diSections
@@ -370,6 +373,18 @@ updateMouseContextGame cfig u = \case
                 then OverTerminal tmid (tm ^. tmStatus)
                 else OutsideTerminal
 
+getDebugMouseOver :: Universe -> MouseContext
+getDebugMouseOver u = fromMaybe MouseInGame $ do
+    guard $ x >0 && x < 100
+    (db,j) <- m ^? ix i
+    return $ OverDebug db j
+  where
+    f (a,as) = (a,) <$> [0..length as - 1]
+    m = foldMap f . M.toList $ u ^. uvDebug
+    i = floor (y /20)
+    y = halfHeight (u^.uvConfig) - y'
+    V2 x y' = u^.uvWorld.input.mousePos
+
 getMenuMouseContext :: ScreenLayer -> Universe -> MouseContext
 getMenuMouseContext screen u = case screen ^. scOptions of
     [] -> NoMouseContext