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.
This commit is contained in:
Griffin Smith 2019-11-30 22:43:17 -05:00
parent 71b628c604
commit 65b1352ef2
8 changed files with 79 additions and 39 deletions

View file

@ -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

View file

@ -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

View file

@ -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 {..}

View file

@ -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)

View file

@ -46,6 +46,7 @@ initialStateFromSeed seed =
_messageHistory = mempty
_revealedPositions = mempty
_promptState = NoPrompt
_activePanel = Nothing
_debugState = DebugState
{ _allRevealed = False
}

View file

@ -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

View file

@ -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

View file

@ -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 ,.