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:
parent
5b1c7799a7
commit
6622dd3018
6 changed files with 77 additions and 27 deletions
|
@ -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,12 +453,16 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem
|
|||
entityMenuItem wentity
|
||||
= let entity = extract wentity
|
||||
in (entityMenuChar entity, MenuOption (description entity) wentity)
|
||||
|
||||
|
||||
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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -25,6 +25,7 @@ module Xanthous.Util
|
|||
-- ** Bag sequence algorithms
|
||||
, takeWhileInclusive
|
||||
, smallestNotIn
|
||||
, removeVectorIndex
|
||||
|
||||
-- * Type-level programming utils
|
||||
, KnownBool(..)
|
||||
|
@ -36,6 +37,7 @@ 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
|
||||
|
|
|
@ -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 ,.
|
||||
|
|
Loading…
Reference in a new issue