diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index e13eb8ffe..268e33ad6 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 f49477a2d..77314a9ae 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 diff --git a/test/Xanthous/UtilSpec.hs b/test/Xanthous/UtilSpec.hs index 1cfca1ffc..8538ea509 100644 --- a/test/Xanthous/UtilSpec.hs +++ b/test/Xanthous/UtilSpec.hs @@ -21,4 +21,8 @@ test = testGroup "Xanthous.Util" forAll (shuffle xs) $ \shuffledXs -> smallestNotIn xs === smallestNotIn shuffledXs ] + , testGroup "takeWhileInclusive" + [ testProperty "takeWhileInclusive (const True) ≡ id" + $ \(xs :: [Int]) -> takeWhileInclusive (const True) xs === xs + ] ]