feat(xan): Add a Marker entity type r/1109

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>

1 files changed, 42 insertions, 0 deletions

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 000000000000..92969ec342a0
--- /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