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.
This commit is contained in:
Griffin Smith 2019-12-22 23:22:25 -05:00
parent 5b1c7799a7
commit 6622dd3018
6 changed files with 77 additions and 27 deletions

View file

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

View file

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

View file

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

View file

@ -112,19 +112,14 @@ drawPanel game panel
drawWielded :: Wielded -> Widget Name drawWielded :: Wielded -> Widget Name
drawWielded (Hands Nothing Nothing) = emptyWidget drawWielded (Hands Nothing Nothing) = emptyWidget
drawWielded (DoubleHanded i) = 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 :: Vector Item -> Widget Name
drawBackpack Empty = txtWrap "Your backpack is empty right now." drawBackpack Empty = txtWrap "Your backpack is empty right now."

View file

@ -25,6 +25,7 @@ module Xanthous.Util
-- ** Bag sequence algorithms -- ** Bag sequence algorithms
, takeWhileInclusive , takeWhileInclusive
, smallestNotIn , smallestNotIn
, removeVectorIndex
-- * Type-level programming utils -- * Type-level programming utils
, KnownBool(..) , KnownBool(..)
@ -36,6 +37,7 @@ import Test.QuickCheck.Checkers
import Data.Foldable (foldr) import Data.Foldable (foldr)
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import qualified Data.Vector as V
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
newtype EqEqProp a = EqEqProp a newtype EqEqProp a = EqEqProp a
@ -210,6 +212,12 @@ smallestNotIn xs = case uniq $ sort xs of
| otherwise | otherwise
-> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..] -> 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 -- | This class gives a boolean associated with a type-level bool, a'la

View file

@ -67,5 +67,17 @@ read:
nothing: "There's nothing there to read" nothing: "There's nothing there to read"
result: "\"{{message}}\"" 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: 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 ,. 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 ,.