-- | UI of inventory management.
module Game.LambdaHack.Client.UI.InventoryM
  ( Suitability(..), ResultItemDialogMode(..)
  , slotsOfItemDialogMode, getFull, getGroupItem, getStoreItem
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , ItemDialogState(..), accessModeBag, storeItemPrompt, getItem
  , DefItemKey(..), transition, keyOfEKM, runDefItemKey
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Char as Char
import           Data.Either
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.Frame
import           Game.LambdaHack.Client.UI.HandleHelperM
import           Game.LambdaHack.Client.UI.HumanCmd
import           Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.MonadClientUI
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.MsgM
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.Slideshow
import           Game.LambdaHack.Client.UI.SlideshowM
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

data ItemDialogState = ISuitable | IAll
  deriving (Int -> ItemDialogState -> ShowS
[ItemDialogState] -> ShowS
ItemDialogState -> String
(Int -> ItemDialogState -> ShowS)
-> (ItemDialogState -> String)
-> ([ItemDialogState] -> ShowS)
-> Show ItemDialogState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemDialogState] -> ShowS
$cshowList :: [ItemDialogState] -> ShowS
show :: ItemDialogState -> String
$cshow :: ItemDialogState -> String
showsPrec :: Int -> ItemDialogState -> ShowS
$cshowsPrec :: Int -> ItemDialogState -> ShowS
Show, ItemDialogState -> ItemDialogState -> Bool
(ItemDialogState -> ItemDialogState -> Bool)
-> (ItemDialogState -> ItemDialogState -> Bool)
-> Eq ItemDialogState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemDialogState -> ItemDialogState -> Bool
$c/= :: ItemDialogState -> ItemDialogState -> Bool
== :: ItemDialogState -> ItemDialogState -> Bool
$c== :: ItemDialogState -> ItemDialogState -> Bool
Eq)

data ResultItemDialogMode =
    RStore CStore [ItemId]
  | ROrgans ItemId ItemBag SingleItemSlots
  | ROwned ItemId
  | RSkills Int
  | RLore SLore ItemId ItemBag SingleItemSlots
  | RPlaces Int
  | RModes Int
  deriving Int -> ResultItemDialogMode -> ShowS
[ResultItemDialogMode] -> ShowS
ResultItemDialogMode -> String
(Int -> ResultItemDialogMode -> ShowS)
-> (ResultItemDialogMode -> String)
-> ([ResultItemDialogMode] -> ShowS)
-> Show ResultItemDialogMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultItemDialogMode] -> ShowS
$cshowList :: [ResultItemDialogMode] -> ShowS
show :: ResultItemDialogMode -> String
$cshow :: ResultItemDialogMode -> String
showsPrec :: Int -> ResultItemDialogMode -> ShowS
$cshowsPrec :: Int -> ResultItemDialogMode -> ShowS
Show

accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag leader :: ActorId
leader s :: State
s (MStore cstore :: CStore
cstore) = let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
leader State
s
                                         in Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cstore State
s
accessModeBag leader :: ActorId
leader s :: State
s MOrgans = let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
leader State
s
                                 in Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
COrgan State
s
accessModeBag leader :: ActorId
leader s :: State
s MOwned = let fid :: FactionId
fid = Actor -> FactionId
bfid (Actor -> FactionId) -> Actor -> FactionId
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader State
s
                                in FactionId -> State -> ItemBag
combinedItems FactionId
fid State
s
accessModeBag _ _ MSkills = ItemBag
forall k a. EnumMap k a
EM.empty
accessModeBag _ s :: State
s MLore{} = (Item -> ItemQuant) -> EnumMap ItemId Item -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (ItemQuant -> Item -> ItemQuant
forall a b. a -> b -> a
const ItemQuant
quantSingle) (EnumMap ItemId Item -> ItemBag) -> EnumMap ItemId Item -> ItemBag
forall a b. (a -> b) -> a -> b
$ State -> EnumMap ItemId Item
sitemD State
s
accessModeBag _ _ MPlaces = ItemBag
forall k a. EnumMap k a
EM.empty
accessModeBag _ _ MModes = ItemBag
forall k a. EnumMap k a
EM.empty

-- This is the only place slots are sorted. As a side-effect,
-- slots in inventories always agree with slots of item lore.
-- Not so for organ menu, because many lore maps point there.
-- Sorting in @updateItemSlot@ would not be enough, because, e.g.,
-- identifying an item should change its slot position.
slotsOfItemDialogMode :: MonadClientUI m => ItemDialogMode -> m SingleItemSlots
slotsOfItemDialogMode :: ItemDialogMode -> m SingleItemSlots
slotsOfItemDialogMode cCur :: ItemDialogMode
cCur = do
  ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
  ItemSlots itemSlotsPre :: EnumMap SLore SingleItemSlots
itemSlotsPre <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
  case ItemDialogMode
cCur of
    MOrgans -> do
      let newSlots :: EnumMap SLore SingleItemSlots
newSlots = (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF) SLore
SOrgan
                     (EnumMap SLore SingleItemSlots -> EnumMap SLore SingleItemSlots)
-> EnumMap SLore SingleItemSlots -> EnumMap SLore SingleItemSlots
forall a b. (a -> b) -> a -> b
$ (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF) SLore
STrunk
                     (EnumMap SLore SingleItemSlots -> EnumMap SLore SingleItemSlots)
-> EnumMap SLore SingleItemSlots -> EnumMap SLore SingleItemSlots
forall a b. (a -> b) -> a -> b
$ (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF) SLore
SCondition EnumMap SLore SingleItemSlots
itemSlotsPre
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sslots :: ItemSlots
sslots = EnumMap SLore SingleItemSlots -> ItemSlots
ItemSlots EnumMap SLore SingleItemSlots
newSlots}
      SingleItemSlots -> m SingleItemSlots
forall (m :: * -> *) a. Monad m => a -> m a
return (SingleItemSlots -> m SingleItemSlots)
-> SingleItemSlots -> m SingleItemSlots
forall a b. (a -> b) -> a -> b
$! (ItemId -> ItemFull) -> [SingleItemSlots] -> SingleItemSlots
mergeItemSlots ItemId -> ItemFull
itemToF [ EnumMap SLore SingleItemSlots
newSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SOrgan
                                       , EnumMap SLore SingleItemSlots
newSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
                                       , EnumMap SLore SingleItemSlots
newSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SCondition ]
    MSkills -> SingleItemSlots -> m SingleItemSlots
forall (m :: * -> *) a. Monad m => a -> m a
return SingleItemSlots
forall k a. EnumMap k a
EM.empty
    MPlaces -> SingleItemSlots -> m SingleItemSlots
forall (m :: * -> *) a. Monad m => a -> m a
return SingleItemSlots
forall k a. EnumMap k a
EM.empty
    MModes -> SingleItemSlots -> m SingleItemSlots
forall (m :: * -> *) a. Monad m => a -> m a
return SingleItemSlots
forall k a. EnumMap k a
EM.empty
    _ -> do
      let slore :: SLore
