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.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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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."
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ,.
|
||||||
|
|
Loading…
Reference in a new issue