From 6622dd301860765ed16f29f74c9d1348d3aa0d41 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 22 Dec 2019 23:22:25 -0500 Subject: 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 | 42 ++++++++++++++++++++++++++++++-------- src/Xanthous/Command.hs | 3 +++ src/Xanthous/Entities/Character.hs | 8 ++++++++ src/Xanthous/Game/Draw.hs | 21 ++++++++----------- src/Xanthous/Util.hs | 18 +++++++++++----- src/Xanthous/messages.yaml | 12 +++++++++++ 6 files changed, 77 insertions(+), 27 deletions(-) (limited to 'src/Xanthous') 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 ,. -- cgit 1.4.1