slore = ItemDialogMode -> SLore
IA.loreFromMode ItemDialogMode
cCur
          newSlots :: EnumMap SLore SingleItemSlots
newSlots = (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF) SLore
slore EnumMap SLore SingleItemSlots
itemSlotsPre
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sslots :: ItemSlots
sslots = EnumMap SLore SingleItemSlots -> ItemSlots
ItemSlots EnumMap SLore SingleItemSlots
newSlots}
      SingleItemSlots -> m SingleItemSlots
forall (m :: * -> *) a. Monad m => a -> m a
return (SingleItemSlots -> m SingleItemSlots)
-> SingleItemSlots -> m SingleItemSlots
forall a b. (a -> b) -> a -> b
$! EnumMap SLore SingleItemSlots
newSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore

-- | Let a human player choose any item from a given group.
-- Note that this does not guarantee the chosen item belongs to the group,
-- as the player can override the choice.
-- Used e.g., for applying and projecting.
getGroupItem :: (MonadClient m, MonadClientUI m)
             => m Suitability
                          -- ^ which items to consider suitable
             -> Text      -- ^ specific prompt for only suitable items
             -> Text      -- ^ generic prompt
             -> Text      -- ^ the verb to use
             -> Text      -- ^ the generic verb to use
             -> [CStore]  -- ^ stores to cycle through
             -> m (Either Text (CStore, ItemId))
getGroupItem :: m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
getGroupItem psuit :: m Suitability
psuit prompt :: Text
prompt promptGeneric :: Text
promptGeneric verb :: Text
verb verbGeneric :: Text
verbGeneric stores :: [CStore]
stores = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side
  let ppItemDialogBody :: Text -> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody v :: Text
v body :: Actor
body actorSk :: Skills
actorSk cCur :: ItemDialogMode
cCur = case ItemDialogMode
cCur of
        MStore CEqp | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorSk ->
          "distractedly attempt to" Text -> Text -> Text
<+> Text
v Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
        MStore CGround | Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
body, Actor -> Point
bpos Actor
body) ->
          "greedily attempt to" Text -> Text -> Text
<+> Text
v Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
        _ -> Text
v Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
  Either Text (CStore, [(ItemId, ItemQuant)])
soc <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
getFull m Suitability
psuit
                 (\body :: Actor
body _ actorSk :: Skills
actorSk cCur :: ItemDialogMode
cCur _ ->
                    Text
prompt Text -> Text -> Text
<+> Text -> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Text
verb Actor
body Skills
actorSk ItemDialogMode
cCur)
                 (\body :: Actor
body _ actorSk :: Skills
actorSk cCur :: ItemDialogMode
cCur _ ->
                    Text
promptGeneric
                    Text -> Text -> Text
<+> Text -> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Text
verbGeneric Actor
body Skills
actorSk ItemDialogMode
cCur)
                 [CStore]
stores Bool
True Bool
False
  case Either Text (CStore, [(ItemId, ItemQuant)])
soc of
    Left err :: Text
err -> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId)))
-> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (CStore, ItemId)
forall a b. a -> Either a b
Left Text
err
    Right (rstore :: CStore
rstore, [(iid :: ItemId
iid, _)]) -> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId)))
-> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall a b. (a -> b) -> a -> b
$ (CStore, ItemId) -> Either Text (CStore, ItemId)
forall a b. b -> Either a b
Right (CStore
rstore, ItemId
iid)
    Right _ -> String -> m (Either Text (CStore, ItemId))
forall a. HasCallStack => String -> a
error (String -> m (Either Text (CStore, ItemId)))
-> String -> m (Either Text (CStore, ItemId))
forall a b. (a -> b) -> a -> b
$ "" String -> Either Text (CStore, [(ItemId, ItemQuant)]) -> String
forall v. Show v => String -> v -> String
`showFailure` Either Text (CStore, [(ItemId, ItemQuant)])
soc

-- | Display all items from a store and let the human player choose any
-- or switch to any other store.
-- Used, e.g., for viewing inventory and item descriptions.
getStoreItem :: (MonadClient m, MonadClientUI m)
             => ItemDialogMode   -- ^ initial mode
             -> m (Either Text ResultItemDialogMode)
getStoreItem :: ItemDialogMode -> m (Either Text ResultItemDialogMode)
getStoreItem cInitial :: ItemDialogMode
cInitial = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  let itemCs :: [ItemDialogMode]
itemCs = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore
CStash, CStore
CEqp, CStore
CGround]
        -- No @COrgan@, because triggerable organs are rare and,
        -- if really needed, accessible directly from the trigger menu.
      loreCs :: [ItemDialogMode]
loreCs = (SLore -> ItemDialogMode) -> [SLore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map SLore -> ItemDialogMode
MLore [SLore
forall a. Bounded a => a
minBound..SLore
forall a. Bounded a => a
maxBound] [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
MPlaces, ItemDialogMode
MModes]
      allCs :: [ItemDialogMode]
allCs = case ItemDialogMode
cInitial of
        MLore{} -> [ItemDialogMode]
loreCs
        MPlaces -> [ItemDialogMode]
loreCs
        MModes -> [ItemDialogMode]
loreCs
        _ -> [ItemDialogMode]
itemCs [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
MOwned, ItemDialogMode
MOrgans, ItemDialogMode
MSkills]
      (pre :: [ItemDialogMode]
pre, rest :: [ItemDialogMode]
rest) = (ItemDialogMode -> Bool)
-> [ItemDialogMode] -> ([ItemDialogMode], [ItemDialogMode])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== ItemDialogMode
cInitial) [ItemDialogMode]
allCs
      post :: [ItemDialogMode]
post = (ItemDialogMode -> Bool) -> [ItemDialogMode] -> [ItemDialogMode]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== ItemDialogMode
cInitial) [ItemDialogMode]
rest
      remCs :: [ItemDialogMode]
remCs = [ItemDialogMode]
post [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode]
pre
      prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt = FactionId
-> Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
storeItemPrompt FactionId
side
  m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
getItem (Suitability -> m Suitability
forall (m :: * -> *) a. Monad m => a -> m a
return Suitability
SuitsEverything) Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt ItemDialogMode
cInitial [ItemDialogMode]
remCs Bool
True Bool
False

storeItemPrompt :: FactionId
                -> Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
                -> Text
storeItemPrompt :: FactionId
-> Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
storeItemPrompt side :: FactionId
side body :: Actor
body bodyUI :: ActorUI
bodyUI actorCurAndMaxSk :: Skills
actorCurAndMaxSk c2 :: ItemDialogMode
c2 s :: State
s =
  let COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} = State -> COps
scops State
s
      fact :: Faction
fact = State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side
      (tIn :: Text
tIn, t :: Text
t) = ItemDialogMode -> (Text, Text)
ppItemDialogMode ItemDialogMode
c2
      subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bodyUI
      f :: (a, b) -> a -> a
