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/Base/Window.hs
+4
View File
@@ -5,6 +5,7 @@ module Dodge.Base.Window (
screenPolygon, screenPolygon,
screenPolygonBord, screenPolygonBord,
screenBox, screenBox,
pointIsOnScreen,
) where ) where
import Control.Lens import Control.Lens
@@ -54,3 +55,6 @@ screenBox w = rectNSWE hh (- hh) (- hw) hw
where where
hw = halfWidth w hw = halfWidth w
hh = halfHeight w hh = halfHeight w
pointIsOnScreen :: Configuration -> Camera -> Point2 -> Bool
pointIsOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w
src/Dodge/Debug/Picture.hs
+12 -40
View File
@@ -1,28 +1,20 @@
module Dodge.Debug.Picture where module Dodge.Debug.Picture where
import Control.Lens import Control.Lens
import Control.Monad (guard)
import Data.Foldable import Data.Foldable
import qualified Data.Graph.Inductive as FGL import qualified Data.Graph.Inductive as FGL
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import qualified Data.Set as Set
import Dodge.Base import Dodge.Base
import Dodge.Creature.Picture
import Dodge.Creature.Picture.Awareness import Dodge.Creature.Picture.Awareness
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.Base.Coordinate
import Dodge.Draw
import Dodge.Flare
import Dodge.GameRoom import Dodge.GameRoom
import Dodge.Graph import Dodge.Graph
import Dodge.Path import Dodge.Path
import Dodge.Picture.SizeInvariant import Dodge.Picture.SizeInvariant
import Dodge.RadarBlip
import Dodge.Render.InfoBox import Dodge.Render.InfoBox
import Dodge.Render.List import Dodge.Render.List
import Dodge.Render.Picture
import Dodge.ShortShow import Dodge.ShortShow
import Dodge.SoundLogic.LoadSound import Dodge.SoundLogic.LoadSound
import Dodge.Viewpoints import Dodge.Viewpoints
@@ -34,31 +26,11 @@ import qualified IntMapHelp as IM
import Padding import Padding
import Picture import Picture
import SDL (MouseButton (..)) import SDL (MouseButton (..))
import Shape
import ShapePicture
import ShortShow import ShortShow
import Sound.Data 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 qualified Data.Set as S
import Dodge.Base.Wall
import Dodge.Base.Window
import Dodge.Data.Universe
import Dodge.Render.Label import Dodge.Render.Label
import Dodge.Render.List
import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.ThingsHit
import Dodge.Zoning.Base
import Dodge.Zoning.Creature
import Geometry
import Picture
import SDL (MouseButton (..))
printPoint :: Point2 -> Picture printPoint :: Point2 -> Picture
printPoint p = color white $ uncurryV translate p $ pictures [circle 3, scale 0.05 0.05 $ text (show p)] 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 = drawCrInfo cfig w =
setLayer FixedCoordLayer $ setLayer FixedCoordLayer $
renderInfoListsAt (2 * hw - 400) 0 cfig cam $ 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 where
cam = w ^. wCam cam = w ^. wCam
drawPathing :: Configuration -> World -> Picture -- drawPathing :: Configuration -> World -> Picture
drawPathing cfig w = -- drawPathing cfig w =
setLayer DebugLayer $ -- setLayer DebugLayer $
foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr) -- foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
<> foldMap dispInc (graphToIncidence gr) -- <> foldMap dispInc (graphToIncidence gr)
where -- where
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n -- dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
gr = w ^. cWorld . pathGraph -- gr = w ^. cWorld . pathGraph
crDisplayInfo :: Configuration -> Camera -> Creature -> Maybe (Point2, [String]) crDisplayInfo :: Creature -> Maybe (Point2, [String])
crDisplayInfo cfig cam cr crDisplayInfo cr
| _crID cr == 0 = Nothing | _crID cr == 0 = Nothing
| crOnScreen = | crOnScreen =
Just Just
@@ -401,7 +373,7 @@ drawCrInfo cfig w =
| otherwise = Nothing | otherwise = Nothing
where where
ap = _crActionPlan cr 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 :: (Show a, Functor f) => String -> f a -> f String
fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show) fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
src/Dodge/Render/ShapePicture.hs
-20
View File
@@ -5,40 +5,20 @@ module Dodge.Render.ShapePicture (
import Control.Lens import Control.Lens
import Control.Monad (guard) import Control.Monad (guard)
import Data.Foldable import Data.Foldable
import qualified Data.Graph.Inductive as FGL
import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import qualified Data.Set as Set
import Dodge.Base import Dodge.Base
import Dodge.Creature.Picture import Dodge.Creature.Picture
import Dodge.Creature.Picture.Awareness
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.Debug.Picture import Dodge.Debug.Picture
import Dodge.Draw import Dodge.Draw
import Dodge.Flare import Dodge.Flare
import Dodge.GameRoom
import Dodge.Graph
import Dodge.Path
import Dodge.Picture.SizeInvariant
import Dodge.RadarBlip import Dodge.RadarBlip
import Dodge.Render.InfoBox
import Dodge.Render.List
import Dodge.Render.Picture import Dodge.Render.Picture
import Dodge.ShortShow
import Dodge.SoundLogic.LoadSound
import Dodge.Viewpoints
import Dodge.Zoning
import Dodge.Zoning.Base
import Geometry import Geometry
import Geometry.ConvexPoly
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import Padding
import Picture import Picture
import SDL (MouseButton (..))
import Shape import Shape
import ShapePicture import ShapePicture
import ShortShow
import Sound.Data
worldSPic :: Configuration -> Universe -> SPic worldSPic :: Configuration -> Universe -> SPic
worldSPic cfig u = worldSPic cfig u =
src/Picture/Base.hs
+1 -1
View File
@@ -201,7 +201,7 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..]
text :: String -> Picture text :: String -> Picture
{-# INLINE text #-} {-# INLINE text #-}
text = translate (-50) (-100) . drawText (-10) text = translate (-50) (-100) . drawText (10)
drawText :: Float -> String -> [Verx] drawText :: Float -> String -> [Verx]
drawText gap = map f . stringToList gap drawText gap = map f . stringToList gap
src/Preload/Render.hs
+3 -1
View File
@@ -84,7 +84,9 @@ preloadRender = do
eslist <- makeShaderVBO "dualTwoD/ellipse" [vert, geom, frag] [3, 4] pmTriangles eslist <- makeShaderVBO "dualTwoD/ellipse" [vert, geom, frag] [3, 4] pmTriangles
cslist <- cslist <-
makeShaderVBO "picture/charArray" [vert, frag] [3, 4, 4] pmTriangles makeShaderVBO "picture/charArray" [vert, frag] [3, 4, 4] pmTriangles
initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_NEAREST_MIPMAP_LINEAR GL_LINEAR -- initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_NEAREST_MIPMAP_LINEAR GL_LINEAR
-- initTexture2DArray 50 "data/texture/charMapVert16Block.png" 2 16 32 95 GL_NEAREST GL_NEAREST
initTexture2DArray 50 "data/texture/charMapVert8Block.png" 2 8 16 95 GL_NEAREST GL_NEAREST
--initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR --initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
--initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_LINEAR_MIPMAP_NEAREST GL_LINEAR --initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_LINEAR_MIPMAP_NEAREST GL_LINEAR