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.

6 files changed, 77 insertions, 27 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index c7d9e3935e0a..77fbf36850ab 100644
--- a/src/Xanthous/App.hs
+++ b/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 ->
-              let (before, after) = V.splitAt idx inv
-              in before <> fromMaybe Empty (tailMay after)
+            character . inventory . backpack %= removeVectorIndex idx
             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,11 +453,15 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem
     entityMenuItem wentity
       = let entity = extract wentity
       in (entityMenuChar entity, MenuOption (description entity) wentity)
-    entityMenuChar entity
-      = let ec = entityChar entity ^. char
-        in if ec `elem` (['a'..'z'] ++ ['A'..'Z'])
-           then ec
-           else 'a'
+
+
+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
diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs
index 7b689c6466e4..3547bdf09ab0 100644
--- a/src/Xanthous/Command.hs
+++ b/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
diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs
index 5ddf33c29434..8a3e7c452082 100644
--- a/src/Xanthous/Entities/Character.hs
+++ b/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
diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs
index 09015d06884f..d98b48c02742 100644
--- a/src/Xanthous/Game/Draw.hs
+++ b/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"
-    drawWielded (Hands l r) =
-      maybe
-        emptyWidget
-        (\i ->
-           txt $ "You are holding " <> description i <> " in your left hand")
-        l
-      <=>
-      maybe
-        emptyWidget
-        (\i ->
-           txt $ "You are holding " <> description i <> " in your right hand")
-        r
+      txtWrap $ "You are holding " <> description i <> " in both hands"
+    drawWielded (Hands l r) = drawHand "left" l <=> drawHand "right" r
+    drawHand side = maybe emptyWidget $ \i ->
+      txtWrap ( "You are holding "
+              <> description i
+              <> " in your " <> side <> " hand"
+              )
+      <=> txt " "
 
     drawBackpack :: Vector Item -> Widget Name
     drawBackpack Empty = txtWrap "Your backpack is empty right now."
diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs
index 814f9371150f..b8b789e1b1ea 100644
--- a/src/Xanthous/Util.hs
+++ b/src/Xanthous/Util.hs
@@ -25,17 +25,19 @@ module Xanthous.Util
     -- ** Bag sequence algorithms
   , takeWhileInclusive
   , smallestNotIn
+  , removeVectorIndex
 
     -- * Type-level programming utils
   , KnownBool(..)
   ) where
 --------------------------------------------------------------------------------
-import Xanthous.Prelude hiding (foldr)
+import           Xanthous.Prelude hiding (foldr)
 --------------------------------------------------------------------------------
-import Test.QuickCheck.Checkers
-import Data.Foldable (foldr)
-import Data.Monoid
-import Data.Proxy
+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
diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml
index 0d8ada8c57f9..3967a0cba067 100644
--- a/src/Xanthous/messages.yaml
+++ b/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 ,.