feat(xanthous): Add an auto-rest command

Add a command that automatically rests (essentially just stepping the
game forwards) until the character's hitpoints are back to full.

Currently due to the time it takes for the character to heal this takes
a bit too long - my thought there is to make the per-step delay for
autocommands different depending on the specific autocommand.

Change-Id: I40378c29d3d9d19e9787af1f015bde65fd08868c
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3221
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI
This commit is contained in:
Griffin Smith 2021-06-18 13:04:43 -04:00 committed by grfn
parent fb5bec8d95
commit 4d2402a64e
6 changed files with 35 additions and 12 deletions

View file

@ -330,6 +330,8 @@ handleCommand (StartAutoMove dir) = do
runAutocommand $ AutoMove dir runAutocommand $ AutoMove dir
continue continue
handleCommand Rest = runAutocommand AutoRest >> continue
-- --
handleCommand ToggleRevealAll = do handleCommand ToggleRevealAll = do

View file

@ -17,12 +17,13 @@ import Xanthous.App.Common
import Xanthous.App.Time import Xanthous.App.Time
import Xanthous.Data import Xanthous.Data
import Xanthous.Data.App import Xanthous.Data.App
import Xanthous.Entities.Character (speed) import Xanthous.Entities.Character (speed, isFullyHealed)
import Xanthous.Entities.Creature (Creature, creatureType) import Xanthous.Entities.Creature (Creature, creatureType)
import Xanthous.Entities.RawTypes (hostile) import Xanthous.Entities.RawTypes (hostile)
import Xanthous.Game.State import Xanthous.Game.State
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Step the given autocommand forward once
autoStep :: Autocommand -> AppM () autoStep :: Autocommand -> AppM ()
autoStep (AutoMove dir) = do autoStep (AutoMove dir) = do
newPos <- uses characterPosition $ move dir newPos <- uses characterPosition $ move dir
@ -31,12 +32,23 @@ autoStep (AutoMove dir) = do
characterPosition .= newPos characterPosition .= newPos
stepGameBy =<< uses (character . speed) (|*| 1) stepGameBy =<< uses (character . speed) (|*| 1)
describeEntitiesAt newPos describeEntitiesAt newPos
cancelIfDanger
Just _ -> cancelAutocommand
autoStep AutoRest = do
done <- uses character isFullyHealed
if done
then say_ ["autocommands", "doneResting"] >> cancelAutocommand
else stepGame >> cancelIfDanger
-- | Cancel the autocommand if the character is in danger
cancelIfDanger :: AppM ()
cancelIfDanger = do
maybeVisibleEnemies <- nonEmpty <$> enemiesInSight maybeVisibleEnemies <- nonEmpty <$> enemiesInSight
for_ maybeVisibleEnemies $ \visibleEnemies -> do for_ maybeVisibleEnemies $ \visibleEnemies -> do
say ["autoMove", "enemyInSight"] say ["autocommands", "enemyInSight"]
$ object [ "firstEntity" A..= NE.head visibleEnemies ] $ object [ "firstEntity" A..= NE.head visibleEnemies ]
cancelAutocommand cancelAutocommand
Just _ -> cancelAutocommand
where where
enemiesInSight :: AppM [Creature] enemiesInSight :: AppM [Creature]
enemiesInSight = do enemiesInSight = do

View file

@ -27,6 +27,7 @@ data Command
| Wield | Wield
| GoUp | GoUp
| GoDown | GoDown
| Rest
-- | TODO replace with `:` commands -- | TODO replace with `:` commands
| ToggleRevealAll | ToggleRevealAll
@ -52,6 +53,7 @@ commandFromKey (KChar 'i') [] = Just ShowInventory
commandFromKey (KChar 'w') [] = Just Wield commandFromKey (KChar 'w') [] = Just Wield
commandFromKey (KChar '<') [] = Just GoUp commandFromKey (KChar '<') [] = Just GoUp
commandFromKey (KChar '>') [] = Just GoDown commandFromKey (KChar '>') [] = Just GoDown
commandFromKey (KChar 'R') [] = Just Rest
-- DEBUG COMMANDS -- -- DEBUG COMMANDS --
commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll

View file

@ -32,6 +32,7 @@ module Xanthous.Entities.Character
, mkCharacter , mkCharacter
, pickUpItem , pickUpItem
, isDead , isDead
, isFullyHealed
, damage , damage
) where ) where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -264,6 +265,11 @@ characterDamage
= fromMaybe defaultCharacterDamage = fromMaybe defaultCharacterDamage
. preview (inventory . wielded . wieldedItems . wieldableItem . Raw.damage) . preview (inventory . wielded . wieldedItems . wieldableItem . Raw.damage)
-- | Is the character fully healed up to or past their initial hitpoints?
isFullyHealed :: Character -> Bool
isFullyHealed = (>= initialHitpoints) . characterHitpoints
-- | Is the character dead?
isDead :: Character -> Bool isDead :: Character -> Bool
isDead = (== 0) . characterHitpoints isDead = (== 0) . characterHitpoints

View file

@ -442,6 +442,7 @@ data GameLevel = GameLevel
data Autocommand data Autocommand
= AutoMove Direction = AutoMove Direction
| AutoRest
deriving stock (Show, Eq, Ord, Generic) deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (NFData, Hashable, ToJSON, FromJSON, CoArbitrary, Function) deriving anyclass (NFData, Hashable, ToJSON, FromJSON, CoArbitrary, Function)
deriving Arbitrary via GenericArbitrary Autocommand deriving Arbitrary via GenericArbitrary Autocommand

View file

@ -113,9 +113,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 put it on the ground.
- You take the {{item.itemType.name}} out of your backpack and drop it on the ground. - You take the {{item.itemType.name}} out of your backpack and drop it on the ground.
autoMove: autocommands:
enemyInSight: enemyInSight: There's a {{firstEntity.creatureType.name}} nearby!
- There's a {{firstEntity.creatureType.name}} nearby! doneResting: Done resting
### ###
tutorial: tutorial: