feat(xan): Add a Marker entity type

It's useful, when developing new level gen techniques, to be able to
specially mark certain areas of the map during devlopment. This adds a
Marker entity type, which renders as a red X on the map and provides a
programmable description when examined. In the future it'll probably be
nice to toggle markers on/off just like we do with revealAll, but for
now it'll be fine to just remove the code to render them like we do with
debug traces.

Change-Id: Ief5d090809a0a4cbcc28f90e4902a5e38d42eeb5
Reviewed-on: https://cl.tvl.fyi/c/depot/+/724
Reviewed-by: glittershark <grfn@gws.fyi>
This commit is contained in:
Griffin Smith 2020-06-28 16:39:17 -04:00 committed by glittershark
parent cdfae7de48
commit 20bc4aa10d
2 changed files with 45 additions and 0 deletions

View file

@ -13,6 +13,7 @@ import Xanthous.Entities.Character
import Xanthous.Entities.Item
import Xanthous.Entities.Creature
import Xanthous.Entities.Environment
import Xanthous.Entities.Marker
import Xanthous.Game.State
import Xanthous.Util.QuickCheck
import Data.Aeson.Generic.DerivingVia
@ -27,6 +28,7 @@ instance Arbitrary SomeEntity where
, SomeEntity <$> arbitrary @Door
, SomeEntity <$> arbitrary @GroundMessage
, SomeEntity <$> arbitrary @Staircase
, SomeEntity <$> arbitrary @Marker
]
instance FromJSON SomeEntity where
@ -40,6 +42,7 @@ instance FromJSON SomeEntity where
"Door" -> SomeEntity @Door <$> obj .: "data"
"GroundMessage" -> SomeEntity @GroundMessage <$> obj .: "data"
"Staircase" -> SomeEntity @Staircase <$> obj .: "data"
"Marker" -> SomeEntity @Marker <$> obj .: "data"
_ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\""
deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameLevel

View file

@ -0,0 +1,42 @@
--------------------------------------------------------------------------------
module Xanthous.Entities.Marker ( Marker(..) ) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
--------------------------------------------------------------------------------
import Data.Aeson
import Test.QuickCheck
import qualified Graphics.Vty.Attributes as Vty
import qualified Graphics.Vty.Image as Vty
import Brick.Widgets.Core (raw)
--------------------------------------------------------------------------------
import Xanthous.Game.State
import Xanthous.Data.Entities (EntityAttributes(..))
import Xanthous.Data.EntityChar (style)
--------------------------------------------------------------------------------
-- | Mark on the map - for use in debugging / development only.
newtype Marker = Marker Text
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (NFData, CoArbitrary, Function)
deriving (Semigroup, Monoid, ToJSON, FromJSON, Arbitrary) via Text
instance Brain Marker where step = brainVia Brainless
instance Entity Marker where
entityAttributes = const EntityAttributes
{ _blocksVision = False
, _blocksObject = False
, _collision = Stop
}
description (Marker m) = "[M] " <> m
entityChar = const $ "X" & style .~ markerStyle
entityCollision = const Nothing
instance Draw Marker where
draw = const . raw $ Vty.char markerStyle 'X'
drawPriority = const maxBound
markerStyle :: Vty.Attr
markerStyle = Vty.defAttr
`Vty.withForeColor` Vty.red
`Vty.withBackColor` Vty.black