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:
parent
4882350f5d
commit
87fedcb6c9
5 changed files with 30 additions and 6 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)) =
|
||||||
|
|
Loading…
Reference in a new issue