diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index e30272984..25a14a9be 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -11,10 +11,10 @@ module Dodge.Creature.Picture , picAtCrPosNoRot ) where import Dodge.Data ---import Dodge.Base +import Dodge.Base import Dodge.Creature.Test import Dodge.Render.InfoBox -import Dodge.Render.List +--import Dodge.Render.List --import Dodge.Creature.AlertLevel.Data --import Dodge.Picture.Layer import Dodge.Clock @@ -74,25 +74,8 @@ basicCrShape col cr = tr . scaleSH (V3 crsize crsize crsize) $ mconcat rotmdir = rotateSH (_crMvDir cr) . colorSH (greyN 0.3) -crDisplayInfo :: Configuration -> World -> Creature -> (Point2,[String]) -crDisplayInfo cfig w cr = (_crPos cr, - [show $_crGoal ap - ,show $ _crStrategy ap - ,show $ _crAction ap - ,show $ _crImpulse ap - ] - ) - where - ap = _crActionPlan cr - crOnScreen = pointOnScreen cfig w $ _crPos cr - creatureDisplayText :: Configuration -> World -> Creature -> Picture creatureDisplayText cfig w cr - = setLayer FixedCoordLayer $ renderInfoListAt 0 0 cfig w - $ crDisplayInfo cfig w cr - -creatureDisplayText' :: Configuration -> World -> Creature -> Picture -creatureDisplayText' cfig w cr | not (_debug_cr_status cfig) = [] | otherwise = setLayer DebugLayer diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index c088ed869..2cc9e24ec 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -42,7 +42,7 @@ lineOnScreenCone cfig w p1 p2 = pointInPolygon p1 sp sps = zip sp (tail sp ++ [head sp]) pointOnScreen :: Configuration -> World -> Point2 -> Bool -pointOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w +pointOnScreen cfig w p = pointInPolygon p . reverse $ screenPolygon cfig w drawWallFace :: Configuration -> World -> Wall -> Picture drawWallFace cfig w wall diff --git a/src/Dodge/Render/InfoBox.hs b/src/Dodge/Render/InfoBox.hs index 69ce978d6..4ff24c320 100644 --- a/src/Dodge/Render/InfoBox.hs +++ b/src/Dodge/Render/InfoBox.hs @@ -7,12 +7,22 @@ import Dodge.Render.List import Dodge.Base import Picture import Geometry + +--import qualified Control.Foldl as L --import Control.Monad --import Data.Maybe renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2,[String]) -> Picture -renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat white)) - <> winScale cfig (color yellow $ zConnect (V2 (20+x-hw) (y+hh-20)) (worldPosToScreen w p)) +renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat yellow)) + <> winScale cfig (color yellow $ lConnect (V2 (x-hw) (hh-20-y)) (worldPosToScreen w p)) where hw = halfWidth cfig hh = halfHeight cfig + +renderInfoListsAt :: Float -> Float -> Configuration -> World -> [(Point2,[String])] -> Picture +renderInfoListsAt x y cfig w = + fst . foldr f (mempty,0) + where + f (p,ss) (pic,offset) = (pic <> renderInfoListAt x (y + offset) cfig w (p,ss) + , offset + 20 * fromIntegral (length ss) + ) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 7dea5a826..3571b52ad 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -2,7 +2,8 @@ module Dodge.Render.ShapePicture ( worldSPic ) where import Dodge.Config.Data ---import Dodge.Debug.Picture +import Dodge.Render.InfoBox +import Dodge.Debug.Picture import Dodge.Picture.SizeInvariant import Dodge.Data import Dodge.Base @@ -22,8 +23,8 @@ import Geometry.ConvexPoly import qualified Data.IntMap.Strict as IM -- Lazy? import qualified Data.Map.Strict as M ---import Control.Lens ---import Data.Maybe +import Control.Lens +import Data.Maybe -- TODO only filter out shapes outside the range of the furthest shown light source worldSPic :: Configuration -> World -> SPic @@ -56,6 +57,7 @@ extraPics cfig w = pictures (_decorations w) <> viewBoundaries cfig w <> viewClipBounds cfig w <> drawPathing cfig w + <> drawCrInfo cfig w testPic :: World -> Picture testPic _ = [] @@ -103,6 +105,29 @@ drawPathing cfig w where dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n gr = _pathGraph w + +crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String]) +crDisplayInfo cfig w cr + | crOnScreen = Just (_crPos cr, catMaybes + [fmap show $ ap ^? crGoal + ,fmap show $ ap ^? crStrategy + ,fmap show $ ap ^? crAction + ,fmap show $ ap ^? crImpulse + ] + ) + | otherwise = Nothing + where + ap = _crActionPlan cr + crOnScreen = pointOnScreen cfig w $ _crPos cr + +drawCrInfo :: Configuration -> World -> Picture +drawCrInfo cfig w + = setLayer FixedCoordLayer + $ renderInfoListsAt (2*hw - 200) 0 cfig w + $ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures w + where + hw = halfWidth cfig + viewBoundaries :: Configuration -> World -> Picture viewBoundaries cfig w | _debug_view_boundaries cfig diff --git a/src/Geometry/Polygon.hs b/src/Geometry/Polygon.hs index 416c8c36d..bd663ef3a 100644 --- a/src/Geometry/Polygon.hs +++ b/src/Geometry/Polygon.hs @@ -8,16 +8,16 @@ import Data.Maybe import Data.List import qualified Control.Foldl as L --- | Draw a rectangle based on maximal N E S W values. +-- | Draw a clockwise rectangle based on maximal N E S W values. rectNESW :: Float -> Float -> Float -> Float -> [Point2] rectNESW !a !b !c !d = [V2 b a,V2 b c,V2 d c,V2 d a] --- | Draw a rectangle based on maximal N S E W values. +-- | Draw a clockwise rectangle based on maximal N S E W values. rectNSEW :: Float -> Float -> Float -> Float -> [Point2] rectNSEW !n !s !e !w = rectNESW n e s w --- | Draw a rectangle based on maximal N S W E values. +-- | Draw a clockwise rectangle based on maximal N S W E values. rectNSWE :: Float -> Float -> Float -> Float -> [Point2] rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n] --- | Draw a rectangle around the origin with given height and width +-- | Draw a clockwise rectangle around the origin with given height and width rectWH :: Float -> Float -> [Point2] rectWH w h = rectNSWE h (-h) (-w) w