Add a wield command

Add a Wield command, which prompts for a wieldable item, if any, to take
out of the character's inventory and put in their right hand.

Eventually we should support other hands, but for now hardcoding the
right hand should be fine.

src/Xanthous/App.hs

@@ -36,6 +36,7 @@ import           Xanthous.Game.Prompt
 import           Xanthous.Monad
 import           Xanthous.Resource (Name, Panel(..))
 import qualified Xanthous.Messages as Messages
+import           Xanthous.Util (removeVectorIndex)
 import           Xanthous.Util.Inflection (toSentence)
 --------------------------------------------------------------------------------
 import qualified Xanthous.Entities.Character as Character
@@ -46,7 +47,10 @@ import           Xanthous.Entities.Creature (Creature)
 import qualified Xanthous.Entities.Creature as Creature
 import           Xanthous.Entities.Environment
                  (Door, open, locked, GroundMessage(..))
-import           Xanthous.Entities.RawTypes (edible, eatMessage, hitpointsHealed)
+import           Xanthous.Entities.RawTypes
+                 ( edible, eatMessage, hitpointsHealed
+                 , wieldable
+                 )
 import           Xanthous.Generators
 import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
 --------------------------------------------------------------------------------
@@ -197,9 +201,7 @@ handleCommand Eat = do
             menuItems = mkMenuItems $ imap foodMenuItem food
         in menu_ ["eat", "menuPrompt"] Cancellable menuItems
           $ \(MenuResult (idx, item, edibleItem)) -> do
-            character . inventory . backpack %= \inv ->
+            character . inventory . backpack %= removeVectorIndex idx
-              let (before, after) = V.splitAt idx inv
-              in before <> fromMaybe Empty (tailMay after)
             let msg = fromMaybe (Messages.lookup ["eat", "eat"])
                       $ edibleItem ^. eatMessage
             character . characterHitpoints' +=
@@ -233,6 +235,24 @@ handleCommand Read = do
 
 handleCommand ShowInventory = showPanel InventoryPanel >> continue
 
+handleCommand Wield = do
+  uses (character . inventory . backpack)
+       (V.mapMaybe (\item ->
+                      (WieldedItem item) <$> item ^. Item.itemType . wieldable))
+    >>= \case
+      Empty -> say_ ["wield", "nothing"]
+      wieldables ->
+        menu_ ["wield", "menu"] Cancellable (wieldableMenu wieldables)
+        $ \(MenuResult (idx, item)) -> do
+          character . inventory . backpack %= removeVectorIndex idx
+          character . inventory . wielded .= inRightHand item
+          say ["wield", "wielded"] item
+  continue
+  where
+    wieldableMenu = mkMenuItems . imap wieldableMenuItem
+    wieldableMenuItem idx wi@(WieldedItem item _) =
+      (entityMenuChar item, MenuOption (description item) (idx, wi))
+
 handleCommand Save = do
   -- TODO default save locations / config file?
   prompt_ @'StringPrompt ["save", "location"] Cancellable
@@ -433,12 +453,16 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem
     entityMenuItem wentity
       = let entity = extract wentity
       in (entityMenuChar entity, MenuOption (description entity) wentity)
+
+
+entityMenuChar :: Entity a => a -> Char
 entityMenuChar entity
   = let ec = entityChar entity ^. char
     in if ec `elem` (['a'..'z'] ++ ['A'..'Z'])
         then ec
         else 'a'
 
+
 -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity)
 -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity
 

src/Xanthous/Command.hs

@@ -21,6 +21,7 @@ data Command
   | Save
   | Read
   | ShowInventory
+  | Wield
 
     -- | TODO replace with `:` commands
   | ToggleRevealAll
@@ -37,7 +38,9 @@ commandFromKey (KChar 'e') [] = Just Eat
 commandFromKey (KChar 'S') [] = Just Save
 commandFromKey (KChar 'r') [] = Just Read
 commandFromKey (KChar 'i') [] = Just ShowInventory
