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:
parent
cdfae7de48
commit
20bc4aa10d
2 changed files with 45 additions and 0 deletions
|
@ -13,6 +13,7 @@ import Xanthous.Entities.Character
|
||||||
import Xanthous.Entities.Item
|
import Xanthous.Entities.Item
|
||||||
import Xanthous.Entities.Creature
|
import Xanthous.Entities.Creature
|
||||||
import Xanthous.Entities.Environment
|
import Xanthous.Entities.Environment
|
||||||
|
import Xanthous.Entities.Marker
|
||||||
import Xanthous.Game.State
|
import Xanthous.Game.State
|
||||||
import Xanthous.Util.QuickCheck
|
import Xanthous.Util.QuickCheck
|
||||||
import Data.Aeson.Generic.DerivingVia
|
import Data.Aeson.Generic.DerivingVia
|
||||||
|
@ -27,6 +28,7 @@ instance Arbitrary SomeEntity where
|
||||||
, SomeEntity <$> arbitrary @Door
|
, SomeEntity <$> arbitrary @Door
|
||||||
, SomeEntity <$> arbitrary @GroundMessage
|
, SomeEntity <$> arbitrary @GroundMessage
|
||||||
, SomeEntity <$> arbitrary @Staircase
|
, SomeEntity <$> arbitrary @Staircase
|
||||||
|
, SomeEntity <$> arbitrary @Marker
|
||||||
]
|
]
|
||||||
|
|
||||||
instance FromJSON SomeEntity where
|
instance FromJSON SomeEntity where
|
||||||
|
@ -40,6 +42,7 @@ instance FromJSON SomeEntity where
|
||||||
"Door" -> SomeEntity @Door <$> obj .: "data"
|
"Door" -> SomeEntity @Door <$> obj .: "data"
|
||||||
"GroundMessage" -> SomeEntity @GroundMessage <$> obj .: "data"
|
"GroundMessage" -> SomeEntity @GroundMessage <$> obj .: "data"
|
||||||
"Staircase" -> SomeEntity @Staircase <$> obj .: "data"
|
"Staircase" -> SomeEntity @Staircase <$> obj .: "data"
|
||||||
|
"Marker" -> SomeEntity @Marker <$> obj .: "data"
|
||||||
_ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\""
|
_ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\""
|
||||||
|
|
||||||
deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameLevel
|
deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameLevel
|
||||||
|
|
42
users/glittershark/xanthous/src/Xanthous/Entities/Marker.hs
Normal file
42
users/glittershark/xanthous/src/Xanthous/Entities/Marker.hs
Normal 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
|
Loading…
Reference in a new issue