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:
		
							parent
							
								
									71b628c604
								
							
						
					
					
						commit
						65b1352ef2
					
				
					 8 changed files with 79 additions and 39 deletions
				
			
		|  | @ -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 | ||||
|  |  | |||
|  | @ -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 | ||||
| 
 | ||||
|  |  | |||
|  | @ -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 {..} | ||||
| 
 | ||||
|  |  | |||
|  | @ -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) | ||||
|  |  | |||
|  | @ -46,6 +46,7 @@ initialStateFromSeed seed = | |||
|       _messageHistory = mempty | ||||
|       _revealedPositions = mempty | ||||
|       _promptState = NoPrompt | ||||
|       _activePanel = Nothing | ||||
|       _debugState = DebugState | ||||
|         { _allRevealed = False | ||||
|         } | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
|  | @ -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 ,. | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue