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(..)
, 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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)) =