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.
This commit is contained in:
Griffin Smith 2019-10-16 12:10:59 -04:00
parent 4882350f5d
commit 87fedcb6c9
5 changed files with 30 additions and 6 deletions

View file

@ -10,6 +10,7 @@ module Xanthous.Entities
, DrawCharacter(..) , DrawCharacter(..)
, DrawStyledCharacter(..) , DrawStyledCharacter(..)
, DrawRawChar(..) , DrawRawChar(..)
, DrawRawCharPriority(..)
, Entity(..) , Entity(..)
, SomeEntity(..) , SomeEntity(..)
, downcastEntity , downcastEntity
@ -97,6 +98,21 @@ instance
) => Draw (DrawRawChar rawField a) where ) => Draw (DrawRawChar rawField a) where
draw (DrawRawChar e) = draw $ e ^. field @rawField . char 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 data EntityChar = EntityChar

View file

@ -50,6 +50,7 @@ instance Draw Character where
where where
rloc = Location (negate scrollOffset, negate scrollOffset) rloc = Location (negate scrollOffset, negate scrollOffset)
rreg = (2 * scrollOffset, 2 * 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 -- the character does not (yet) have a mind of its own
instance Brain Character where step = brainVia Brainless instance Brain Character where step = brainVia Brainless

View file

@ -35,7 +35,7 @@ import Data.Aeson.Generic.DerivingVia
import Data.Aeson (ToJSON, FromJSON) import Data.Aeson (ToJSON, FromJSON)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Xanthous.Entities.RawTypes hiding (Creature, description) import Xanthous.Entities.RawTypes hiding (Creature, description)
import Xanthous.Entities (Draw(..), DrawRawChar(..)) import Xanthous.Entities (Draw(..), DrawRawCharPriority(..))
import Xanthous.Data import Xanthous.Data
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -83,7 +83,7 @@ data Creature = Creature
} }
deriving stock (Eq, Show, Generic) deriving stock (Eq, Show, Generic)
deriving anyclass (NFData, CoArbitrary, Function) deriving anyclass (NFData, CoArbitrary, Function)
deriving Draw via DrawRawChar "_creatureType" Creature deriving Draw via DrawRawCharPriority "_creatureType" 1000 Creature
deriving (ToJSON, FromJSON) deriving (ToJSON, FromJSON)
via WithOptions '[ FieldLabelModifier '[Drop 1] ] via WithOptions '[ FieldLabelModifier '[Drop 1] ]
Creature Creature

View file

@ -4,12 +4,12 @@ module Xanthous.Game.Draw
) where ) where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Xanthous.Prelude import Xanthous.Prelude
import Brick hiding (loc) import Brick hiding (loc, on)
import Brick.Widgets.Border import Brick.Widgets.Border
import Brick.Widgets.Border.Style import Brick.Widgets.Border.Style
import Brick.Widgets.Edit import Brick.Widgets.Edit
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Xanthous.Data (Position'(..), type Position, x, y, loc) import Xanthous.Data
import Xanthous.Data.EntityMap (EntityMap, atPosition) import Xanthous.Data.EntityMap (EntityMap, atPosition)
import qualified Xanthous.Data.EntityMap as EntityMap import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Entities import Xanthous.Entities
@ -68,7 +68,10 @@ drawEntities canRenderPos allEnts
| canRenderPos pos | canRenderPos pos
= let neighbors = EntityMap.neighbors pos allEnts = let neighbors = EntityMap.neighbors pos allEnts
in maybe (str " ") (drawWithNeighbors neighbors) in maybe (str " ") (drawWithNeighbors neighbors)
$ allEnts ^? atPosition pos . folded $ maximumByOf
(atPosition pos . folded)
(compare `on` drawPriority)
allEnts
| otherwise = str " " | otherwise = str " "
drawMap :: GameState -> Widget Name drawMap :: GameState -> Widget Name

View file

@ -58,7 +58,6 @@ import Brick (EventM, Widget)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data.EntityMap (EntityMap, EntityID)
import Xanthous.Data import Xanthous.Data
(Positioned(..), type Position, Neighbors, Ticks(..))
import Xanthous.Orphans () import Xanthous.Orphans ()
import Xanthous.Game.Prompt import Xanthous.Game.Prompt
import Xanthous.Resource import Xanthous.Resource
@ -143,6 +142,10 @@ class Draw a where
draw :: a -> Widget n draw :: a -> Widget n
draw = drawWithNeighbors $ pure mempty draw = drawWithNeighbors $ pure mempty
-- | higher priority gets drawn on top
drawPriority :: a -> Word
drawPriority = const minBound
instance Draw a => Draw (Positioned a) where instance Draw a => Draw (Positioned a) where
drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a
draw (Positioned _ a) = draw a draw (Positioned _ a) = draw a
@ -185,6 +188,7 @@ instance Eq SomeEntity where
instance Draw SomeEntity where instance Draw SomeEntity where
drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent
drawPriority (SomeEntity ent) = drawPriority ent
instance Brain SomeEntity where instance Brain SomeEntity where
step ticks (Positioned pos (SomeEntity ent)) = step ticks (Positioned pos (SomeEntity ent)) =