diff options
| -rw-r--r-- | src/Xanthous/App.hs | 42 | ||||
| -rw-r--r-- | src/Xanthous/Command.hs | 3 | ||||
| -rw-r--r-- | src/Xanthous/Entities/Character.hs | 8 | ||||
| -rw-r--r-- | src/Xanthous/Game/Draw.hs | 21 | ||||
| -rw-r--r-- | src/Xanthous/Util.hs | 18 | ||||
| -rw-r--r-- | src/Xanthous/messages.yaml | 12 |
6 files changed, 77 insertions, 27 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index c7d9e3935e..77fbf36850 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 7b689c6466..3547bdf09a 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 5ddf33c294..8a3e7c4520 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 09015d0688..d98b48c027 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 814f937115..b8b789e1b1 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 0d8ada8c57..3967a0cba0 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 ,. |