Stop auto-moving if there's an enemy nearby

If at any point during an auto-move there's an enemy in the character's
line of sight, cancel the autocommand and send a message
This commit is contained in:
Griffin Smith 2020-05-16 18:57:07 -04:00
parent 34cabba896
commit 15b4f0e6a7
4 changed files with 44 additions and 11 deletions

View file

@ -4,16 +4,24 @@ module Xanthous.App.Autocommands
, autoStep
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
import Xanthous.Prelude
--------------------------------------------------------------------------------
import Control.Concurrent (threadDelay)
import Control.Concurrent (threadDelay)
import qualified Data.Aeson as A
import Data.Aeson (object)
import Data.List.NonEmpty (nonEmpty)
import qualified Data.List.NonEmpty as NE
import Control.Monad.State (gets)
--------------------------------------------------------------------------------
import Xanthous.App.Common
import Xanthous.App.Time
import Xanthous.Data
import Xanthous.Data.App
import Xanthous.Entities.Character (speed)
import Xanthous.Game.State
import Xanthous.App.Common
import Xanthous.App.Time
import Xanthous.Data
import Xanthous.Data.App
import Xanthous.Entities.Character (speed)
import Xanthous.Entities.Creature (Creature, creatureType)
import Xanthous.Entities.RawTypes (hostile)
import Xanthous.Game.State
import Xanthous.Game.Lenses (characterVisibleEntities)
--------------------------------------------------------------------------------
autoStep :: Autocommand -> AppM ()
@ -24,7 +32,20 @@ autoStep (AutoMove dir) = do
characterPosition .= newPos
stepGameBy =<< uses (character . speed) (|*| 1)
describeEntitiesAt newPos
maybeVisibleEnemies <- nonEmpty <$> enemiesInSight
for_ maybeVisibleEnemies $ \visibleEnemies -> do
say ["autoMove", "enemyInSight"]
$ object [ "firstEntity" A..= NE.head visibleEnemies ]
cancelAutocommand
Just _ -> cancelAutocommand
where
enemiesInSight :: AppM [Creature]
enemiesInSight = do
ents <- gets characterVisibleEntities
pure $ ents
^.. folded
. _SomeEntity @Creature
. filtered (view $ creatureType . hostile)
--------------------------------------------------------------------------------

View file

@ -9,6 +9,7 @@ module Xanthous.Entities.RawTypes
-- * Creatures
, CreatureType(..)
, hostile
-- * Items
, ItemType(..)
@ -63,6 +64,9 @@ data CreatureType = CreatureType
CreatureType
makeFieldsNoPrefix ''CreatureType
hostile :: Lens' CreatureType Bool
hostile = friendly . involuted not
--------------------------------------------------------------------------------
data EdibleItem = EdibleItem
@ -127,4 +131,3 @@ data EntityRaw
via WithOptions '[ SumEnc ObjWithSingleField ]
EntityRaw
makePrisms ''EntityRaw

View file

@ -8,6 +8,7 @@ module Xanthous.Game.Lenses
, characterPosition
, updateCharacterVision
, characterVisiblePositions
, characterVisibleEntities
, getInitialState
, initialStateFromSeed
, entitiesAtCharacter
@ -28,7 +29,8 @@ import Xanthous.Game.State
import Xanthous.Data
import Xanthous.Data.Levels
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Data.EntityMap.Graphics (visiblePositions)
import Xanthous.Data.EntityMap.Graphics
(visiblePositions, visibleEntities)
import Xanthous.Data.VectorBag
import Xanthous.Entities.Character (Character, mkCharacter)
import {-# SOURCE #-} Xanthous.Entities.Entities ()
@ -101,6 +103,11 @@ characterVisiblePositions game =
let charPos = game ^. characterPosition
in visiblePositions charPos visionRadius $ game ^. entities
characterVisibleEntities :: GameState -> EntityMap.EntityMap SomeEntity
characterVisibleEntities game =
let charPos = game ^. characterPosition
in visibleEntities charPos visionRadius $ game ^. entities
entitiesCollision
:: ( Functor f
, forall xx. MonoFoldable (f xx)

View file

@ -111,7 +111,9 @@ drop:
- You take the {{item.itemType.name}} out of your backpack and put it on the ground.
- You take the {{item.itemType.name}} out of your backpack and drop it on the ground.
autoMove:
enemyInSight:
- There's a {{firstEntity.creatureType.name}} nearby!
###
tutorial: