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…
	
	Add table
		Add a link
		
	
		Reference in a new issue