diff options
Diffstat (limited to 'src/Xanthous')
-rw-r--r-- | src/Xanthous/AI/Gormlak.hs | 12 | ||||
-rw-r--r-- | src/Xanthous/Game/Lenses.hs | 27 |
2 files changed, 27 insertions, 12 deletions
diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index e13eb8ffe71a..268e33ad6caa 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -27,7 +27,9 @@ import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Entities (Entity(..), Brain(..), brainVia) import Xanthous.Game.State (entities, GameState, entityIs) import Xanthous.Game.Lenses - ( Collision(..), collisionAt, character, characterPosition ) + ( Collision(..), entityCollision, collisionAt + , character, characterPosition + ) import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee) import Xanthous.Random import Xanthous.Monad (say) @@ -72,9 +74,13 @@ stepGormlak ticks pe@(Positioned pos creature) = do then attackCharacter $> pos' else pure $ pos' `stepTowards` charPos else do - lines <- uses entities $ linesOfSight pos' (Creature.visionRadius creature') + lines <- map (takeWhile (isNothing . entityCollision . map snd . snd) + -- the first item on these lines is always the creature itself + . fromMaybe mempty . tailMay) + . linesOfSight pos' (Creature.visionRadius creature') + <$> use entities line <- choose $ weightedBy length lines - pure $ fromMaybe pos' $ fmap fst . headMay =<< tailMay =<< line + pure $ fromMaybe pos' $ fmap fst . headMay =<< line vision = Creature.visionRadius creature attackCharacter = do 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 |