diff options
Diffstat (limited to 'src/Xanthous/Game/Lenses.hs')
| -rw-r--r-- | src/Xanthous/Game/Lenses.hs | 27 |
1 files changed, 18 insertions, 9 deletions
diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index f49477a2db23..77314a9aea60 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -10,6 +10,7 @@ module Xanthous.Game.Lenses -- * Collisions , Collision(..) + , entityCollision , collisionAt ) where -------------------------------------------------------------------------------- @@ -93,13 +94,21 @@ data Collision deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData) +entityCollision + :: ( MonoFoldable (f SomeEntity) + , Foldable f + , Element (f SomeEntity) ~ SomeEntity + , AsEmpty (f SomeEntity) + ) + => f SomeEntity + -> Maybe Collision +entityCollision Empty = Nothing +entityCollision ents + | any (entityIs @Creature) ents = pure Combat + | all (entityIs @Item) ents = Nothing + | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door + , all (view open) doors = Nothing + | otherwise = pure Stop + collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) -collisionAt pos = do - ents <- use $ entities . EntityMap.atPosition pos - pure $ - if | null ents -> Nothing - | any (entityIs @Creature) ents -> pure Combat - | all (entityIs @Item) ents -> Nothing - | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door - , all (view open) doors -> Nothing - | otherwise -> pure Stop +collisionAt pos = uses (entities . EntityMap.atPosition pos) entityCollision |