From 4d2402a64ec3ca28e87ebc264f2064f310ca68f5 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 18 Jun 2021 13:04:43 -0400 Subject: [PATCH] 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 Tested-by: BuildkiteCI --- users/grfn/xanthous/src/Xanthous/App.hs | 2 ++ .../xanthous/src/Xanthous/App/Autocommands.hs | 30 +++++++++++++------ users/grfn/xanthous/src/Xanthous/Command.hs | 2 ++ .../src/Xanthous/Entities/Character.hs | 6 ++++ .../grfn/xanthous/src/Xanthous/Game/State.hs | 1 + .../grfn/xanthous/src/Xanthous/messages.yaml | 6 ++-- 6 files changed, 35 insertions(+), 12 deletions(-) diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs index d361adf41..fa4ef2d6a 100644 --- a/users/grfn/xanthous/src/Xanthous/App.hs +++ b/users/grfn/xanthous/src/Xanthous/App.hs @@ -330,6 +330,8 @@ handleCommand (StartAutoMove dir) = do runAutocommand $ AutoMove dir continue +handleCommand Rest = runAutocommand AutoRest >> continue + -- handleCommand ToggleRevealAll = do diff --git a/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs b/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs index f393a0e2e..589253613 100644 --- a/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs +++ b/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs @@ -17,12 +17,13 @@ import Xanthous.App.Common import Xanthous.App.Time import Xanthous.Data import Xanthous.Data.App -import Xanthous.Entities.Character (speed) +import Xanthous.Entities.Character (speed, isFullyHealed) import Xanthous.Entities.Creature (Creature, creatureType) import Xanthous.Entities.RawTypes (hostile) import Xanthous.Game.State -------------------------------------------------------------------------------- +-- | Step the given autocommand forward once autoStep :: Autocommand -> AppM () autoStep (AutoMove dir) = do newPos <- uses characterPosition $ move dir @@ -31,20 +32,31 @@ 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 + 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 + for_ maybeVisibleEnemies $ \visibleEnemies -> do + say ["autocommands", "enemyInSight"] + $ object [ "firstEntity" A..= NE.head visibleEnemies ] + cancelAutocommand where enemiesInSight :: AppM [Creature] enemiesInSight = do ents <- gets characterVisibleEntities pure $ ents - ^.. folded - . _SomeEntity @Creature - . filtered (view $ creatureType . hostile) + ^.. folded + . _SomeEntity @Creature + . filtered (view $ creatureType . hostile) -------------------------------------------------------------------------------- diff --git a/users/grfn/xanthous/src/Xanthous/Command.hs b/users/grfn/xanthous/src/Xanthous/Command.hs index 37025dd37..1d0014d78 100644 --- a/users/grfn/xanthous/src/Xanthous/Command.hs +++ b/users/grfn/xanthous/src/Xanthous/Command.hs @@ -27,6 +27,7 @@ data Command | Wield | GoUp | GoDown + | Rest -- | TODO replace with `:` commands | ToggleRevealAll @@ -52,6 +53,7 @@ commandFromKey (KChar 'i') [] = Just ShowInventory commandFromKey (KChar 'w') [] = Just Wield commandFromKey (KChar '<') [] = Just GoUp commandFromKey (KChar '>') [] = Just GoDown +commandFromKey (KChar 'R') [] = Just Rest -- DEBUG COMMANDS -- commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs index c18d726a4..f27ed1e47 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs @@ -32,6 +32,7 @@ module Xanthous.Entities.Character , mkCharacter , pickUpItem , isDead + , isFullyHealed , damage ) where -------------------------------------------------------------------------------- @@ -264,6 +265,11 @@ characterDamage = fromMaybe defaultCharacterDamage . 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 = (== 0) . characterHitpoints diff --git a/users/grfn/xanthous/src/Xanthous/Game/State.hs b/users/grfn/xanthous/src/Xanthous/Game/State.hs index 6f51683d1..10883ce06 100644 --- a/users/grfn/xanthous/src/Xanthous/Game/State.hs +++ b/users/grfn/xanthous/src/Xanthous/Game/State.hs @@ -442,6 +442,7 @@ data GameLevel = GameLevel data Autocommand = AutoMove Direction + | AutoRest deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, Hashable, ToJSON, FromJSON, CoArbitrary, Function) deriving Arbitrary via GenericArbitrary Autocommand diff --git a/users/grfn/xanthous/src/Xanthous/messages.yaml b/users/grfn/xanthous/src/Xanthous/messages.yaml index 4f5dff52f..e3ebd8beb 100644 --- a/users/grfn/xanthous/src/Xanthous/messages.yaml +++ b/users/grfn/xanthous/src/Xanthous/messages.yaml @@ -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 drop it on the ground. -autoMove: - enemyInSight: - - There's a {{firstEntity.creatureType.name}} nearby! +autocommands: + enemyInSight: There's a {{firstEntity.creatureType.name}} nearby! + doneResting: Done resting ### tutorial: