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.

4 files changed, 43 insertions, 22 deletions

diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs
index 090eba634d4b..f4c83e005146 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 ab0e31f8a04a..7947c6efe917 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 13f4b89314f7..1f72e08b7b25 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 5ddb7de7e9b8..3b401d366d10 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