justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add more debug info for selected creatures

Browse Source
This commit is contained in:
justin
2023-04-30 13:55:54 +01:00
parent 5b1212e4f6
commit 08e71e5451
17 changed files with 116 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Debug.hs
+66 -7
View File
@@ -1,9 +1,17 @@
module Dodge.Debug where
import Dodge.Debug.Picture
import AesonHelp
import Control.Lens
import Dodge.Data.Universe
import Data.List (sortOn)
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import Dodge.Base.Coordinate
import Dodge.Data.Universe
import Dodge.Debug.Picture
import Dodge.WorldEvent.ThingsHit
import Geometry.Vector
import qualified SDL
debugEvents :: Universe -> Universe
debugEvents u = case dbools ^. at Enable_debug of
@@ -15,11 +23,62 @@ debugEvents u = case dbools ^. at Enable_debug of
debugEvent :: DebugBool -> Universe -> Universe
debugEvent db u = case db of
Collision_test -> u & uvDebug . at Collision_test ?~ collisionDebugItem u
Select_creature -> u & uvDebug . at Select_creature ?~ selectCreatureDebugItem u
_ -> u
collisionDebugItem :: Universe -> DebugItem
collisionDebugItem u = DebugItem
{ _debugPic = drawCollisionTest $ u ^. uvWorld
, _debugMessage = ["Collision test:","asdf"]
, _debugInfo = NoDebugInfo
}
collisionDebugItem u =
DebugItem
{ _debugPic = const $ drawCollisionTest $ u ^. uvWorld
, _debugMessage = const []
, _debugInfo = NoDebugInfo
}
selectCreatureDebugItem :: Universe -> DebugItem
selectCreatureDebugItem u =
DebugItem
{ _debugPic = const mempty
, _debugMessage = debugSelectCreatureMessage
, _debugInfo = scrollDebugInfoInt (length $ debugSelectCreatureList 0 u) u $ clickGetCreature u
}
scrollDebugInfoInt :: Int -> Universe -> DebugInfo -> DebugInfo
scrollDebugInfoInt i u
| SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys) =
debugInt %~ ((`mod` i) . (+ (u ^. uvWorld . input . scrollAmount)))
| otherwise = id
debugSelectCreatureMessage :: Universe -> [String]
debugSelectCreatureMessage u = fromMaybe
[show (u ^? uvDebug . ix Select_creature . debugInfo . debugInt)]
$ do
cid <- u ^? uvDebug . ix Select_creature . debugInfo . debugMInt . _Just
i <- u ^? uvDebug . ix Select_creature . debugInfo . debugInt
cap <- debugSelectCreatureList cid u !! i
return $ show cid : getPretty cap
debugSelectCreatureList :: Int -> Universe -> [Maybe [String]]
debugSelectCreatureList cid u =
[ fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crActionPlan
, fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crPerception
, fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crIntention
, fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crMemory
]
clickGetCreature :: Universe -> DebugInfo
clickGetCreature u
| SDL.ButtonLeft `M.member` (u ^. uvWorld . input . mouseButtons)
&& SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys) =
DebugIntMInt 0 (closestCreatureID u)
| otherwise =
fromMaybe (DebugIntMInt 0 Nothing) $
u ^? uvDebug . ix Select_creature . debugInfo
closestCreatureID :: Universe -> Maybe Int
closestCreatureID u =
fmap (_crID . snd) . listToMaybe . reverse
. sortOn (dist mwp . fst)
. crsHitRadial mwp 100
$ _uvWorld u
where
mwp = mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)