Add creature info display
This commit is contained in:
@@ -11,10 +11,10 @@ module Dodge.Creature.Picture
|
|||||||
, picAtCrPosNoRot
|
, picAtCrPosNoRot
|
||||||
) where
|
) where
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
--import Dodge.Base
|
import Dodge.Base
|
||||||
import Dodge.Creature.Test
|
import Dodge.Creature.Test
|
||||||
import Dodge.Render.InfoBox
|
import Dodge.Render.InfoBox
|
||||||
import Dodge.Render.List
|
--import Dodge.Render.List
|
||||||
--import Dodge.Creature.AlertLevel.Data
|
--import Dodge.Creature.AlertLevel.Data
|
||||||
--import Dodge.Picture.Layer
|
--import Dodge.Picture.Layer
|
||||||
import Dodge.Clock
|
import Dodge.Clock
|
||||||
@@ -74,25 +74,8 @@ basicCrShape col cr = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
|
|||||||
rotmdir = rotateSH (_crMvDir cr)
|
rotmdir = rotateSH (_crMvDir cr)
|
||||||
. colorSH (greyN 0.3)
|
. 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 :: Configuration -> World -> Creature -> Picture
|
||||||
creatureDisplayText cfig w cr
|
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) = []
|
| not (_debug_cr_status cfig) = []
|
||||||
| otherwise
|
| otherwise
|
||||||
= setLayer DebugLayer
|
= setLayer DebugLayer
|
||||||
|
|||||||
@@ -42,7 +42,7 @@ lineOnScreenCone cfig w p1 p2 = pointInPolygon p1 sp
|
|||||||
sps = zip sp (tail sp ++ [head sp])
|
sps = zip sp (tail sp ++ [head sp])
|
||||||
|
|
||||||
pointOnScreen :: Configuration -> World -> Point2 -> Bool
|
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 :: Configuration -> World -> Wall -> Picture
|
||||||
drawWallFace cfig w wall
|
drawWallFace cfig w wall
|
||||||
|
|||||||
@@ -7,12 +7,22 @@ import Dodge.Render.List
|
|||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
import Picture
|
import Picture
|
||||||
import Geometry
|
import Geometry
|
||||||
|
|
||||||
|
--import qualified Control.Foldl as L
|
||||||
--import Control.Monad
|
--import Control.Monad
|
||||||
--import Data.Maybe
|
--import Data.Maybe
|
||||||
|
|
||||||
renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2,[String]) -> Picture
|
renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2,[String]) -> Picture
|
||||||
renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat white))
|
renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat yellow))
|
||||||
<> winScale cfig (color yellow $ zConnect (V2 (20+x-hw) (y+hh-20)) (worldPosToScreen w p))
|
<> winScale cfig (color yellow $ lConnect (V2 (x-hw) (hh-20-y)) (worldPosToScreen w p))
|
||||||
where
|
where
|
||||||
hw = halfWidth cfig
|
hw = halfWidth cfig
|
||||||
hh = halfHeight 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)
|
||||||
|
)
|
||||||
|
|||||||
@@ -2,7 +2,8 @@ module Dodge.Render.ShapePicture
|
|||||||
( worldSPic
|
( worldSPic
|
||||||
) where
|
) where
|
||||||
import Dodge.Config.Data
|
import Dodge.Config.Data
|
||||||
--import Dodge.Debug.Picture
|
import Dodge.Render.InfoBox
|
||||||
|
import Dodge.Debug.Picture
|
||||||
import Dodge.Picture.SizeInvariant
|
import Dodge.Picture.SizeInvariant
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
@@ -22,8 +23,8 @@ import Geometry.ConvexPoly
|
|||||||
|
|
||||||
import qualified Data.IntMap.Strict as IM -- Lazy?
|
import qualified Data.IntMap.Strict as IM -- Lazy?
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
--import Control.Lens
|
import Control.Lens
|
||||||
--import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
-- TODO only filter out shapes outside the range of the furthest shown light source
|
-- TODO only filter out shapes outside the range of the furthest shown light source
|
||||||
worldSPic :: Configuration -> World -> SPic
|
worldSPic :: Configuration -> World -> SPic
|
||||||
@@ -56,6 +57,7 @@ extraPics cfig w = pictures (_decorations w)
|
|||||||
<> viewBoundaries cfig w
|
<> viewBoundaries cfig w
|
||||||
<> viewClipBounds cfig w
|
<> viewClipBounds cfig w
|
||||||
<> drawPathing cfig w
|
<> drawPathing cfig w
|
||||||
|
<> drawCrInfo cfig w
|
||||||
|
|
||||||
testPic :: World -> Picture
|
testPic :: World -> Picture
|
||||||
testPic _ = []
|
testPic _ = []
|
||||||
@@ -103,6 +105,29 @@ drawPathing cfig w
|
|||||||
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 = _pathGraph w
|
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 :: Configuration -> World -> Picture
|
||||||
viewBoundaries cfig w
|
viewBoundaries cfig w
|
||||||
| _debug_view_boundaries cfig
|
| _debug_view_boundaries cfig
|
||||||
|
|||||||
@@ -8,16 +8,16 @@ import Data.Maybe
|
|||||||
import Data.List
|
import Data.List
|
||||||
import qualified Control.Foldl as L
|
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 :: Float -> Float -> Float -> Float -> [Point2]
|
||||||
rectNESW !a !b !c !d = [V2 b a,V2 b c,V2 d c,V2 d a]
|
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 :: Float -> Float -> Float -> Float -> [Point2]
|
||||||
rectNSEW !n !s !e !w = rectNESW n e s w
|
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 :: Float -> Float -> Float -> Float -> [Point2]
|
||||||
rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n]
|
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 :: Float -> Float -> [Point2]
|
||||||
rectWH w h = rectNSWE h (-h) (-w) w
|
rectWH w h = rectNSWE h (-h) (-w) w
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user