From 65b1352ef2e463393d0504c32b73bdcf7c99491a Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 30 Nov 2019 22:43:17 -0500 Subject: Add a very basic inventory panel Add a very basic inventory panel to the game opened by pressing `i`, which displays the contents of the player's inventory in a basic list. --- src/Xanthous/App.hs | 11 +++++++++-- src/Xanthous/Command.hs | 2 ++ src/Xanthous/Game/Arbitrary.hs | 1 + src/Xanthous/Game/Draw.hs | 44 ++++++++++++++++++++++++++++++++---------- src/Xanthous/Game/Lenses.hs | 1 + src/Xanthous/Game/State.hs | 19 +++++++----------- src/Xanthous/Resource.hs | 35 +++++++++++++++++++-------------- src/Xanthous/messages.yaml | 5 ++++- 8 files changed, 79 insertions(+), 39 deletions(-) (limited to 'src/Xanthous') diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index df76eadc3b..9d606bbef3 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -34,7 +34,7 @@ import Xanthous.Game.State import Xanthous.Game.Draw (drawGame) import Xanthous.Game.Prompt import Xanthous.Monad -import Xanthous.Resource (Name) +import Xanthous.Resource (Name, Panel(..)) import qualified Xanthous.Messages as Messages import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- @@ -231,6 +231,8 @@ handleCommand Read = do in readAndContinue msgs continue +handleCommand Inventory = showPanel InventoryPanel >> continue + handleCommand Save = do -- TODO default save locations / config file? prompt_ @'StringPrompt ["save", "location"] Cancellable @@ -439,4 +441,9 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity --------------------------------------------------------------------------------- +showPanel :: Panel -> AppM () +showPanel panel = do + activePanel ?= panel + prompt_ @'Continue ["generic", "continue"] Uncancellable + . const + $ activePanel .= Nothing diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 61fb11b22e..a14a4d0713 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -20,6 +20,7 @@ data Command | Look | Save | Read + | Inventory -- | TODO replace with `:` commands | ToggleRevealAll @@ -35,6 +36,7 @@ commandFromKey (KChar ';') [] = Just Look commandFromKey (KChar 'e') [] = Just Eat commandFromKey (KChar 'S') [] = Just Save commandFromKey (KChar 'r') [] = Just Read +commandFromKey (KChar 'i') [] = Just Inventory commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index 090eba634d..f4c83e0051 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -26,6 +26,7 @@ instance Arbitrary GameState where _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities _randomGen <- mkStdGen <$> arbitrary let _promptState = NoPrompt -- TODO + _activePanel <- arbitrary _debugState <- arbitrary pure $ GameState {..} diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index ab0e31f8a0..7947c6efe9 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -27,7 +27,7 @@ import Xanthous.Game , debugState, allRevealed ) import Xanthous.Game.Prompt -import Xanthous.Resource (Name) +import Xanthous.Resource (Name, Panel(..)) import qualified Xanthous.Resource as Resource import Xanthous.Orphans () -------------------------------------------------------------------------------- @@ -41,23 +41,23 @@ cursorPosition game = showCursor Resource.Character (game ^. characterPosition . loc) drawMessages :: MessageHistory -> Widget Name -drawMessages = txt . (<> " ") . unwords . oextract +drawMessages = txtWrap . (<> " ") . unwords . oextract drawPromptState :: GamePromptState m -> Widget Name drawPromptState NoPrompt = emptyWidget 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 + txtWrap msg <+> renderEditor (txtWrap . fold) True edit + (SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg + (SContinue, _, _) -> txtWrap msg (SMenu, _, menuItems) -> - txt msg + txtWrap msg <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems) - _ -> txt msg + _ -> txtWrap msg where drawMenuItem (chr, MenuOption m _) = - str ("[" <> pure chr <> "] ") <+> txt m + str ("[" <> pure chr <> "] ") <+> txtWrap m drawEntities :: (Position -> Bool) @@ -95,11 +95,32 @@ drawMap game -- character can't see them (game ^. entities) +bullet :: Char +bullet = '•' + +drawPanel :: GameState -> Panel -> Widget Name +drawPanel game panel + = border + . hLimit 35 + . viewport (Resource.Panel panel) Vertical + $ case panel of + InventoryPanel -> + let items = game ^. character . inventory + in if null items + then txtWrap "Your inventory is empty right now." + else + txtWrap "You are currently carrying the following items:" + <=> txt " " + <=> foldl' (<=>) emptyWidget + (map + (txtWrap . ((bullet <| " ") <>) . description) + items) + drawCharacterInfo :: Character -> Widget Name drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints where charName | Just n <- ch ^. characterName - = txt n <+> txt " " + = txt $ n <> " " | otherwise = emptyWidget charHitpoints @@ -114,5 +135,8 @@ drawGame game NoPrompt -> drawMessages (game ^. messageHistory) _ -> emptyWidget <=> drawPromptState (game ^. promptState) - <=> border (drawMap game) + <=> + (maybe emptyWidget (drawPanel game) (game ^. activePanel) + <+> border (drawMap game) + ) <=> drawCharacterInfo (game ^. character) diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 13f4b89314..1f72e08b7b 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -46,6 +46,7 @@ initialStateFromSeed seed = _messageHistory = mempty _revealedPositions = mempty _promptState = NoPrompt + _activePanel = Nothing _debugState = DebugState { _allRevealed = False } diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 5ddb7de7e9..3b401d366d 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -10,6 +10,7 @@ module Xanthous.Game.State , revealedPositions , messageHistory , randomGen + , activePanel , promptState , characterEntityID , GamePromptState(..) @@ -383,6 +384,7 @@ instance -------------------------------------------------------------------------------- + data DebugState = DebugState { _allRevealed :: !Bool } @@ -402,8 +404,12 @@ data GameState = GameState , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory , _randomGen :: !StdGen + + -- | The active panel displayed in the UI, if any + , _activePanel :: !(Maybe Panel) + , _promptState :: !(GamePromptState AppM) - , _debugState :: DebugState + , _debugState :: !DebugState } deriving stock (Show, Generic) deriving anyclass (NFData) @@ -437,14 +443,3 @@ instance (MonadIO m) => MonadIO (AppT m) where -------------------------------------------------------------------------------- makeLenses ''DebugState - --------------------------------------------------------------------------------- - --- saveGame :: GameState -> LByteString --- saveGame = Zlib.compress . JSON.encode - --- loadGame :: LByteString -> Maybe GameState --- loadGame = JSON.decode . Zlib.decompress - --- saved :: Prism' LByteString GameState --- saved = prism' saveGame loadGame diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs index 5350e7646e..cc2fc97a14 100644 --- a/src/Xanthous/Resource.hs +++ b/src/Xanthous/Resource.hs @@ -1,24 +1,31 @@ -------------------------------------------------------------------------------- module Xanthous.Resource - ( Name(..) + ( Panel(..) + , Name(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic +import Data.Aeson (ToJSON, FromJSON) +-------------------------------------------------------------------------------- +import Xanthous.Util.QuickCheck -------------------------------------------------------------------------------- -data Name = MapViewport - -- ^ The main viewport where we display the game content - | Character - -- ^ The character - | MessageBox - -- ^ The box where we display messages to the user - | Prompt - -- ^ The game's prompt - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) +-- | Enum for "panels" displayed in the game's UI. +data Panel + = InventoryPanel -- ^ A panel displaying the character's inventory + deriving stock (Show, Eq, Ord, Generic, Enum, Bounded) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary Panel -instance Arbitrary Name where - arbitrary = genericArbitrary + +data Name + = MapViewport -- ^ The main viewport where we display the game content + | Character -- ^ The character + | MessageBox -- ^ The box where we display messages to the user + | Prompt -- ^ The game's prompt + | Panel Panel -- ^ A panel in the game + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary Name diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 1c5692ddfe..40a37cf59b 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -5,6 +5,9 @@ dead: - You perish... - You have perished... +generic: + continue: Press enter to continue... + save: location: "Enter filename to save to: " @@ -61,4 +64,4 @@ read: result: "\"{{message}}\"" tutorial: - message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance, and pick it up with , + message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance! You can pick items up with ,. -- cgit 1.4.1