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

Start to create debug datatypes

Browse Source
This commit is contained in:
justin
2023-03-29 11:35:39 +01:00
parent 2c13f52ce8
commit 5b5ed519dd
5 changed files with 20 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Debug/Picture.hs
+12 -40
View File
@@ -1,28 +1,20 @@
module Dodge.Debug.Picture where
import Control.Lens
import Control.Monad (guard)
import Data.Foldable
import qualified Data.Graph.Inductive as FGL
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as Set
import Dodge.Base
import Dodge.Creature.Picture
import Dodge.Creature.Picture.Awareness
import Dodge.Data.Universe
import Dodge.Base.Coordinate
import Dodge.Draw
import Dodge.Flare
import Dodge.GameRoom
import Dodge.Graph
import Dodge.Path
import Dodge.Picture.SizeInvariant
import Dodge.RadarBlip
import Dodge.Render.InfoBox
import Dodge.Render.List
import Dodge.Render.Picture
import Dodge.ShortShow
import Dodge.SoundLogic.LoadSound
import Dodge.Viewpoints
@@ -34,31 +26,11 @@ import qualified IntMapHelp as IM
import Padding
import Picture
import SDL (MouseButton (..))
import Shape
import ShapePicture
import ShortShow
import Sound.Data
import Dodge.Zoning.Wall
import Dodge.Path
import Dodge.Creature.Picture.Awareness
import qualified Data.Graph.Inductive as FGL
import Sound.Data
import Control.Lens
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import Dodge.Base.Wall
import Dodge.Base.Window
import Dodge.Data.Universe
import Dodge.Render.Label
import Dodge.Render.List
import Dodge.WorldEvent.ThingsHit
import Dodge.Zoning.Base
import Dodge.Zoning.Creature
import Geometry
import Picture
import SDL (MouseButton (..))
printPoint :: Point2 -> Picture
printPoint p = color white $ uncurryV translate p $ pictures [circle 3, scale 0.05 0.05 $ text (show p)]
@@ -369,20 +341,20 @@ drawCrInfo :: Configuration -> World -> Picture
drawCrInfo cfig w =
setLayer FixedCoordLayer $
renderInfoListsAt (2 * hw - 400) 0 cfig cam $
mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. cWorld . lWorld . creatures
mapMaybe crDisplayInfo $ IM.elems $ w ^. cWorld . lWorld . creatures
where
cam = w ^. wCam
drawPathing :: Configuration -> World -> Picture
drawPathing cfig w =
setLayer DebugLayer $
foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
<> foldMap dispInc (graphToIncidence gr)
where
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
gr = w ^. cWorld . pathGraph
-- drawPathing :: Configuration -> World -> Picture
-- drawPathing cfig w =
-- setLayer DebugLayer $
-- foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
-- <> foldMap dispInc (graphToIncidence gr)
-- where
-- dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
-- gr = w ^. cWorld . pathGraph
crDisplayInfo :: Configuration -> Camera -> Creature -> Maybe (Point2, [String])
crDisplayInfo cfig cam cr
crDisplayInfo :: Creature -> Maybe (Point2, [String])
crDisplayInfo cr
| _crID cr == 0 = Nothing
| crOnScreen =
Just
@@ -401,7 +373,7 @@ drawCrInfo cfig w =
| otherwise = Nothing
where
ap = _crActionPlan cr
crOnScreen = pointOnScreen cfig cam $ _crPos cr
crOnScreen = pointIsOnScreen cfig cam $ _crPos cr
fpreShow :: (Show a, Functor f) => String -> f a -> f String
fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)