f (k :: a
k, _) acc :: a
acc = a
k a -> a -> a
forall a. Num a => a -> a -> a
+ a
acc
      countItems :: CStore -> Int
countItems store :: CStore
store = (ItemQuant -> Int -> Int) -> Int -> ItemBag -> Int
forall a b k. (a -> b -> b) -> b -> EnumMap k a -> b
EM.foldr' ItemQuant -> Int -> Int
forall a b. Num a => (a, b) -> a -> a
f 0 (ItemBag -> Int) -> ItemBag -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
body CStore
store State
s
  in case ItemDialogMode
c2 of
    MStore CGround ->
      let n :: Int
n = CStore -> Int
countItems CStore
CGround
          nItems :: Part
nItems = Int -> Part -> Part
MU.CarAWs Int
n "item"
          verbGround :: Part
verbGround = if Faction -> Maybe (LevelId, Point)
gstash Faction
fact Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
body, Actor -> Point
bpos Actor
body)
                       then "fondle greedily"
                       else "notice"
      in [Part] -> Text
makePhrase
           [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbGround
           , Part
nItems, "at"
           , Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text "feet" ]
    MStore CEqp ->
      let n :: Int
n = CStore -> Int
countItems CStore
CEqp
          (verbEqp :: Part
verbEqp, nItems :: Part
nItems) =
            if | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> ("find nothing", "")
               | Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorCurAndMaxSk ->
                   ("find", Int -> Part -> Part
MU.CarAWs Int
n "item")
               | Bool
otherwise -> ("paw distractedly at", Int -> Part -> Part
MU.CarAWs Int
n "item")
      in [Part] -> Text
makePhrase
           [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbEqp
           , Part
nItems, Text -> Part
MU.Text Text
tIn
           , Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
    MStore cstore :: CStore
cstore ->
      let n :: Int
n = CStore -> Int
countItems CStore
cstore
          nItems :: Part
nItems = Int -> Part -> Part
MU.CarAWs Int
n "item"
          (verb :: Part
verb, onLevel :: [Part]
onLevel) = case CStore
cstore of
            COrgan -> ("feel", [])
            CStash ->
              ( "notice"
              , case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
                  Just (lid :: LevelId
lid, _) ->
                    (Text -> Part) -> [Text] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Part
MU.Text ["on level", Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ LevelId -> Int
forall a. Enum a => a -> Int
fromEnum LevelId
lid]
                  Nothing -> [] )
            _ -> ("see", [])
          ownObject :: [Part]
ownObject = case CStore
cstore of
            CStash -> ["our", Text -> Part
MU.Text Text
t]
            _ -> [Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t]
      in [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
           [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb
           , Part
nItems, Text -> Part
MU.Text Text
tIn ] [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
ownObject [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
onLevel
    MOrgans ->
      [Part] -> Text
makePhrase
        [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "feel"
        , Text -> Part
MU.Text Text
tIn
        , Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
    MOwned ->
      -- We assume "gold grain", not "grain" with label "of gold":
      let currencyName :: Text
currencyName = ItemKind -> Text
IK.iname (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem
                         (ContentId ItemKind -> ItemKind) -> ContentId ItemKind -> ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> GroupName ItemKind -> ContentId ItemKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData ItemKind
coitem GroupName ItemKind
IK.S_CURRENCY
          dungeonTotal :: Int
dungeonTotal = State -> Int
sgold State
s
          (_, total :: Int
total) = FactionId -> State -> (ItemBag, Int)
calculateTotal FactionId
side State
s
          n :: Int
n = CStore -> Int
countItems CStore
CStash
          verbOwned :: Part
verbOwned = if | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> "find nothing among"
                         | Bool
otherwise -> "review"
      in [Part] -> Text
makePhrase
           [ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> Text
spoilsBlurb Text
currencyName Int
total Int
dungeonTotal
           , Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbOwned
           , Text -> Part
MU.Text Text
t ]
    MSkills ->
      [Part] -> Text
makePhrase
        [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "estimate"
        , Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
    MLore slore :: SLore
slore ->
      [Part] -> Text
makePhrase
        [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
            if SLore
slore SLore -> SLore -> Bool
forall a. Eq a => a -> a -> Bool
== SLore
SEmbed
            then "terrain (including crafting recipes)"
            else Text
t ]
    MPlaces ->
      [Part] -> Text
makePhrase
        [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
    MModes ->
      [Part] -> Text
makePhrase
        [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]

-- | Let the human player choose a single, preferably suitable,
-- item from a list of items. Don't display stores empty for all actors.
-- Start with a non-empty store.
getFull :: (MonadClient m, MonadClientUI m)
        => m Suitability    -- ^ which items to consider suitable
        -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
            -> Text)        -- ^ specific prompt for only suitable items
        -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
            -> Text)        -- ^ generic prompt
        -> [CStore]         -- ^ stores to cycle through
        -> Bool             -- ^ whether to ask, when the only item
                            --   in the starting mode is suitable
        -> Bool             -- ^ whether to permit multiple items as a result
        -> m (Either Text (CStore, [(ItemId, ItemQuant)]))
getFull :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
getFull psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric stores :: [CStore]
stores askWhenLone :: Bool
askWhenLone permitMulitple :: Bool
permitMulitple = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Suitability
mpsuit <- m Suitability
psuit
  let psuitFun :: Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun = case Suitability
mpsuit of
        SuitsEverything -> \_ _ _ -> Bool
True
        SuitsSomething f :: Maybe CStore -> ItemFull -> ItemQuant -> Bool
f -> Maybe CStore -> ItemFull -> ItemQuant -> Bool
f
  -- Move the first store that is non-empty for suitable items for this actor
  -- to the front, if any.
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  CStore -> ItemBag
getCStoreBag <- (State -> CStore -> ItemBag) -> m (CStore -> ItemBag)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> CStore -> ItemBag) -> m (CStore -> ItemBag))
-> (State -> CStore -> ItemBag) -> m (CStore -> ItemBag)
forall a b. (a -> b) -> a -> b
$ \s :: State
s cstore :: CStore
cstore -> Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cstore State
s
  let hasThisActor :: CStore -> Bool
hasThisActor = Bool -> Bool
not (Bool -> Bool) -> (CStore -> Bool) -> CStore -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null (ItemBag -> Bool) -> (CStore -> ItemBag) -> CStore -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStore -> ItemBag
getCStoreBag
  case (CStore -> Bool) -> [CStore] -> [CStore]
forall a. (a -> Bool) -> [a] -> [a]
filter CStore -> Bool
hasThisActor [CStore]
stores of
    [] -> do
      let dialogModes :: [ItemDialogMode]
dialogModes = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore]
stores
          ts :: [Part]
ts = (ItemDialogMode -> Part) -> [ItemDialogMode] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Part
MU.Text (Text -> Part)
-> (ItemDialogMode -> Text) -> ItemDialogMode -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemDialogMode -> Text
ppItemDialogModeIn) [ItemDialogMode]
dialogModes
      Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, [(ItemId, ItemQuant)])
 -> m (Either Text (CStore, [(ItemId, ItemQuant)])))
-> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (CStore, [(ItemId, ItemQuant)])
forall a b. a -> Either a b
Left (Text -> Either Text (CStore, [(ItemId, ItemQuant)]))
-> Text -> Either Text (CStore, [(ItemId, ItemQuant)])
forall a b. (a -> b) -> a -> b
$ "no items" Text -> Text -> Text
<+> [Part] -> Text
makePhrase [Part -> [Part] -> Part
MU.WWxW "nor" [Part]
ts]
    haveThis :: [CStore]
haveThis@(headThisActor :: CStore
headThisActor : _) -> do
      ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
      let suitsThisActor :: CStore -> Bool
suitsThisActor store :: CStore
store =
            let bag :: ItemBag
bag = CStore -> ItemBag
getCStoreBag CStore
store
            in ((ItemId, ItemQuant) -> Bool) -> [(ItemId, ItemQuant)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(iid :: ItemId
iid, kit :: ItemQuant
kit) -> Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
store) (ItemId -> ItemFull
itemToF ItemId
iid) ItemQuant
kit)
                   (ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag)
          firstStore :: CStore
firstStore = CStore -> Maybe CStore -> CStore
forall a. a -> Maybe a -> a
fromMaybe CStore
headThisActor (Maybe CStore -> CStore) -> Maybe CStore -> CStore
forall a b. (a -> b) -> a -> b
$ (CStore -> Bool) -> [CStore] -> Maybe CStore
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CStore -> Bool
suitsThisActor [CStore]
haveThis
          -- Don't display stores totally empty for all actors.
          breakStores :: CStore -> (ItemDialogMode, [ItemDialogMode])
breakStores cInit :: CStore
cInit =
            let (pre :: [CStore]
pre, rest :: [CStore]
rest) = (CStore -> Bool) -> [CStore] -> ([CStore], [CStore])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
cInit) [CStore]
stores
                post :: [CStore]
post = (CStore -> Bool) -> [CStore] -> [CStore]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
cInit) [CStore]
rest
            in (CStore -> ItemDialogMode
MStore CStore
cInit, (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore ([CStore] -> [ItemDialogMode]) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ [CStore]
post [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore]
pre)
          (modeFirst :: ItemDialogMode
modeFirst, modeRest :: [ItemDialogMode]
modeRest) = CStore -> (ItemDialogMode, [ItemDialogMode])
breakStores CStore
firstStore
      Either Text ResultItemDialogMode
res <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
getItem m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric ItemDialogMode
modeFirst [ItemDialogMode]
modeRest
                     Bool
askWhenLone Bool
permitMulitple
      case Either Text ResultItemDialogMode
res of
        Left t :: Text
t -> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, [(ItemId, ItemQuant)])
 -> m (Either Text (CStore, [(ItemId, ItemQuant)])))
-> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (CStore, [(ItemId, ItemQuant)])
forall a b. a -> Either a b
Left Text
t
        Right (RStore fromCStore :: CStore
fromCStore iids :: [ItemId]
iids) -> do
          let bagAll :: ItemBag
bagAll = CStore -> ItemBag
getCStoreBag CStore
fromCStore
              f :: ItemId -> (ItemId, ItemQuant)
f iid :: ItemId
iid = (ItemId
iid, ItemBag
bagAll ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)
          Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, [(ItemId, ItemQuant)])
 -> m (Either Text (CStore, [(ItemId, ItemQuant)])))
-> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a b. (a -> b) -> a -> b
$ (CStore, [(ItemId, ItemQuant)])
-> Either Text (CStore, [(ItemId, ItemQuant)])
forall a b. b -> Either a b
Right (CStore
fromCStore, (ItemId -> (ItemId, ItemQuant))
-> [ItemId] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map ItemId -> (ItemId, ItemQuant)
f [ItemId]
iids)
        Right _ -> String -> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a. HasCallStack => String -> a
