about summary refs log tree commit diff
path: root/src/Xanthous
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xanthous')
-rw-r--r--src/Xanthous/App.hs42
-rw-r--r--src/Xanthous/Command.hs3
-rw-r--r--src/Xanthous/Entities/Character.hs8
-rw-r--r--src/Xanthous/Game/Draw.hs21
-rw-r--r--src/Xanthous/Util.hs18
-rw-r--r--src/Xanthous/messages.yaml12
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 ,.