Commit before working on debugging

2025-10-13 23:43:29 +01:00
parent c3a0cb0527
commit 3d602b4f57
7 changed files with 144 additions and 102 deletions
@@ -1,6 +1,14 @@
 {-# LANGUAGE LambdaCase #-}
 module Dodge.Debug (debugEvents) where

+import Padding
+import Dodge.Base.Window
+import ShortShow
+import Linear
+import Dodge.Render.InfoBox
+import Picture.Base
+import Geometry.Data
+import qualified Data.IntMap.Strict as IM
 import Data.Aeson.Types
 import AesonHelp
 import Control.Lens
@@ -15,7 +23,7 @@ import Dodge.WorldEvent.ThingsHit
 import Geometry.Vector
 import qualified SDL
 import Data.Ord
-import Data.Foldable (fold)
+--import Data.Foldable (fold)

 debugEvents :: Universe -> Universe
 debugEvents u = case dbools ^. at Enable_debug of
@@ -62,6 +70,75 @@ debugItem = \case
 constDPic :: (Universe -> Picture) -> Universe -> Maybe DebugItem
 constDPic p u = Just $ DebugItem (p u) mempty NoDebugInfo

+drawCrInfo' :: Universe -> Maybe DebugItem
+drawCrInfo' u = do
+    undefined
+--    
+--    setLayer FixedCoordLayer $
+--        renderInfoListsAt (2 * hw - 400) 0 cfig cam $
+--            mapMaybe crDisplayInfo $ IM.elems $ w ^. cWorld . lWorld . creatures
+--  where
+--    w = u ^. uvWorld
+--    cfig = u ^. uvConfig
+--    cam = w ^. wCam
+--    crDisplayInfo :: Creature -> Maybe (Point2, [String])
+--    crDisplayInfo cr
+--        | _crID cr == 0 = Nothing
+--        | crOnScreen =
+--            Just
+--                ( cr ^. crPos . _xy
+--                , catMaybes
+--                    --        [fmap show $ ap ^? crGoal
+--                    [ fpreShow "crHP" $ cr ^? crHP . _HP
+--                    , fpreShow "crStrategy" $ ap ^? apStrategy
+--                    , fmap (("crPos....." ++) . shortShow) $ cr ^? crPos . _xy
+--                    , fpreShow "cpVigilance" $ cr ^? crPerception . cpVigilance
+--                    , fpreShow "crAction" $ ap ^? apAction
+--                    , fpreShow "crImpulse" $ ap ^? apImpulse
+--                    ]
+--                )
+--        | otherwise = Nothing
+--      where
+--        ap = _crActionPlan cr
+--        crOnScreen = pointIsOnScreen cfig cam $ cr ^. crPos . _xy
+--
+--    fpreShow :: (Show a, Functor f) => String -> f a -> f String
+--    fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
+--    hw = halfWidth cfig
+
+drawCrInfo :: Config -> World -> Picture
+drawCrInfo cfig w =
+    setLayer FixedCoordLayer $
+        renderInfoListsAt (2 * hw - 400) 0 cfig cam $
+            mapMaybe crDisplayInfo $ IM.elems $ w ^. cWorld . lWorld . creatures
+  where
+    cam = w ^. wCam
+    crDisplayInfo :: Creature -> Maybe (Point2, [String])
+    crDisplayInfo cr
+        | _crID cr == 0 = Nothing
+        | crOnScreen =
+            Just
+                ( cr ^. crPos . _xy
+                , catMaybes
+                    --        [fmap show $ ap ^? crGoal
+                    [ fpreShow "crHP" $ cr ^? crHP . _HP
+                    , fpreShow "crStrategy" $ ap ^? apStrategy
+                    , fmap (("crPos....." ++) . shortShow) $ cr ^? crPos . _xy
+                    , fpreShow "cpVigilance" $ cr ^? crPerception . cpVigilance
+                    , fpreShow "crAction" $ ap ^? apAction
+                    , fpreShow "crImpulse" $ ap ^? apImpulse
+                    ]
+                )
+        | otherwise = Nothing
+      where
+        ap = _crActionPlan cr
+        crOnScreen = pointIsOnScreen cfig cam $ cr ^. crPos . _xy
+
+    fpreShow :: (Show a, Functor f) => String -> f a -> f String
+    fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
+    hw = halfWidth cfig
+
+
 selectCreatureDebugItem :: Universe -> DebugItem
 selectCreatureDebugItem u =
    DebugItem