error (String -> m (Either Text (CStore, [(ItemId, ItemQuant)])))
-> String -> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a b. (a -> b) -> a -> b
$ "" String -> Either Text ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` Either Text ResultItemDialogMode
res

-- | Let the human player choose a single, preferably suitable,
-- item from a list of items.
getItem :: (MonadClient m, MonadClientUI m)
        => m Suitability    -- ^ which items to consider suitable
        -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
            -> Text)        -- ^ specific prompt for only suitable items
        -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
            -> Text)        -- ^ generic prompt
        -> ItemDialogMode   -- ^ first mode to display
        -> [ItemDialogMode] -- ^ the (rest of) modes
        -> Bool             -- ^ whether to ask, when the only item
                            --   in the starting mode is suitable
        -> Bool             -- ^ whether to permit multiple items as a result
        -> m (Either Text ResultItemDialogMode)
getItem :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
getItem psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric cCur :: ItemDialogMode
cCur cRest :: [ItemDialogMode]
cRest askWhenLone :: Bool
askWhenLone permitMulitple :: Bool
permitMulitple = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  ItemDialogMode -> ItemBag
accessCBag <- (State -> ItemDialogMode -> ItemBag)
-> m (ItemDialogMode -> ItemBag)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemDialogMode -> ItemBag)
 -> m (ItemDialogMode -> ItemBag))
-> (State -> ItemDialogMode -> ItemBag)
-> m (ItemDialogMode -> ItemBag)
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag ActorId
leader
  let storeAssocs :: ItemDialogMode -> [(ItemId, ItemQuant)]
storeAssocs = ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
-> (ItemDialogMode -> ItemBag)
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemDialogMode -> ItemBag
accessCBag
      allAssocs :: [(ItemId, ItemQuant)]
allAssocs = (ItemDialogMode -> [(ItemId, ItemQuant)])
-> [ItemDialogMode] -> [(ItemId, ItemQuant)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ItemDialogMode -> [(ItemId, ItemQuant)]
storeAssocs (ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest)
  case ([(ItemId, ItemQuant)]
allAssocs, ItemDialogMode
cCur) of
    ([(iid :: ItemId
iid, _)], MStore rstore :: CStore
rstore) | [ItemDialogMode] -> Bool
forall a. [a] -> Bool
null [ItemDialogMode]
cRest Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
askWhenLone ->
      Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
 -> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (ResultItemDialogMode -> Either Text ResultItemDialogMode)
-> ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ CStore -> [ItemId] -> ResultItemDialogMode
RStore CStore
rstore [ItemId
iid]
    _ -> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
transition m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Bool
permitMulitple
                    0 ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
ISuitable

data DefItemKey m = DefItemKey
  { DefItemKey m -> Either Text KM
defLabel  :: Either Text K.KM
  , DefItemKey m -> Bool
defCond   :: Bool
  , DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction :: Either K.KM SlotChar -> m (Either Text ResultItemDialogMode)
  }

data Suitability =
    SuitsEverything
  | SuitsSomething (Maybe CStore -> ItemFull -> ItemQuant -> Bool)

transition :: forall m. (MonadClient m, MonadClientUI m)
           => m Suitability
           -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
               -> Text)
           -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
               -> Text)
           -> Bool
           -> Int
           -> ItemDialogMode
           -> [ItemDialogMode]
           -> ItemDialogState
           -> m (Either Text ResultItemDialogMode)
transition :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
transition psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric permitMulitple :: Bool
permitMulitple
           numPrefix :: Int
numPrefix cCur :: ItemDialogMode
cCur cRest :: [ItemDialogMode]
cRest itemDialogState :: ItemDialogState
itemDialogState = do
  let recCall :: Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall = m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
transition m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Bool
permitMulitple
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  ActorUI
bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
  [(ActorId, Actor, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
  ItemBag
bagAll <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag ActorId
leader State
s ItemDialogMode
cCur
  ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
  HumanCmd -> KM
revCmd <- m (HumanCmd -> KM)
forall (m :: * -> *). MonadClientUI m => m (HumanCmd -> KM)
revCmdMap
  Suitability
mpsuit <- m Suitability
psuit  -- when throwing, this sets eps and checks xhair validity
  Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun <- case Suitability
mpsuit of
    SuitsEverything -> (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
-> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe CStore -> ItemFull -> ItemQuant -> Bool)
 -> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool))
-> (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
-> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
forall a b. (a -> b) -> a -> b
$ \_ _ _ -> Bool
True
    SuitsSomething f :: Maybe CStore -> ItemFull -> ItemQuant -> Bool
f -> (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
-> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CStore -> ItemFull -> ItemQuant -> Bool
f  -- When throwing, this function takes
                                  -- missile range into accout.
  SingleItemSlots
lSlots <- ItemDialogMode -> m SingleItemSlots
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m SingleItemSlots
slotsOfItemDialogMode ItemDialogMode
cCur
  let getResult :: [ItemId] -> Either Text ResultItemDialogMode
      getResult :: [ItemId] -> Either Text ResultItemDialogMode
getResult iids :: [ItemId]
iids = ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (ResultItemDialogMode -> Either Text ResultItemDialogMode)
-> ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ case ItemDialogMode
cCur of
        MStore rstore :: CStore
rstore -> CStore -> [ItemId] -> ResultItemDialogMode
RStore CStore
rstore [ItemId]
iids
        MOrgans -> case [ItemId]
iids of
          [iid :: ItemId
iid] -> ItemId -> ItemBag -> SingleItemSlots -> ResultItemDialogMode
ROrgans ItemId
iid ItemBag
bagAll SingleItemSlots
bagItemSlotsAll
          _ -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemDialogMode, [ItemId]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemDialogMode
cCur, [ItemId]
iids)
        MOwned -> case [ItemId]
iids of
          [iid :: ItemId
iid] -> ItemId -> ResultItemDialogMode
ROwned ItemId
iid
          _ -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemDialogMode, [ItemId]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemDialogMode
cCur, [ItemId]
iids)
        MSkills -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> ItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ItemDialogMode
cCur
        MLore rlore :: SLore
rlore -> case [ItemId]
iids of
          [iid :: ItemId
iid] -> SLore
-> ItemId -> ItemBag -> SingleItemSlots -> ResultItemDialogMode
RLore SLore
rlore ItemId
iid ItemBag
bagAll SingleItemSlots
bagItemSlotsAll
          _ -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemDialogMode, [ItemId]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemDialogMode
cCur, [ItemId]
iids)
        MPlaces ->  String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> ItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ItemDialogMode
cCur
        MModes -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> ItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ItemDialogMode
cCur
      mstore :: Maybe CStore
mstore = case ItemDialogMode
cCur of
        MStore store :: CStore
store -> CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
store
        _ -> Maybe CStore
forall a. Maybe a
Nothing
      filterP :: ItemId -> ItemQuant -> Bool
filterP iid :: ItemId
iid = Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun Maybe CStore
mstore (ItemId -> ItemFull
itemToF ItemId
iid)
      bagAllSuit :: ItemBag
bagAllSuit = (ItemId -> ItemQuant -> Bool) -> ItemBag -> ItemBag
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey ItemId -> ItemQuant -> Bool
filterP ItemBag
bagAll
      bagItemSlotsAll :: SingleItemSlots
bagItemSlotsAll = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
bagAll) SingleItemSlots
lSlots
      -- Predicate for slot matching the current prefix, unless the prefix
      -- is 0, in which case we display all slots, even if they require
      -- the user to start with number keys to get to them.
      -- Could be generalized to 1 if prefix 1x exists, etc., but too rare.
      hasPrefixOpen :: SlotChar -> ItemId -> Bool
hasPrefixOpen x :: SlotChar
x _ = SlotChar -> Int
slotPrefix SlotChar
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numPrefix Bool -> Bool -> Bool
|| Int
numPrefix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
      bagItemSlotsOpen :: SingleItemSlots
bagItemSlotsOpen = (SlotChar -> ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey SlotChar -> ItemId -> Bool
hasPrefixOpen SingleItemSlots
bagItemSlotsAll
      hasPrefix :: SlotChar -> ItemId -> Bool
hasPrefix x :: SlotChar
x _ = SlotChar -> Int
slotPrefix SlotChar
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numPrefix
      bagItemSlots :: SingleItemSlots
bagItemSlots = (SlotChar -> ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey SlotChar -> ItemId -> Bool
hasPrefix SingleItemSlots
bagItemSlotsOpen
      bag :: ItemBag
bag = [(ItemId, ItemQuant)] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, ItemQuant)] -> ItemBag)
-> [(ItemId, ItemQuant)] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, ItemQuant))
-> [ItemId] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
bagAll ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid))
                              (SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
bagItemSlotsOpen)
      suitableItemSlotsAll :: SingleItemSlots
suitableItemSlotsAll = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
bagAllSuit) SingleItemSlots
lSlots
      suitableItemSlotsOpen :: SingleItemSlots
suitableItemSlotsOpen =
        (SlotChar -> ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey SlotChar -> ItemId -> Bool
hasPrefixOpen SingleItemSlots
suitableItemSlotsAll
      bagSuit :: ItemBag
bagSuit = [(ItemId, ItemQuant)] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, ItemQuant)] -> ItemBag)
-> [(ItemId, ItemQuant)] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, ItemQuant))
-> [ItemId] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
bagAllSuit ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid))
                                  (SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
suitableItemSlotsOpen)
      nextContainers :: Direction -> (ItemDialogMode, [ItemDialogMode])
nextContainers direction :: Direction
direction = case Direction
direction of
        Forward -> case [ItemDialogMode]
cRest [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
cCur] of
          c1 :: ItemDialogMode
c1 : rest :: [ItemDialogMode]
rest -> (ItemDialogMode
c1, [ItemDialogMode]
rest)
          [] -> String -> (ItemDialogMode, [ItemDialogMode])
forall a. HasCallStack => String -> a
error (String -> (ItemDialogMode, [ItemDialogMode]))
-> String -> (ItemDialogMode, [ItemDialogMode])
forall a b. (a -> b) -> a -> b
$ "" String -> [ItemDialogMode] -> String
forall v. Show v => String -> v -> String
`showFailure` [ItemDialogMode]
cRest
        Backward -> case [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse ([ItemDialogMode] -> [ItemDialogMode])
-> [ItemDialogMode] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest of
          c1 :: ItemDialogMode
c1 : rest :: [ItemDialogMode]
rest -> (ItemDialogMode
c1, [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse [ItemDialogMode]
rest)
          [] -> String -> (ItemDialogMode, [ItemDialogMode])
forall a. HasCallStack => String -> a
error (String -> (ItemDialogMode, [ItemDialogMode]))
-> String -> (ItemDialogMode, [ItemDialogMode])
forall a b. (a -> b) -> a -> b
$ "" String -> [ItemDialogMode] -> String
forall v. Show v => String -> v -> String
`showFailure` [ItemDialogMode]
cRest
  (bagFiltered :: ItemBag
bagFiltered, promptChosen :: Text
promptChosen) <- (State -> (ItemBag, Text)) -> m (ItemBag, Text)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (ItemBag, Text)) -> m (ItemBag, Text))
-> (State -> (ItemBag, Text)) -> m (ItemBag, Text)
forall a b. (a -> b) -> a -> b
$ \s :: State
s ->
    case ItemDialogState
itemDialogState of
      ISuitable -> (ItemBag
bagSuit, Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor
body ActorUI
bodyUI Skills
actorCurAndMaxSk ItemDialogMode
cCur State
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":")
      IAll -> (ItemBag
bag, Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Actor
body ActorUI
bodyUI Skills
actorCurAndMaxSk ItemDialogMode
cCur State
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":")
  let (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
      multipleSlots :: SingleItemSlots
multipleSlots = if ItemDialogState
itemDialogState ItemDialogState -> ItemDialogState -> Bool
forall a. Eq a => a -> a -> Bool
== ItemDialogState
IAll
                      then SingleItemSlots
bagItemSlotsAll
                      else SingleItemSlots
suitableItemSlotsAll
      maySwitchLeader :: ItemDialogMode -> Bool
maySwitchLeader MOwned = Bool
False
      maySwitchLeader MLore{} = Bool
False
      maySwitchLeader MPlaces = Bool
False
      maySwitchLeader MModes = Bool
False
      maySwitchLeader _ = Bool
True
      cycleKeyDef :: Direction -> (KM, DefItemKey m)
cycleKeyDef direction :: Direction
direction =
        let km :: KM
km = HumanCmd -> KM
revCmd (HumanCmd -> KM) -> HumanCmd -> KM
forall a b. (a -> b) -> a -> b
$ Direction -> HumanCmd
MemberCycle Direction
direction
        in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
               { defLabel :: Either Text KM
defLabel = if Direction
direction Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Forward then KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km else Text -> Either Text KM
forall a b. a -> Either a b
Left ""
               , defCond :: Bool
defCond = ItemDialogMode -> Bool
maySwitchLeader ItemDialogMode
cCur Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
autoDun Bool -> Bool -> Bool
|| [(ActorId, Actor, ActorUI)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor, ActorUI)]
hs)
               , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \_ -> do
                   MError
err <- Bool -> Direction -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Direction -> m MError
memberCycle Bool
False Direction
direction
                   let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (MError -> Bool
forall a. Maybe a -> Bool
isNothing MError
err Bool -> MError -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` MError
err) ()
                   Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
               })
      cycleLevelKeyDef :: Direction -> (KM, DefItemKey m)
