diff options
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/App.hs')
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/App.hs | 70 |
1 files changed, 55 insertions, 15 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs index 6ed545e3aa4f..f43b7e58fc91 100644 --- a/users/grfn/xanthous/src/Xanthous/App.hs +++ b/users/grfn/xanthous/src/Xanthous/App.hs @@ -1,6 +1,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} module Xanthous.App ( makeApp , RunType(..) @@ -19,6 +20,7 @@ import qualified Data.Vector as V import System.Exit import System.Directory (doesFileExist) import Data.List.NonEmpty (NonEmpty(..)) +import Data.Vector.Lens (toVectorOf) -------------------------------------------------------------------------------- import Xanthous.App.Common import Xanthous.App.Time @@ -151,7 +153,7 @@ handleCommand PickUp = do stepGameBy 100 -- TODO handleCommand Drop = do - selectItemFromInventory_ ["drop", "menu"] Cancellable id + takeItemFromInventory_ ["drop", "menu"] Cancellable id (say_ ["drop", "nothing"]) $ \(MenuResult item) -> do entitiesAtCharacter %= (SomeEntity item <|) @@ -271,8 +273,16 @@ handleCommand Read = do handleCommand ShowInventory = showPanel InventoryPanel >> continue +handleCommand DescribeInventory = do + selectItemFromInventory_ ["inventory", "describe", "select"] Cancellable id + (say_ ["inventory", "describe", "nothing"]) + $ \(MenuResult item) -> + showPanel . ItemDescriptionPanel $ Item.fullDescription item + continue + + handleCommand Wield = do - selectItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem + takeItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem (say_ ["wield", "nothing"]) $ \(MenuResult item) -> do prevItems <- character . inventory . wielded <<.= inRightHand item @@ -403,8 +413,8 @@ entityMenuChar entity then ec else 'a' --- | Prompt with an item to select out of the inventory, remove it from the --- inventory, and call callback with it +-- | Prompt with an item to select out of the inventory and call callback with +-- it selectItemFromInventory :: forall item params. (ToJSON params) @@ -417,23 +427,21 @@ selectItemFromInventory -> AppM () -- ^ Action to take if there are no items matching -> (PromptResult ('Menu item) -> AppM ()) -> AppM () -selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb = - uses (character . inventory . backpack) - (V.mapMaybe $ preview extraInfo) +selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb = do + uses (character . inventory) + (V.mapMaybe (preview extraInfo) . toVectorOf items) >>= \case Empty -> onEmpty - items' -> - menu msgPath msgParams cancellable (itemMenu items') - $ \(MenuResult (idx, item)) -> do - character . inventory . backpack %= removeVectorIndex idx - cb $ MenuResult item + items' -> menu msgPath msgParams cancellable (itemMenu items') cb where - itemMenu = mkMenuItems . imap itemMenuItem - itemMenuItem idx extraInfoItem = + itemMenu = mkMenuItems . map itemMenuItem + itemMenuItem extraInfoItem = let item = extraInfo # extraInfoItem in ( entityMenuChar item - , MenuOption (description item) (idx, extraInfoItem)) + , MenuOption (description item) extraInfoItem) +-- | Prompt with an item to select out of the inventory and call callback with +-- it selectItemFromInventory_ :: forall item. [Text] -- ^ Menu message @@ -446,6 +454,38 @@ selectItemFromInventory_ -> AppM () selectItemFromInventory_ msgPath = selectItemFromInventory msgPath () +-- | Prompt with an item to select out of the inventory, remove it from the +-- inventory, and call callback with it +takeItemFromInventory + :: forall item params. + (ToJSON params) + => [Text] -- ^ Menu message + -> params -- ^ Menu message params + -> PromptCancellable -- ^ Is the menu cancellable? + -> Prism' Item item -- ^ Attach some extra information to the item, in a + -- recoverable fashion. Prism vs iso so we can discard + -- items. + -> AppM () -- ^ Action to take if there are no items matching + -> (PromptResult ('Menu item) -> AppM ()) + -> AppM () +takeItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb = + selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty + $ \(MenuResult item) -> do + character . inventory . backpack %= filter (/= (item ^. re extraInfo)) + cb $ MenuResult item + +takeItemFromInventory_ + :: forall item. + [Text] -- ^ Menu message + -> PromptCancellable -- ^ Is the menu cancellable? + -> Prism' Item item -- ^ Attach some extra information to the item, in a + -- recoverable fashion. Prism vs iso so we can discard + -- items. + -> AppM () -- ^ Action to take if there are no items matching + -> (PromptResult ('Menu item) -> AppM ()) + -> AppM () +takeItemFromInventory_ msgPath = takeItemFromInventory msgPath () + -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity |