diff options
| -rw-r--r-- | users/glittershark/xanthous/src/Xanthous/Entities/Entities.hs | 3 | ||||
| -rw-r--r-- | users/glittershark/xanthous/src/Xanthous/Entities/Marker.hs | 42 |
2 files changed, 45 insertions, 0 deletions
diff --git a/users/glittershark/xanthous/src/Xanthous/Entities/Entities.hs b/users/glittershark/xanthous/src/Xanthous/Entities/Entities.hs index 62e6e15c98..a0c037a1b4 100644 --- a/users/glittershark/xanthous/src/Xanthous/Entities/Entities.hs +++ b/users/glittershark/xanthous/src/Xanthous/Entities/Entities.hs @@ -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 diff --git a/users/glittershark/xanthous/src/Xanthous/Entities/Marker.hs b/users/glittershark/xanthous/src/Xanthous/Entities/Marker.hs new file mode 100644 index 0000000000..92969ec342 --- /dev/null +++ b/users/glittershark/xanthous/src/Xanthous/Entities/Marker.hs @@ -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 |