cycleLevelKeyDef direction :: Direction
direction =
        let km :: KM
km = HumanCmd -> KM
revCmd (HumanCmd -> KM) -> HumanCmd -> KM
forall a b. (a -> b) -> a -> b
$ Direction -> HumanCmd
MemberCycleLevel Direction
direction
        in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
                { defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
                , defCond :: Bool
defCond = ItemDialogMode -> Bool
maySwitchLeader ItemDialogMode
cCur
                            Bool -> Bool -> Bool
&& ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(_, b :: Actor
b, _) -> Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
body) [(ActorId, Actor, ActorUI)]
hs
                , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \_ -> do
                    MError
err <- Bool -> Direction -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Direction -> m MError
memberCycleLevel Bool
False Direction
direction
                    let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (MError -> Bool
forall a. Maybe a -> Bool
isNothing MError
err Bool -> MError -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` MError
err) ()
                    Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
                })
      keyDefs :: [(K.KM, DefItemKey m)]
      keyDefs :: [(KM, DefItemKey m)]
keyDefs = ((KM, DefItemKey m) -> Bool)
-> [(KM, DefItemKey m)] -> [(KM, DefItemKey m)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DefItemKey m -> Bool
forall (m :: * -> *). DefItemKey m -> Bool
defCond (DefItemKey m -> Bool)
-> ((KM, DefItemKey m) -> DefItemKey m)
-> (KM, DefItemKey m)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KM, DefItemKey m) -> DefItemKey m
forall a b. (a, b) -> b
snd) ([(KM, DefItemKey m)] -> [(KM, DefItemKey m)])
-> [(KM, DefItemKey m)] -> [(KM, DefItemKey m)]
forall a b. (a -> b) -> a -> b
$
        [ let km :: KM
km = Char -> KM
K.mkChar '<'
          in (KM
km, Direction -> Either Text KM -> DefItemKey m
changeContainerDef Direction
Backward (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km)
        , let km :: KM
km = Char -> KM
K.mkChar '>'
          in (KM
km, Direction -> Either Text KM -> DefItemKey m
changeContainerDef Direction
Forward (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km)
        , let km :: KM
km = Char -> KM
K.mkChar '+'
          in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
           { defLabel :: Either Text KM
defLabel = KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km
           , defCond :: Bool
defCond = ItemBag
bag ItemBag -> ItemBag -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemBag
bagSuit
           , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \_ -> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest
                               (ItemDialogState -> m (Either Text ResultItemDialogMode))
-> ItemDialogState -> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ case ItemDialogState
itemDialogState of
                                   ISuitable -> ItemDialogState
IAll
                                   IAll -> ItemDialogState
ISuitable
           })
        , let km :: KM
km = Char -> KM
K.mkChar '*'
          in (KM
km, Either Text KM -> DefItemKey m
useMultipleDef (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km)
        , let km :: KM
km = Char -> KM
K.mkChar '!'
          in (KM
km, Either Text KM -> DefItemKey m
useMultipleDef (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ Text -> Either Text KM
forall a b. a -> Either a b
Left "")  -- alias close to 'g'
        , Direction -> (KM, DefItemKey m)
cycleKeyDef Direction
Forward
        , Direction -> (KM, DefItemKey m)
cycleKeyDef Direction
Backward
        , Direction -> (KM, DefItemKey m)
cycleLevelKeyDef Direction
Forward
        , Direction -> (KM, DefItemKey m)
cycleLevelKeyDef Direction
Backward
        , (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier Key
K.LeftButtonRelease, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
           { defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
           , defCond :: Bool
defCond = ItemDialogMode -> Bool
maySwitchLeader ItemDialogMode
cCur Bool -> Bool -> Bool
&& Bool -> Bool
not ([(ActorId, Actor, ActorUI)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor, ActorUI)]
hs)
           , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \_ -> do
               MError
merror <- m MError
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m MError
pickLeaderWithPointer
               case MError
merror of
                 Nothing -> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
                 Just{} -> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
 -> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ResultItemDialogMode
forall a b. a -> Either a b
Left "not a menu item nor teammate position"
                             -- don't inspect the error, it's expected
           })
        , (KM
K.escKM, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
           { defLabel :: Either Text KM
defLabel = KM -> Either Text KM
forall a b. b -> Either a b
Right KM
K.escKM
           , defCond :: Bool
defCond = Bool
True
           , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \_ -> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
 -> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ResultItemDialogMode
forall a b. a -> Either a b
Left "never mind"
           })
        ]
        [(KM, DefItemKey m)]
-> [(KM, DefItemKey m)] -> [(KM, DefItemKey m)]
forall a. [a] -> [a] -> [a]
++ [(KM, DefItemKey m)]
numberPrefixes
      changeContainerDef :: Direction -> Either Text KM -> DefItemKey m
changeContainerDef direction :: Direction
direction defLabel :: Either Text KM
defLabel =
        let (cCurAfterCalm :: ItemDialogMode
cCurAfterCalm, cRestAfterCalm :: [ItemDialogMode]
cRestAfterCalm) = Direction -> (ItemDialogMode, [ItemDialogMode])
nextContainers Direction
direction
        in $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
          { Either Text KM
defLabel :: Either Text KM
defLabel :: Either Text KM
defLabel
          , defCond :: Bool
defCond = ItemDialogMode
cCurAfterCalm ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemDialogMode
cCur
          , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \_ ->
              Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall Int
numPrefix ItemDialogMode
cCurAfterCalm [ItemDialogMode]
cRestAfterCalm ItemDialogState
itemDialogState
          }
      useMultipleDef :: Either Text KM -> DefItemKey m
useMultipleDef defLabel :: Either Text KM
defLabel = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
        { Either Text KM
defLabel :: Either Text KM
defLabel :: Either Text KM
defLabel
        , defCond :: Bool
defCond = Bool
permitMulitple Bool -> Bool -> Bool
&& Bool -> Bool
not (SingleItemSlots -> Bool
forall k a. EnumMap k a -> Bool
EM.null SingleItemSlots
multipleSlots)
        , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \_ ->
            let eslots :: [ItemId]
eslots = SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
multipleSlots
            in Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
 -> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$! [ItemId] -> Either Text ResultItemDialogMode
getResult [ItemId]
eslots
        }
      prefixCmdDef :: Int -> (KM, DefItemKey m)
prefixCmdDef d :: Int
d =
        (Char -> KM
K.mkChar (Char -> KM) -> Char -> KM
forall a b. (a -> b) -> a -> b
$ Int -> Char
Char.intToDigit Int
d, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
           { defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
           , defCond :: Bool
defCond = Bool
True
           , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \_ ->
               Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall (10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numPrefix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
           })
      numberPrefixes :: [(KM, DefItemKey m)]
numberPrefixes = (Int -> (KM, DefItemKey m)) -> [Int] -> [(KM, DefItemKey m)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (KM, DefItemKey m)
prefixCmdDef [0..9]
      lettersDef :: DefItemKey m
      lettersDef :: DefItemKey m
lettersDef = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
        { defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
        , defCond :: Bool
defCond = Bool
True
        , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \ekm :: Either KM SlotChar
ekm ->
            let slot :: SlotChar
slot = case Either KM SlotChar
ekm of
                  Left K.KM{key :: KM -> Key
key=K.Char l :: Char
l} -> Int -> Char -> SlotChar
SlotChar Int
numPrefix Char
l
                  Left km :: KM
km ->
                    String -> SlotChar
forall a. HasCallStack => String -> a
error (String -> SlotChar) -> String -> SlotChar
forall a b. (a -> b) -> a -> b
$ "unexpected key:" String -> ShowS
forall v. Show v => String -> v -> String
`showFailure` KM -> String
K.showKM KM
km
                  Right sl :: SlotChar
sl -> SlotChar
sl
            in case SlotChar -> SingleItemSlots -> Maybe ItemId
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup SlotChar
slot SingleItemSlots
bagItemSlotsAll of
              Nothing -> String -> m (Either Text ResultItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either Text ResultItemDialogMode))
-> String -> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ "unexpected slot"
                                 String -> (SlotChar, SingleItemSlots) -> String
forall v. Show v => String -> v -> String
`showFailure` (SlotChar
slot, SingleItemSlots
bagItemSlots)
              Just iid :: ItemId
iid -> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
 -> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$! [ItemId] -> Either Text ResultItemDialogMode
getResult [ItemId
iid]
        }
      processSpecialOverlay :: OKX -> (Int -> ResultItemDialogMode)
                            -> m (Either Text ResultItemDialogMode)
      processSpecialOverlay :: OKX
-> (Int -> ResultItemDialogMode)
-> m (Either Text ResultItemDialogMode)
processSpecialOverlay io :: OKX
io resultConstructor :: Int -> ResultItemDialogMode
resultConstructor = do
        let slotLabels :: [Either [KM] SlotChar]
slotLabels = ((Either [KM] SlotChar, (PointUI, ButtonWidth))
 -> Either [KM] SlotChar)
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> [a] -> [b]
map (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar
forall a b. (a, b) -> a
fst ([(Either [KM] SlotChar, (PointUI, ButtonWidth))]
 -> [Either [KM] SlotChar])
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> a -> b
$ OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a, b) -> b
snd OKX
io
            slotKeys :: [KM]
slotKeys = (Either [KM] SlotChar -> Maybe KM)
-> [Either [KM] SlotChar] -> [KM]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> Either [KM] SlotChar -> Maybe KM
keyOfEKM Int
numPrefix) [Either [KM] SlotChar]
slotLabels
            skillsDef :: DefItemKey m
            skillsDef :: DefItemKey m
skillsDef = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
              { defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
              , defCond :: Bool
defCond = Bool
True
              , defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \ekm :: Either KM SlotChar
ekm ->
                  let slot :: SlotChar
slot = case Either KM SlotChar
ekm of
                        Left K.KM{Key
key :: Key
key :: KM -> Key
key} -> case Key
key of
                          K.Char l :: Char
l -> Int -> Char -> SlotChar
SlotChar Int
numPrefix Char
l
                          _ -> String -> SlotChar
forall a. HasCallStack => String -> a
error (String -> SlotChar) -> String -> SlotChar
forall a b. (a -> b) -> a -> b
$ "unexpected key:"
                                       String -> ShowS
forall v. Show v => String -> v -> String
`showFailure` Key -> String
K.showKey Key
key
                        Right sl :: SlotChar
sl -> SlotChar
sl
                      slotIndex :: Int
slotIndex = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error "illegal slot")
                                  (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ SlotChar -> [SlotChar] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex SlotChar
slot [SlotChar]
allSlots
                  in Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (Int -> ResultItemDialogMode
resultConstructor Int
slotIndex))
              }
        [(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
runDefItemKey [(KM, DefItemKey m)]
keyDefs DefItemKey m
skillsDef OKX
io [KM]
slotKeys Text
promptChosen ItemDialogMode
cCur
  case ItemDialogMode
cCur of
    MSkills -> do
      OKX
io <- ActorId -> m OKX
forall (m :: * -> *). MonadClientUI m => ActorId -> m OKX
skillsOverlay ActorId
leader
      OKX
-> (Int -> ResultItemDialogMode)
-> m (Either Text ResultItemDialogMode)
processSpecialOverlay OKX
io Int -> ResultItemDialogMode
RSkills
    MPlaces -> do
      OKX
io <- m OKX
forall (m :: * -> *). MonadClientUI m => m OKX
placesOverlay
      OKX
-> (Int -> ResultItemDialogMode)
-> m (Either Text ResultItemDialogMode)
processSpecialOverlay OKX
io Int -> ResultItemDialogMode
RPlaces
    MModes -> do
      OKX
io <- m OKX
forall (m :: * -> *). MonadClientUI m => m OKX
modesOverlay
      OKX
-> (Int -> ResultItemDialogMode)
-> m (Either Text ResultItemDialogMode)
processSpecialOverlay OKX
io Int -> ResultItemDialogMode
RModes
    _ -> do
      let displayRanged :: Bool
displayRanged =
            ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CStore -> ItemDialogMode
MStore CStore
COrgan, ItemDialogMode
MOrgans, SLore -> ItemDialogMode
MLore SLore
SOrgan, SLore -> ItemDialogMode
MLore SLore
STrunk]
      OKX
io <- SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
itemOverlay SingleItemSlots
lSlots (Actor -> LevelId
blid Actor
body) ItemBag
bagFiltered Bool
displayRanged
      let slotKeys :: [KM]
slotKeys = (SlotChar -> Maybe KM) -> [SlotChar] -> [KM]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> Either [KM] SlotChar -> Maybe KM
keyOfEKM Int
numPrefix (Either [KM] SlotChar -> Maybe KM)
-> (SlotChar -> Either [KM] SlotChar) -> SlotChar -> Maybe KM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right)
                     ([SlotChar] -> [KM]) -> [SlotChar] -> [KM]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [SlotChar]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys SingleItemSlots
bagItemSlots
      [(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
runDefItemKey [(KM, DefItemKey m)]
keyDefs DefItemKey m
lettersDef OKX
io [KM]
slotKeys Text
promptChosen ItemDialogMode
cCur

keyOfEKM :: Int -> Either [K.KM] SlotChar -> Maybe K.KM
keyOfEKM :: Int -> Either [KM] SlotChar -> Maybe KM
keyOfEKM _ (Left kms :: [KM]
kms) = String -> Maybe KM
forall a. HasCallStack => String -> a
error (String -> Maybe KM) -> String -> Maybe KM
forall a b. (a -> b) -> a -> b
$ "" String -> [KM] -> String
forall v. Show v => String -> v -> String
`showFailure` [KM]
kms
keyOfEKM numPrefix :: Int
numPrefix (Right SlotChar{..}) | Int
slotPrefix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numPrefix =
  KM -> Maybe KM
forall a. a -> Maybe a
Just (KM -> Maybe KM) -> KM -> Maybe KM
forall a b. (a -> b) -> a -> b
$ Char -> KM
K.mkChar Char
slotChar
keyOfEKM _ _ = Maybe KM
forall a. Maybe a
Nothing

-- We don't create keys from slots in @okx@, so they have to be
-- exolicitly given in @slotKeys@.
runDefItemKey :: (MonadClient m, MonadClientUI m)
              => [(K.KM, DefItemKey m)]
              -> DefItemKey m
              -> OKX
              -> [K.KM]
              -> Text
              -> ItemDialogMode
              -> m (Either Text ResultItemDialogMode)
runDefItemKey :: [(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
runDefItemKey keyDefs :: [(KM, DefItemKey m)]
keyDefs lettersDef :: DefItemKey m
lettersDef okx :: OKX
okx slotKeys :: [KM]
slotKeys prompt :: Text
prompt cCur :: ItemDialogMode
cCur = do
  let itemKeys :: [KM]
itemKeys = [KM]
slotKeys [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ ((KM, DefItemKey m) -> KM) -> [(KM, DefItemKey m)] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (KM, DefItemKey m) -> KM
forall a b. (a, b) -> a
fst [(KM, DefItemKey m)]
keyDefs
      wrapB :: a -> a
wrapB s :: a
s = "[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> "]"
      (keyLabelsRaw :: [Text]
keyLabelsRaw, keys :: [KM]
keys) = [Either Text KM] -> ([Text], [KM])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Text KM] -> ([Text], [KM]))
-> [Either Text KM] -> ([Text], [KM])
forall a b. (a -> b) -> a -> b
$ ((KM, DefItemKey m) -> Either Text KM)
-> [(KM, DefItemKey m)] -> [Either Text KM]
forall a b. (a -> b) -> [a] -> [b]
map (DefItemKey m -> Either Text KM
forall (m :: * -> *). DefItemKey m -> Either Text KM
defLabel (DefItemKey m -> Either Text KM)
-> ((KM, DefItemKey m) -> DefItemKey m)
-> (KM, DefItemKey m)
-> Either Text KM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KM, DefItemKey m) -> DefItemKey m
forall a b. (a, b) -> b
snd) [(KM, DefItemKey m)]
keyDefs
      keyLabels :: [Text]
keyLabels = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
keyLabelsRaw
      choice :: Text
choice = Text -> [Text] -> Text
T.intercalate " " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapB ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
keyLabels
        -- switch to Data.Containers.ListUtils.nubOrd when we drop GHC 8.4.4
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
<+> Text
choice
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  Either KM SlotChar
ekm <- do
    Slideshow
okxs <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) [KM]
keys OKX
okx
    String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen (ItemDialogMode -> String
forall a. Show a => a -> String
show ItemDialogMode
cCur) ColorMode
ColorFull Bool
False Slideshow
okxs [KM]
itemKeys
  case Either KM SlotChar
ekm of
    Left km :: KM
km -> case KM
km KM -> [(KM, DefItemKey m)] -> Maybe (DefItemKey m)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(KM, DefItemKey m)]
keyDefs of
      Just keyDef :: DefItemKey m
keyDef -> DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
keyDef Either KM SlotChar
ekm
      Nothing -> DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
lettersDef Either KM SlotChar
ekm  -- pressed; with current prefix
    Right _slot :: SlotChar
_slot -> DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
lettersDef Either KM SlotChar
ekm  -- selected; with the given prefix