From 87fedcb6c9bc251a5a23a632ccf985b674b84bc7 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Wed, 16 Oct 2019 12:10:59 -0400 Subject: Add draw priority Rather than blindly taking one entity from the list when we have multiple entities on the same tile, add a `drawPriority` method to the Draw typeclass which allows individual entities to request to be drawn on top - this avoids the "noodles floating over your head" bug we saw before. --- src/Xanthous/Entities.hs | 16 ++++++++++++++++ src/Xanthous/Entities/Character.hs | 1 + src/Xanthous/Entities/Creature.hs | 4 ++-- src/Xanthous/Game/Draw.hs | 9 ++++++--- src/Xanthous/Game/State.hs | 6 +++++- 5 files changed, 30 insertions(+), 6 deletions(-) (limited to 'src/Xanthous') diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index 93c4813cc483..ccd3ae42bfc3 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -10,6 +10,7 @@ module Xanthous.Entities , DrawCharacter(..) , DrawStyledCharacter(..) , DrawRawChar(..) + , DrawRawCharPriority(..) , Entity(..) , SomeEntity(..) , downcastEntity @@ -97,6 +98,21 @@ instance ) => Draw (DrawRawChar rawField a) where draw (DrawRawChar e) = draw $ e ^. field @rawField . char +newtype DrawRawCharPriority + (rawField :: Symbol) + (priority :: Nat) + (a :: Type) + = DrawRawCharPriority a + +instance + forall rawField priority a raw. + ( HasField rawField a a raw raw + , KnownNat priority + , HasChar raw EntityChar + ) => Draw (DrawRawCharPriority rawField priority a) where + draw (DrawRawCharPriority e) = draw $ e ^. field @rawField . char + drawPriority = const . fromIntegral $ natVal @priority Proxy + -------------------------------------------------------------------------------- data EntityChar = EntityChar diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 7d2d22c9983b..e3cbb2c038ff 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -50,6 +50,7 @@ instance Draw Character where where rloc = Location (negate scrollOffset, negate scrollOffset) rreg = (2 * scrollOffset, 2 * scrollOffset) + drawPriority = const maxBound -- Character should always be on top, for now -- the character does not (yet) have a mind of its own instance Brain Character where step = brainVia Brainless diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 6ea6f93e4254..4ad751a58240 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -35,7 +35,7 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Creature, description) -import Xanthous.Entities (Draw(..), DrawRawChar(..)) +import Xanthous.Entities (Draw(..), DrawRawCharPriority(..)) import Xanthous.Data -------------------------------------------------------------------------------- @@ -83,7 +83,7 @@ data Creature = Creature } deriving stock (Eq, Show, Generic) deriving anyclass (NFData, CoArbitrary, Function) - deriving Draw via DrawRawChar "_creatureType" Creature + deriving Draw via DrawRawCharPriority "_creatureType" 1000 Creature deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] Creature diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 24c177513ed1..b7d7a76956ed 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -4,12 +4,12 @@ module Xanthous.Game.Draw ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -import Brick hiding (loc) +import Brick hiding (loc, on) import Brick.Widgets.Border import Brick.Widgets.Border.Style import Brick.Widgets.Edit -------------------------------------------------------------------------------- -import Xanthous.Data (Position'(..), type Position, x, y, loc) +import Xanthous.Data import Xanthous.Data.EntityMap (EntityMap, atPosition) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities @@ -68,7 +68,10 @@ drawEntities canRenderPos allEnts | canRenderPos pos = let neighbors = EntityMap.neighbors pos allEnts in maybe (str " ") (drawWithNeighbors neighbors) - $ allEnts ^? atPosition pos . folded + $ maximumByOf + (atPosition pos . folded) + (compare `on` drawPriority) + allEnts | otherwise = str " " drawMap :: GameState -> Widget Name diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index c437f640c091..e3df5c60def2 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -58,7 +58,6 @@ import Brick (EventM, Widget) -------------------------------------------------------------------------------- import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data - (Positioned(..), type Position, Neighbors, Ticks(..)) import Xanthous.Orphans () import Xanthous.Game.Prompt import Xanthous.Resource @@ -143,6 +142,10 @@ class Draw a where draw :: a -> Widget n draw = drawWithNeighbors $ pure mempty + -- | higher priority gets drawn on top + drawPriority :: a -> Word + drawPriority = const minBound + instance Draw a => Draw (Positioned a) where drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a draw (Positioned _ a) = draw a @@ -185,6 +188,7 @@ instance Eq SomeEntity where instance Draw SomeEntity where drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent + drawPriority (SomeEntity ent) = drawPriority ent instance Brain SomeEntity where step ticks (Positioned pos (SomeEntity ent)) = -- cgit 1.4.1