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.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

View file

@ -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

View file

@ -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

View file

@ -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."

View file

@ -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

View file

@ -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 ,.