Track entity collision in the Entity class

Rather than having a single function in the Game.Lenses module for
determining what collision type if any an entity has, track it in the
Entity typeclass itself. This is both more extensible and a better
separation of concerns and gets rid of one of the two needs for a
circular import. Yay!

As part of this, I realized nothing was being done to prevent doors from
being placed on tiles that already had walls (since now that was
properly causing a collision!) so I've fixed that as well.
This commit is contained in:
Griffin Smith 2020-01-03 18:28:43 -05:00
parent 1b88921bc3
commit 84f32efad4
9 changed files with 37 additions and 35 deletions

View file

@ -27,7 +27,7 @@ import qualified Xanthous.Entities.RawTypes as Raw
import Xanthous.Entities.RawTypes (CreatureType)
import Xanthous.Game.State
import Xanthous.Game.Lenses
( Collision(..), entityCollision, collisionAt
( Collision(..), entitiesCollision, collisionAt
, character, characterPosition
)
import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee)
@ -90,7 +90,7 @@ stepGormlak ticks pe@(Positioned pos creature) = do
then attackCharacter $> pos'
else pure $ pos' `stepTowards` charPos
else do
lines <- map (takeWhile (isNothing . entityCollision . map snd . snd)
lines <- map (takeWhile (isNothing . entitiesCollision . map snd . snd)
-- the first item on these lines is always the creature itself
. fromMaybe mempty . tailMay)
. linesOfSight pos' (visionRadius creature')

View file

@ -68,6 +68,7 @@ instance Entity Creature where
blocksVision _ = False
description = view $ creatureType . Raw.description
entityChar = view $ creatureType . char
entityCollision = const $ Just Combat
--------------------------------------------------------------------------------

View file

@ -1,2 +0,0 @@
module Xanthous.Entities.Creature where
data Creature

View file

@ -47,6 +47,7 @@ instance Entity SomeEntity where
blocksVision (SomeEntity ent) = blocksVision ent
description (SomeEntity ent) = description ent
entityChar (SomeEntity ent) = entityChar ent
entityCollision (SomeEntity ent) = entityCollision ent
instance Function SomeEntity where
function = functionJSON

View file

@ -91,6 +91,8 @@ instance Entity Door where
description door | door ^. open = "an open door"
| otherwise = "a closed door"
entityChar _ = "d"
entityCollision door | door ^. open = Nothing
| otherwise = Just Stop
-- | A closed, unlocked door
unlockedDoor :: Door
@ -113,8 +115,10 @@ newtype GroundMessage = GroundMessage Text
deriving Draw
via DrawStyledCharacter ('Just 'Yellow) 'Nothing ""
GroundMessage
deriving Entity
via DeriveEntity 'False "a message on the ground. Press r. to read it."
""
GroundMessage
instance Brain GroundMessage where step = brainVia Brainless
instance Entity GroundMessage where
blocksVision = const False
description = const "a message on the ground. Press r. to read it."
entityChar = const ""
entityCollision = const Nothing

View file

@ -41,6 +41,7 @@ instance Entity Item where
blocksVision _ = False
description = view $ itemType . Raw.description
entityChar = view $ itemType . Raw.char
entityCollision = const Nothing
newWithType :: ItemType -> Item
newWithType = Item

View file

@ -1,4 +1,6 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
--------------------------------------------------------------------------------
module Xanthous.Game.Lenses
( positionedCharacter
@ -11,7 +13,7 @@ module Xanthous.Game.Lenses
-- * Collisions
, Collision(..)
, entityCollision
, entitiesCollision
, collisionAt
) where
--------------------------------------------------------------------------------
@ -26,9 +28,6 @@ import Xanthous.Data
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Data.EntityMap.Graphics (visiblePositions)
import Xanthous.Entities.Character (Character, mkCharacter)
import Xanthous.Entities.Environment (Door, open, GroundMessage)
import Xanthous.Entities.Item (Item)
import {-# SOURCE #-} Xanthous.Entities.Creature (Creature)
import {-# SOURCE #-} Xanthous.Entities.Entities ()
--------------------------------------------------------------------------------
@ -96,31 +95,17 @@ characterVisiblePositions game =
let charPos = game ^. characterPosition
in visiblePositions charPos visionRadius $ game ^. entities
data Collision
= Stop
| Combat
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (NFData)
entityCollision
:: ( MonoFoldable (f SomeEntity)
, Foldable f
, Element (f SomeEntity) ~ SomeEntity
, AsEmpty (f SomeEntity)
entitiesCollision
:: ( Functor f
, forall xx. MonoFoldable (f xx)
, forall xx. Element (f xx) ~ xx
, Element (f (Maybe Collision)) ~ Maybe Collision
, Show (f (Maybe Collision))
, Show (f SomeEntity)
)
=> f SomeEntity
-> Maybe Collision
entityCollision Empty = Nothing
entityCollision ents
-- TODO track entity collision in the Entity class
| any (entityIs @Creature) ents = pure Combat
| all (\e ->
entityIs @Item e
|| entityIs @GroundMessage e
) ents = Nothing
| doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door
, all (view open) doors = Nothing
| otherwise = pure Stop
entitiesCollision = join . maximumMay . fmap entityCollision
collisionAt :: MonadState GameState m => Position -> m (Maybe Collision)
collisionAt pos = uses (entities . EntityMap.atPosition pos) entityCollision
collisionAt pos = uses (entities . EntityMap.atPosition pos) entitiesCollision

View file

@ -34,6 +34,7 @@ module Xanthous.Game.State
, Brain(..)
, Brainless(..)
, brainVia
, Collision(..)
, Entity(..)
, SomeEntity(..)
, downcastEntity
@ -306,6 +307,13 @@ brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain)
--------------------------------------------------------------------------------
data Collision
= Stop -- ^ Can't move through this
| Combat -- ^ Moving into this equates to hitting it with a stick
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (NFData)
class ( Show a, Eq a, Ord a, NFData a
, ToJSON a, FromJSON a
, Draw a, Brain a
@ -313,6 +321,8 @@ class ( Show a, Eq a, Ord a, NFData a
blocksVision :: a -> Bool
description :: a -> Text
entityChar :: a -> EntityChar
entityCollision :: a -> Maybe Collision
entityCollision = const $ Just Stop
data SomeEntity where
SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity

View file

@ -45,6 +45,8 @@ randomDoors cells = do
candidateCells = filter doorable $ Arr.indices cells
subsetRange = (0.8 :: Double, 1.0)
doorable (x, y) =
not (fromMaybe True $ cells ^? ix (x, y))
&&
( fromMaybe True $ cells ^? ix (x - 1, y) -- left
, fromMaybe True $ cells ^? ix (x, y - 1) -- top
, fromMaybe True $ cells ^? ix (x + 1, y) -- right