diff options
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/App.hs | 2 | ||||
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/App/Autocommands.hs | 30 | ||||
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/Command.hs | 2 | ||||
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/Entities/Character.hs | 6 | ||||
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/Game/State.hs | 1 | ||||
| -rw-r--r-- | users/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 d361adf418..fa4ef2d6a5 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 f393a0e2ea..5892536137 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 37025dd37a..1d0014d787 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 c18d726a4b..f27ed1e475 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 6f51683d14..10883ce06e 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 4f5dff52f6..e3ebd8bebe 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: |