+commandFromKey (KChar 'w') [] = Just Wield
 
+-- DEBUG COMMANDS --
 commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll
 
 commandFromKey _ _ = Nothing

src/Xanthous/Entities/Character.hs

@@ -20,6 +20,8 @@ module Xanthous.Entities.Character
   , hands
   , leftHand
   , rightHand
+  , inLeftHand
+  , inRightHand
   , doubleHanded
   , wieldedItems
   , WieldedItem(..)
@@ -100,9 +102,15 @@ hands = prism' (uncurry Hands) $ \case
 leftHand :: Traversal' Wielded WieldedItem
 leftHand = hands . _1 . _Just
 
+inLeftHand :: WieldedItem -> Wielded
+inLeftHand wi = Hands (Just wi) Nothing
+
 rightHand :: Traversal' Wielded WieldedItem
 rightHand = hands . _2 . _Just
 
+inRightHand :: WieldedItem -> Wielded
+inRightHand wi = Hands Nothing (Just wi)
+
 doubleHanded :: Prism' Wielded WieldedItem
 doubleHanded = prism' DoubleHanded $ \case
   DoubleHanded i -> Just i

src/Xanthous/Game/Draw.hs

@@ -112,19 +112,14 @@ drawPanel game panel
     drawWielded :: Wielded -> Widget Name
     drawWielded (Hands Nothing Nothing) = emptyWidget
     drawWielded (DoubleHanded i) =
-      txt $ "You are holding " <> description i <> " in both hands"
+      txtWrap $ "You are holding " <> description i <> " in both hands"
-    drawWielded (Hands l r) =
+    drawWielded (Hands l r) = drawHand "left" l <=> drawHand "right" r
-      maybe
+    drawHand side = maybe emptyWidget $ \i ->
-        emptyWidget
+      txtWrap ( "You are holding "
-        (\i ->
+              <> description i
-           txt $ "You are holding " <> description i <> " in your left hand")
+              <> " in your " <> side <> " hand"
-        l
+              )
-      <=>
+      <=> txt " "
-      maybe
-        emptyWidget
-        (\i ->
-           txt $ "You are holding " <> description i <> " in your right hand")
-        r
 
     drawBackpack :: Vector Item -> Widget Name
     drawBackpack Empty = txtWrap "Your backpack is empty right now."

src/Xanthous/Util.hs

@@ -25,6 +25,7 @@ module Xanthous.Util
     -- ** Bag sequence algorithms
   , takeWhileInclusive
   , smallestNotIn
+  , removeVectorIndex
 
     -- * Type-level programming utils
   , KnownBool(..)
@@ -36,6 +37,7 @@ import Test.QuickCheck.Checkers
 import           Data.Foldable (foldr)
 import           Data.Monoid
 import           Data.Proxy
+import qualified Data.Vector as V
 --------------------------------------------------------------------------------
 
 newtype EqEqProp a = EqEqProp a
@@ -210,6 +212,12 @@ smallestNotIn xs = case uniq $ sort xs of
     | otherwise
     -> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..]
 
+-- | Remove the element at the given index, if any, from the given vector
+removeVectorIndex :: Int -> Vector a -> Vector a
+removeVectorIndex idx vect =
+  let (before, after) = V.splitAt idx vect
+  in before <> fromMaybe Empty (tailMay after)
+
 --------------------------------------------------------------------------------
 
 -- | This class gives a boolean associated with a type-level bool, a'la

src/Xanthous/messages.yaml

@@ -67,5 +67,17 @@ read:
   nothing: "There's nothing there to read"
   result: "\"{{message}}\""
 
+wield:
+  nothing:
+    - You aren't carrying anything you can wield
+    - You can't wield anything in your backpack
+    - You can't wield anything currently in your backpack
+  menu: What would you like to wield?
+  # TODO: use actual hands
+  wielded : You wield the {{wieldedItem.itemType.name}} in your right hand.
+
+
+###
+
 tutorial:
   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 ,.