diff options
author | Griffin Smith <root@gws.fyi> | 2019-10-06T16·50-0400 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-10-06T16·50-0400 |
commit | de8052cef8a9f749cdb2312a4f5ae5f5a44cf1b8 (patch) | |
tree | 734d38ad7279b0188b46f67e0288c5efddab7f8e /src | |
parent | 262fc7fb41f14181ed34cecfcca9ef2d25102688 (diff) |
Allow eating edible items
Add menu support to the prompt system, and an "Eat" command that prompts for an item to eat and eats the item the character specifies, restoring an amount of hitpoints configurable via the item raw type.
Diffstat (limited to 'src')
-rw-r--r-- | src/Xanthous/App.hs | 84 | ||||
-rw-r--r-- | src/Xanthous/Command.hs | 2 | ||||
-rw-r--r-- | src/Xanthous/Entities.hs | 12 | ||||
-rw-r--r-- | src/Xanthous/Entities/Item.hs | 6 | ||||
-rw-r--r-- | src/Xanthous/Entities/RawTypes.hs | 33 | ||||
-rw-r--r-- | src/Xanthous/Entities/Raws/noodles.yaml | 4 | ||||
-rw-r--r-- | src/Xanthous/Game/Draw.hs | 16 | ||||
-rw-r--r-- | src/Xanthous/Game/Prompt.hs | 79 | ||||
-rw-r--r-- | src/Xanthous/Messages.hs | 27 | ||||
-rw-r--r-- | src/Xanthous/Monad.hs | 37 | ||||
-rw-r--r-- | src/Xanthous/Util.hs | 10 | ||||
-rw-r--r-- | src/Xanthous/messages.yaml | 21 |
12 files changed, 258 insertions, 73 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 72c9a3f553ad..eb2f0cf7ad83 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -13,6 +13,7 @@ import Control.Monad.Random (MonadRandom) import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A +import qualified Data.Vector as V import System.Exit -------------------------------------------------------------------------------- import Xanthous.Command @@ -29,16 +30,18 @@ import Xanthous.Game.Draw (drawGame) import Xanthous.Game.Prompt import Xanthous.Monad import Xanthous.Resource (Name) -import Xanthous.Messages (message) +import qualified Xanthous.Messages as Messages import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- import qualified Xanthous.Entities.Character as Character import Xanthous.Entities.Character import Xanthous.Entities import Xanthous.Entities.Item (Item) +import qualified Xanthous.Entities.Item as Item import Xanthous.Entities.Creature (Creature) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Environment (Door, open, locked) +import Xanthous.Entities.RawTypes (edible, eatMessage, hitpointsHealed) import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -------------------------------------------------------------------------------- @@ -155,6 +158,26 @@ handleCommand Open = do handleCommand Wait = stepGame >> continue +handleCommand Eat = do + uses (character . inventory) + (V.mapMaybe (\item -> (item,) <$> item ^. Item.itemType . edible)) + >>= \case + Empty -> say_ ["eat", "noFood"] + food -> + let foodMenuItem idx (item, edibleItem) + = ( item ^. Item.itemType . char . char + , MenuOption (description item) (idx, item, edibleItem)) + menuItems = mkMenuItems $ imap foodMenuItem food + in menu_ ["eat", "menuPrompt"] Cancellable menuItems + $ \(MenuResult (idx, item, edibleItem)) -> do + character . inventory %= \inv -> + let (before, after) = V.splitAt idx inv + in before <> fromMaybe Empty (tailMay after) + let msg = fromMaybe (Messages.lookup ["eat", "eat"]) + $ edibleItem ^. eatMessage + message msg $ object ["item" A..= item] + continue + handleCommand ToggleRevealAll = do val <- debugState . allRevealed <%= not say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ] @@ -168,39 +191,43 @@ handlePromptEvent -> BrickEvent Name () -> AppM (Next GameState) -handlePromptEvent _ (Prompt Cancellable _ _ _) (VtyEvent (EvKey KEsc [])) = do - promptState .= NoPrompt - continue -handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = do - submitPrompt pr +handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) = do promptState .= NoPrompt continue +handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = + submitPrompt pr >> clearPrompt handlePromptEvent msg - (Prompt c SStringPrompt (StringPromptState edit) cb) + (Prompt c SStringPrompt (StringPromptState edit) pi cb) (VtyEvent ev) = do edit' <- lift $ handleEditorEvent ev edit - let prompt' = Prompt c SStringPrompt (StringPromptState edit') cb + let prompt' = Prompt c SStringPrompt (StringPromptState edit') pi cb promptState .= WaitingPrompt msg prompt' continue -handlePromptEvent _ (Prompt _ SDirectionPrompt _ cb) +handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb) (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) - = do - cb $ DirectionResult dir - promptState .= NoPrompt - continue -handlePromptEvent _ (Prompt _ SDirectionPrompt _ _) _ = continue + = cb (DirectionResult dir) >> clearPrompt +handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue -handlePromptEvent _ (Prompt _ SContinue _ _) _ = continue +handlePromptEvent _ (Prompt _ SContinue _ _ _) _ = continue + +handlePromptEvent _ (Prompt _ SMenu _ items cb) (VtyEvent (EvKey (KChar chr) [])) + | Just (MenuOption _ res) <- items ^. at chr + = cb (MenuResult res) >> clearPrompt + | otherwise + = continue handlePromptEvent _ _ _ = undefined +clearPrompt :: AppM (Next GameState) +clearPrompt = promptState .= NoPrompt >> continue + prompt :: forall (pt :: PromptType) (params :: Type). - (ToJSON params, SingPromptType pt) + (ToJSON params, SingPromptType pt, PromptInput pt ~ ()) => [Text] -- ^ Message key -> params -- ^ Message params -> PromptCancellable @@ -208,19 +235,40 @@ prompt -> AppM () prompt msgPath params cancellable cb = do let pt = singPromptType @pt - msg <- message msgPath params + msg <- Messages.message msgPath params let p = mkPrompt cancellable pt cb promptState .= WaitingPrompt msg p prompt_ :: forall (pt :: PromptType) . - (SingPromptType pt) + (SingPromptType pt, PromptInput pt ~ ()) => [Text] -- ^ Message key -> PromptCancellable -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler -> AppM () prompt_ msg = prompt msg $ object [] +menu :: forall (a :: Type) (params :: Type). + (ToJSON params) + => [Text] -- ^ Message key + -> params -- ^ Message params + -> PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler + -> AppM () +menu msgPath params cancellable items cb = do + msg <- Messages.message msgPath params + let p = mkMenu cancellable items cb + promptState .= WaitingPrompt msg p + +menu_ :: forall (a :: Type). + [Text] -- ^ Message key + -> PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler + -> AppM () +menu_ msgPath = menu msgPath $ object [] + -------------------------------------------------------------------------------- entitiesAtPositionWithType diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 4bf0e2893908..f2f21160df75 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -16,6 +16,7 @@ data Command | PickUp | Open | Wait + | Eat -- | TODO replace with `:` commands | ToggleRevealAll @@ -27,6 +28,7 @@ commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage commandFromKey (KChar ',') [] = Just PickUp commandFromKey (KChar 'o') [] = Just Open +commandFromKey (KChar 'e') [] = Just Eat commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll commandFromKey _ _ = Nothing diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index 15080b3221e0..af226b395d9e 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- module Xanthous.Entities ( Draw(..) @@ -103,6 +104,7 @@ data EntityChar = EntityChar } deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) +makeFieldsNoPrefix ''EntityChar instance Arbitrary EntityChar where arbitrary = genericArbitrary diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index 832f0d4d62b3..ea6f16e05dc3 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -5,6 +5,7 @@ module Xanthous.Entities.Item ( Item(..) , itemType , newWithType + , isEdible ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -12,7 +13,7 @@ import Test.QuickCheck import Data.Aeson (ToJSON, FromJSON) import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes hiding (Item, description) +import Xanthous.Entities.RawTypes hiding (Item, description, isEdible) import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Entities ( Draw(..) @@ -47,3 +48,6 @@ instance Entity Item where newWithType :: ItemType -> Item newWithType = Item + +isEdible :: Item -> Bool +isEdible = Raw.isEdible . view itemType diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index 3fb89c58ba3b..f1f5e05f7aac 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -3,14 +3,20 @@ -------------------------------------------------------------------------------- module Xanthous.Entities.RawTypes ( CreatureType(..) + , EdibleItem(..) , ItemType(..) + , isEdible , EntityRaw(..) + -- * Lens classes , HasName(..) , HasDescription(..) , HasLongDescription(..) , HasMaxHitpoints(..) , HasFriendly(..) + , HasEatMessage(..) + , HasHitpointsHealed(..) + , HasEdible(..) , _Creature ) where -------------------------------------------------------------------------------- @@ -21,6 +27,7 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities (EntityChar, HasChar(..)) +import Xanthous.Messages (Message(..)) -------------------------------------------------------------------------------- data CreatureType = CreatureType { _name :: Text @@ -41,11 +48,26 @@ instance Arbitrary CreatureType where -------------------------------------------------------------------------------- +data EdibleItem = EdibleItem + { _hitpointsHealed :: Int + , _eatMessage :: Maybe Message + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + EdibleItem +makeFieldsNoPrefix ''EdibleItem + +instance Arbitrary EdibleItem where + arbitrary = genericArbitrary + data ItemType = ItemType - { _name :: Text - , _description :: Text + { _name :: Text + , _description :: Text , _longDescription :: Text - , _char :: EntityChar + , _char :: EntityChar + , _edible :: Maybe EdibleItem } deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) @@ -57,6 +79,11 @@ makeFieldsNoPrefix ''ItemType instance Arbitrary ItemType where arbitrary = genericArbitrary +isEdible :: ItemType -> Bool +isEdible = has $ edible . _Just + +-------------------------------------------------------------------------------- + data EntityRaw = Creature CreatureType | Item ItemType diff --git a/src/Xanthous/Entities/Raws/noodles.yaml b/src/Xanthous/Entities/Raws/noodles.yaml index 91a0a35388ad..c3f19dce91d1 100644 --- a/src/Xanthous/Entities/Raws/noodles.yaml +++ b/src/Xanthous/Entities/Raws/noodles.yaml @@ -6,3 +6,7 @@ Item: char: 'n' style: foreground: yellow + edible: + hitpointsHealed: 2 + eatMessage: + - You slurp up the noodles. Yumm! diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index addeaa14cd45..9f247d383325 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -37,13 +37,19 @@ drawMessages = txt . (<> " ") . unwords . oextract drawPromptState :: GamePromptState m -> Widget Name drawPromptState NoPrompt = emptyWidget -drawPromptState (WaitingPrompt msg (Prompt _ pt ps _)) = - case (pt, ps) of - (SStringPrompt, StringPromptState edit) -> +drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = + case (pt, ps, pri) of + (SStringPrompt, StringPromptState edit, _) -> txt msg <+> renderEditor (txt . fold) True edit - (SDirectionPrompt, DirectionPromptState) -> txt msg - (SContinue, _) -> txt msg + (SDirectionPrompt, DirectionPromptState, _) -> txt msg + (SContinue, _, _) -> txt msg + (SMenu, _, menuItems) -> + txt msg + <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems) _ -> undefined + where + drawMenuItem (chr, MenuOption m _) = + str ("[" <> pure chr <> "] ") <+> txt m drawEntities :: (Position -> Bool) diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index cb34793c6d60..26a7b96eb1f2 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -8,20 +8,25 @@ module Xanthous.Game.Prompt , PromptCancellable(..) , PromptResult(..) , PromptState(..) + , MenuOption(..) + , mkMenuItems + , PromptInput , Prompt(..) , mkPrompt + , mkMenu , isCancellable , submitPrompt ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- -import Brick.Widgets.Edit (Editor, editorText, getEditContents) -import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic +import Brick.Widgets.Edit (Editor, editorText, getEditContents) +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- -import Xanthous.Data (Direction, Position) -import Xanthous.Resource (Name) +import Xanthous.Util (smallestNotIn) +import Xanthous.Data (Direction, Position) +import Xanthous.Resource (Name) import qualified Xanthous.Resource as Resource -------------------------------------------------------------------------------- @@ -81,12 +86,31 @@ data PromptResult (pt :: PromptType) where ContinueResult :: PromptResult 'Continue data PromptState pt where - StringPromptState :: Editor Text Name -> PromptState 'StringPrompt - DirectionPromptState :: PromptState 'DirectionPrompt - ContinuePromptState :: PromptState 'Continue + StringPromptState :: Editor Text Name -> PromptState 'StringPrompt + DirectionPromptState :: PromptState 'DirectionPrompt + ContinuePromptState :: PromptState 'Continue + MenuPromptState :: forall a. PromptState ('Menu a) deriving stock instance Show (PromptState pt) +data MenuOption a = MenuOption Text a + +mkMenuItems :: (MonoFoldable f, Element f ~ (Char, MenuOption a)) + => f + -> Map Char (MenuOption a) +mkMenuItems = flip foldl' mempty $ \items (chr, option) -> + let chr' = if has (ix chr) items + then smallestNotIn $ keys items + else chr + in items & at chr' ?~ option + +instance Show (MenuOption a) where + show (MenuOption m _) = show m + +type family PromptInput (pt :: PromptType) :: Type where + PromptInput ('Menu a) = Map Char (MenuOption a) + PromptInput _ = () + data Prompt (m :: Type -> Type) where Prompt :: forall (pt :: PromptType) @@ -94,38 +118,53 @@ data Prompt (m :: Type -> Type) where PromptCancellable -> SPromptType pt -> PromptState pt + -> PromptInput pt -> (PromptResult pt -> m ()) -> Prompt m instance Show (Prompt m) where - show (Prompt c pt ps _) + show (Prompt c pt ps pri _) = "(Prompt " <> show c <> " " <> show pt <> " " - <> show ps - <> " <function> )" - -mkPrompt :: PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m + <> show ps <> " " + <> showPri + <> " <function>)" + where showPri = case pt of + SMenu -> show pri + _ -> "()" + +mkPrompt :: (PromptInput pt ~ ()) => PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m mkPrompt c pt@SStringPrompt cb = let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" - in Prompt c pt ps cb -mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState cb -mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState cb + in Prompt c pt ps () cb +mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState () cb +mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState () cb mkPrompt _ _ _ = undefined +mkMenu + :: forall a m. + PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> m ()) + -> Prompt m +mkMenu c = Prompt c SMenu MenuPromptState + isCancellable :: Prompt m -> Bool -isCancellable (Prompt Cancellable _ _ _) = True -isCancellable (Prompt Uncancellable _ _ _) = False +isCancellable (Prompt Cancellable _ _ _ _) = True +isCancellable (Prompt Uncancellable _ _ _ _) = False submitPrompt :: Applicative m => Prompt m -> m () -submitPrompt (Prompt _ pt ps cb) = +submitPrompt (Prompt _ pt ps _ cb) = case (pt, ps) of (SStringPrompt, StringPromptState edit) -> cb . StringResult . mconcat . getEditContents $ edit (SDirectionPrompt, DirectionPromptState) -> pure () -- Don't use submit with a direction prompt (SContinue, ContinuePromptState) -> - cb ContinueResult -- Don't use submit with a direction prompt + cb ContinueResult + (SMenu, MenuPromptState) -> + pure () -- Don't use submit with a menu prompt _ -> undefined -- data PromptInput :: PromptType -> Type where diff --git a/src/Xanthous/Messages.hs b/src/Xanthous/Messages.hs index b1aeeb635cc9..b0dc0e4ae9d2 100644 --- a/src/Xanthous/Messages.hs +++ b/src/Xanthous/Messages.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- module Xanthous.Messages ( Message(..) , resolve @@ -7,11 +8,13 @@ module Xanthous.Messages -- * Game messages , messages + , render + , lookup , message ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude - +import Xanthous.Prelude hiding (lookup) +-------------------------------------------------------------------------------- import Control.Monad.Random.Class (MonadRandom) import Data.Aeson (FromJSON, ToJSON, toJSON) import Data.Aeson.Generic.DerivingVia @@ -22,9 +25,10 @@ import Test.QuickCheck.Arbitrary.Generic import Test.QuickCheck.Instances.UnorderedContainers () import Text.Mustache import qualified Data.Yaml as Yaml - +-------------------------------------------------------------------------------- import Xanthous.Random import Xanthous.Orphans () +-------------------------------------------------------------------------------- data Message = Single Template | Choice (NonEmpty Template) deriving stock (Show, Eq, Ord, Generic) @@ -78,10 +82,19 @@ messages = either (error . Yaml.prettyPrintParseException) id $ Yaml.decodeEither' rawMessages +render :: (MonadRandom m, ToJSON params) => Message -> params -> m Text +render msg params = do + tpl <- resolve msg + pure . toStrict . renderMustache tpl $ toJSON params + +lookup :: [Text] -> Message +lookup path = fromMaybe notFound $ messages ^? ix path + where notFound + = Single + $ compileMustacheText "template" "Message not found" + ^?! _Right + message :: (MonadRandom m, ToJSON params) => [Text] -> params -> m Text -message path params = maybe notFound renderMessage $ messages ^? ix path +message path params = maybe notFound (`render` params) $ messages ^? ix path where - renderMessage msg = do - tpl <- resolve msg - pure . toStrict . renderMustache tpl $ toJSON params notFound = pure "Message not found" diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs index 3e567ee8fa5e..c11cb0e2d4df 100644 --- a/src/Xanthous/Monad.hs +++ b/src/Xanthous/Monad.hs @@ -1,22 +1,28 @@ +-------------------------------------------------------------------------------- module Xanthous.Monad ( AppT(..) , AppM , runAppT , continue , halt + -- * Messages , say , say_ + , message + , message_ ) where - -import Xanthous.Prelude -import Control.Monad.Random -import Control.Monad.State +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Control.Monad.Random +import Control.Monad.State import qualified Brick -import Brick (EventM, Next) -import Data.Aeson - -import Xanthous.Game.State -import Xanthous.Messages (message) +import Brick (EventM, Next) +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import Xanthous.Messages (Message) +import qualified Xanthous.Messages as Messages +-------------------------------------------------------------------------------- runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState) runAppT appt initialState = flip runStateT initialState . unAppT $ appt @@ -27,12 +33,23 @@ halt = lift . Brick.halt =<< get continue :: AppT (EventM n) (Next GameState) continue = lift . Brick.continue =<< get +-------------------------------------------------------------------------------- say :: (MonadRandom m, ToJSON params, MonadState GameState m) => [Text] -> params -> m () say msgPath params = do - msg <- message msgPath params + msg <- Messages.message msgPath params messageHistory %= pushMessage msg say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m () say_ msgPath = say msgPath $ object [] + +message :: (MonadRandom m, ToJSON params, MonadState GameState m) + => Message -> params -> m () +message msg params = do + m <- Messages.render msg params + messageHistory %= pushMessage m + +message_ :: (MonadRandom m, MonadState GameState m) + => Message -> m () +message_ msg = message msg $ object [] diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs index d90cf5b03d3d..3a7c10ace18e 100644 --- a/src/Xanthous/Util.hs +++ b/src/Xanthous/Util.hs @@ -24,6 +24,7 @@ module Xanthous.Util , uniq -- ** Bag sequence algorithms , takeWhileInclusive + , smallestNotIn ) where import Xanthous.Prelude hiding (foldr) @@ -194,3 +195,12 @@ uniq = uniqOf folded takeWhileInclusive :: (a -> Bool) -> [a] -> [a] takeWhileInclusive _ [] = [] takeWhileInclusive p (x:xs) = x : if p x then takeWhileInclusive p xs else [] + +-- | Returns the smallest value not in a list +smallestNotIn :: (Ord a, Bounded a, Enum a) => [a] -> a +smallestNotIn xs = case uniq $ sort xs of + [] -> minBound + xs'@(x : _) + | x > minBound -> minBound + | otherwise + -> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..] diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 8f761ba6e76d..1d8e066ed7a6 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -1,5 +1,9 @@ welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? -dead: You have died... Press Enter to continue. +dead: + - You have died... + - You die... + - You perish... + - You have perished... entities: description: You see here {{entityDescriptions}} @@ -18,10 +22,10 @@ character: namePrompt: "What's your name? " combat: - nothingToAttack: There's nothing to attack there + nothingToAttack: There's nothing to attack there. hit: - - You hit the {{creature.creatureType.name}} - - You attack the {{creature.creatureType.name}} + - You hit the {{creature.creatureType.name}}. + - You attack the {{creature.creatureType.name}}. creatureAttack: - The {{creature.creatureType.name}} hits you! - The {{creature.creatureType.name}} attacks you! @@ -31,3 +35,12 @@ combat: debug: toggleRevealAll: revealAll now set to {{revealAll}} + +eat: + noFood: + - You have nothing edible. + - You don't have any food. + - You don't have anything to eat. + - You search your pockets for something edible, and come up short. + menuPrompt: What would you like to eat? + eat: You eat the {{item.itemType.name}}. |