-- | UI of inventory management.
module Game.LambdaHack.Client.UI.InventoryM
  ( Suitability(..)
  , getFull, getGroupItem, getStoreItem
  ) 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           Data.Tuple (swap)
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.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.MsgM
import           Game.LambdaHack.Client.UI.Overlay
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.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Types
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)

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 -> (Int, [Time])) -> EnumMap ItemId Item -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map ((Int, [Time]) -> Item -> (Int, [Time])
forall a b. a -> b -> a
const (1, [])) (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

-- | 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 :: MonadClientUI m
             => m Suitability
                          -- ^ which items to consider suitable
             -> Text      -- ^ specific prompt for only suitable items
             -> Text      -- ^ generic prompt
             -> [CStore]  -- ^ initial legal modes
             -> [CStore]  -- ^ legal modes after Calm taken into account
             -> m (Either Text ( (ItemId, ItemFull)
                               , (ItemDialogMode, Either K.KM SlotChar) ))
getGroupItem :: m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
getGroupItem psuit :: m Suitability
psuit prompt :: Text
prompt promptGeneric :: Text
promptGeneric
             cLegalRaw :: [CStore]
cLegalRaw cLegalAfterCalm :: [CStore]
cLegalAfterCalm = do
  Either
  Text
  ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
soc <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> [CStore]
-> Bool
-> Bool
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> [CStore]
-> Bool
-> Bool
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
getFull m Suitability
psuit
                 (\_ _ _ cCur :: ItemDialogMode
cCur _ -> Text
prompt Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur)
                 (\_ _ _ cCur :: ItemDialogMode
cCur _ -> Text
promptGeneric Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur)
                 [CStore]
cLegalRaw [CStore]
cLegalAfterCalm Bool
True Bool
False
  case Either
  Text
  ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
soc of
    Left err :: Text
err -> Either
  Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
 -> m (Either
         Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))))
-> Either
     Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ Text
-> Either
     Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
forall a b. a -> Either a b
Left Text
err
    Right ([(iid :: ItemId
iid, (itemFull :: ItemFull
itemFull, _))], cekm :: (ItemDialogMode, Either KM SlotChar)
cekm) ->
      Either
  Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
 -> m (Either
         Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))))
-> Either
     Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> Either
     Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
forall a b. b -> Either a b
Right ((ItemId
iid, ItemFull
itemFull), (ItemDialogMode, Either KM SlotChar)
cekm)
    Right _ -> String
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall a. HasCallStack => String -> a
error (String
 -> m (Either
         Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))))
-> String
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ "" String
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` Either
  Text
  ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
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 :: MonadClientUI m
             => (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
                 -> Text)        -- ^ how to describe suitable items
             -> ItemDialogMode   -- ^ initial mode
             -> m ( Either Text (ItemId, ItemBag, SingleItemSlots)
                  , (ItemDialogMode, Either K.KM SlotChar) )
getStoreItem :: (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
getStoreItem prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt cInitial :: ItemDialogMode
cInitial = do
  let itemCs :: [ItemDialogMode]
itemCs = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore
CEqp, CStore
CInv, CStore
CGround, CStore
CSha]
      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]
      allCs :: [ItemDialogMode]
allCs = case ItemDialogMode
cInitial of
        MLore{} -> [ItemDialogMode]
loreCs
        MPlaces -> [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
  (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
soc <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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 (ItemDialogMode
cInitial ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
remCs)
  case (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
soc of
    (Left err :: Text
err, cekm :: (ItemDialogMode, Either KM SlotChar)
cekm) -> (Either Text (ItemId, ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text (ItemId, ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left Text
err, (ItemDialogMode, Either KM SlotChar)
cekm)
    (Right ([iid :: ItemId
iid], itemBag :: ItemBag
itemBag, lSlots :: SingleItemSlots
lSlots), cekm :: (ItemDialogMode, Either KM SlotChar)
cekm) ->
      (Either Text (ItemId, ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ItemId, ItemBag, SingleItemSlots)
-> Either Text (ItemId, ItemBag, SingleItemSlots)
forall a b. b -> Either a b
Right (ItemId
iid, ItemBag
itemBag, SingleItemSlots
lSlots), (ItemDialogMode, Either KM SlotChar)
cekm)
    (Right{}, _) -> String
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall a. HasCallStack => String -> a
error (String
 -> m (Either Text (ItemId, ItemBag, SingleItemSlots),
       (ItemDialogMode, Either KM SlotChar)))
-> String
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ "" String
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
    (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
soc

-- | 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 :: 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]         -- ^ initial legal modes
        -> [CStore]         -- ^ legal modes with Calm taken into account
        -> 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 ( [(ItemId, ItemFullKit)]
                          , (ItemDialogMode, Either K.KM SlotChar) ))
getFull :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> [CStore]
-> Bool
-> Bool
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
getFull psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric cLegalRaw :: [CStore]
cLegalRaw cLegalAfterCalm :: [CStore]
cLegalAfterCalm
        askWhenLone :: Bool
askWhenLone permitMulitple :: Bool
permitMulitple = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  let aidNotEmpty :: CStore -> ActorId -> m Bool
aidNotEmpty store :: CStore
store aid :: ActorId
aid = do
        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
aid
        ItemBag
bag <- (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
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
body CStore
store
        Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
bag
      partyNotEmpty :: CStore -> m Bool
partyNotEmpty store :: CStore
store = do
        [(ActorId, Actor)]
as <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
        [Bool]
bs <- ((ActorId, Actor) -> m Bool) -> [(ActorId, Actor)] -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CStore -> ActorId -> m Bool
forall (m :: * -> *).
MonadStateRead m =>
CStore -> ActorId -> m Bool
aidNotEmpty CStore
store (ActorId -> m Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
as
        Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
bs
  Suitability
mpsuit <- m Suitability
psuit
  let psuitFun :: ItemFull -> (Int, [Time]) -> Bool
psuitFun = case Suitability
mpsuit of
        SuitsEverything -> \_ _ -> Bool
True
        SuitsSomething f :: ItemFull -> (Int, [Time]) -> Bool
f -> ItemFull -> (Int, [Time]) -> 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]
cLegalAfterCalm of
    [] ->
      if Maybe CStore -> Bool
forall a. Maybe a -> Bool
isNothing ((CStore -> Bool) -> [CStore] -> Maybe CStore
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CStore -> Bool
hasThisActor [CStore]
cLegalRaw) then do
        let contLegalRaw :: [ItemDialogMode]
contLegalRaw = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore]
cLegalRaw
            tLegal :: [Part]
tLegal = (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]
contLegalRaw
            ppLegal :: Text
ppLegal = [Part] -> Text
makePhrase [Part -> [Part] -> Part
MU.WWxW "nor" [Part]
tLegal]
        Either
  Text
  ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   Text
   ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
 -> m (Either
         Text
         ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))))
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ Text
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. a -> Either a b
Left (Text
 -> Either
      Text
      ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
-> Text
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ "no items" Text -> Text -> Text
<+> Text
ppLegal
      else Either
  Text
  ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   Text
   ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
 -> m (Either
         Text
         ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))))
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ Text
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. a -> Either a b
Left (Text
 -> Either
      Text
      ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
-> Text
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
ItemNotCalm
    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, (Int, [Time])) -> Bool)
-> [(ItemId, (Int, [Time]))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(iid :: ItemId
iid, kit :: (Int, [Time])
kit) -> ItemFull -> (Int, [Time]) -> Bool
psuitFun (ItemId -> ItemFull
itemToF ItemId
iid) (Int, [Time])
kit) ([(ItemId, (Int, [Time]))] -> Bool)
-> [(ItemId, (Int, [Time]))] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, (Int, [Time]))]
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.
      [CStore]
cLegal <- (CStore -> m Bool) -> [CStore] -> m [CStore]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM CStore -> m Bool
partyNotEmpty [CStore]
cLegalRaw
      let 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]
cLegal
                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)
      let (modeFirst :: ItemDialogMode
modeFirst, modeRest :: [ItemDialogMode]
modeRest) = CStore -> (ItemDialogMode, [ItemDialogMode])
breakStores CStore
firstStore
      (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
res <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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 ((CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore]
cLegal)
      case (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
res of
        (Left t :: Text
t, _) -> Either
  Text
  ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   Text
   ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
 -> m (Either
         Text
         ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))))
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ Text
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. a -> Either a b
Left Text
t
        (Right (iids :: [ItemId]
iids, itemBag :: ItemBag
itemBag, _lSlots :: SingleItemSlots
_lSlots), cekm :: (ItemDialogMode, Either KM SlotChar)
cekm) -> do
          let f :: ItemId -> (ItemId, ItemFullKit)
f iid :: ItemId
iid = (ItemId
iid, (ItemId -> ItemFull
itemToF ItemId
iid, ItemBag
itemBag ItemBag -> ItemId -> (Int, [Time])
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid))
          Either
  Text
  ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   Text
   ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
 -> m (Either
         Text
         ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))))
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
        Text
        ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> Either
     Text
     ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. b -> Either a b
Right ((ItemId -> (ItemId, ItemFullKit))
-> [ItemId] -> [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> [a] -> [b]
map ItemId -> (ItemId, ItemFullKit)
f [ItemId]
iids, (ItemDialogMode, Either KM SlotChar)
cekm)

-- | Let the human player choose a single, preferably suitable,
-- item from a list of items.
getItem :: 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, legal or not
        -> [ItemDialogMode] -- ^ the (rest of) legal modes
        -> Bool             -- ^ whether to ask, when the only item
                            --   in the starting mode is suitable
        -> Bool             -- ^ whether to permit multiple items as a result
        -> [ItemDialogMode] -- ^ all legal modes
        -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)
             , (ItemDialogMode, Either K.KM SlotChar) )
getItem :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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
        cLegal :: [ItemDialogMode]
cLegal = 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, (Int, [Time]))]
storeAssocs = ItemBag -> [(ItemId, (Int, [Time]))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, (Int, [Time]))])
-> (ItemDialogMode -> ItemBag)
-> ItemDialogMode
-> [(ItemId, (Int, [Time]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemDialogMode -> ItemBag
accessCBag
      allAssocs :: [(ItemId, (Int, [Time]))]
allAssocs = (ItemDialogMode -> [(ItemId, (Int, [Time]))])
-> [ItemDialogMode] -> [(ItemId, (Int, [Time]))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ItemDialogMode -> [(ItemId, (Int, [Time]))]
storeAssocs (ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest)
  case [(ItemId, (Int, [Time]))]
allAssocs of
    [(iid :: ItemId
iid, k :: (Int, [Time])
k)] | [ItemDialogMode] -> Bool
forall a. [a] -> Bool
null [ItemDialogMode]
cRest Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
askWhenLone -> do
      ItemSlots itemSlots :: EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
      let lSlots :: SingleItemSlots
lSlots = EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemDialogMode -> SLore
IA.loreFromMode ItemDialogMode
cCur
          slotChar :: SlotChar
slotChar = SlotChar -> Maybe SlotChar -> SlotChar
forall a. a -> Maybe a -> a
fromMaybe (String -> SlotChar
forall a. HasCallStack => String -> a
error (String -> SlotChar) -> String -> SlotChar
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemId, SingleItemSlots) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, SingleItemSlots
lSlots))
                     (Maybe SlotChar -> SlotChar) -> Maybe SlotChar -> SlotChar
forall a b. (a -> b) -> a -> b
$ ItemId -> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid ([(ItemId, SlotChar)] -> Maybe SlotChar)
-> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId) -> (ItemId, SlotChar))
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> [a] -> [b]
map (SlotChar, ItemId) -> (ItemId, SlotChar)
forall a b. (a, b) -> (b, a)
swap ([(SlotChar, ItemId)] -> [(ItemId, SlotChar)])
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs SingleItemSlots
lSlots
      (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([ItemId], ItemBag, SingleItemSlots)
-> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. b -> Either a b
Right ([ItemId
iid], ItemId -> (Int, [Time]) -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid (Int, [Time])
k, SlotChar -> ItemId -> SingleItemSlots
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton SlotChar
slotChar ItemId
iid)
             , (ItemDialogMode
cCur, SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
slotChar) )
    _ ->
      m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
transition m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Bool
permitMulitple [ItemDialogMode]
cLegal
                 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction :: Either K.KM SlotChar
              -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)
                   , (ItemDialogMode, Either K.KM SlotChar) )
  }

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

transition :: forall m. MonadClientUI m
           => m Suitability
           -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
               -> Text)
           -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
               -> Text)
           -> Bool
           -> [ItemDialogMode]
           -> Int
           -> ItemDialogMode
           -> [ItemDialogMode]
           -> ItemDialogState
           -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)
                , (ItemDialogMode, Either K.KM SlotChar) )
transition :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
transition psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric permitMulitple :: Bool
permitMulitple cLegal :: [ItemDialogMode]
cLegal
           numPrefix :: Int
numPrefix cCur :: ItemDialogMode
cCur cRest :: [ItemDialogMode]
cRest itemDialogState :: ItemDialogState
itemDialogState = do
  let recCall :: Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
recCall = m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
transition m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Bool
permitMulitple [ItemDialogMode]
cLegal
  ItemSlots itemSlotsPre :: EnumMap SLore SingleItemSlots
itemSlotsPre <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills 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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
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
  KM -> HumanCmd -> KM
revCmd <- m (KM -> HumanCmd -> KM)
forall (m :: * -> *). MonadClientUI m => m (KM -> HumanCmd -> KM)
revCmdMap
  Suitability
mpsuit <- m Suitability
psuit  -- when throwing, this sets eps and checks xhair validity
  ItemFull -> (Int, [Time]) -> Bool
psuitFun <- case Suitability
mpsuit of
    SuitsEverything -> (ItemFull -> (Int, [Time]) -> Bool)
-> m (ItemFull -> (Int, [Time]) -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ItemFull -> (Int, [Time]) -> Bool)
 -> m (ItemFull -> (Int, [Time]) -> Bool))
-> (ItemFull -> (Int, [Time]) -> Bool)
-> m (ItemFull -> (Int, [Time]) -> Bool)
forall a b. (a -> b) -> a -> b
$ \_ _ -> Bool
True
    SuitsSomething f :: ItemFull -> (Int, [Time]) -> Bool
f -> (ItemFull -> (Int, [Time]) -> Bool)
-> m (ItemFull -> (Int, [Time]) -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ItemFull -> (Int, [Time]) -> Bool
f  -- When throwing, this function takes
                                  -- missile range into accout.
  -- 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.
  SingleItemSlots
lSlots <- 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
    _ -> 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 getResult :: Either K.KM SlotChar -> [ItemId]
                -> ( Either Text ([ItemId], ItemBag, SingleItemSlots)
                   , (ItemDialogMode, Either K.KM SlotChar) )
      getResult :: Either KM SlotChar
-> [ItemId]
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
    (ItemDialogMode, Either KM SlotChar))
getResult ekm :: Either KM SlotChar
ekm iids :: [ItemId]
iids = (([ItemId], ItemBag, SingleItemSlots)
-> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. b -> Either a b
Right ([ItemId]
iids, ItemBag
bagAll, SingleItemSlots
bagItemSlotsAll), (ItemDialogMode
cCur, Either KM SlotChar
ekm))
      filterP :: ItemId -> (Int, [Time]) -> Bool
filterP iid :: ItemId
iid = ItemFull -> (Int, [Time]) -> Bool
psuitFun (ItemId -> ItemFull
itemToF ItemId
iid)
      bagAllSuit :: ItemBag
bagAllSuit = (ItemId -> (Int, [Time]) -> Bool) -> ItemBag -> ItemBag
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey ItemId -> (Int, [Time]) -> 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, (Int, [Time]))] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, (Int, [Time]))] -> ItemBag)
-> [(ItemId, (Int, [Time]))] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, (Int, [Time])))
-> [ItemId] -> [(ItemId, (Int, [Time]))]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
bagAll ItemBag -> ItemId -> (Int, [Time])
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, (Int, [Time]))] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, (Int, [Time]))] -> ItemBag)
-> [(ItemId, (Int, [Time]))] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, (Int, [Time])))
-> [ItemId] -> [(ItemId, (Int, [Time]))]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
bagAllSuit ItemBag -> ItemId -> (Int, [Time])
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)
  (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
actorMaxSk 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
actorMaxSk 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 _ = Bool
True
      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, Bool -> Either Text KM -> DefItemKey m
changeContainerDef Bool
True (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)
        , (Char -> KM
K.mkKP '/', Bool -> Either Text KM -> DefItemKey m
changeContainerDef Bool
True (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 "")
        , let km :: KM
km = Char -> KM
K.mkChar '?'
          in (KM
km, Bool -> Either Text KM -> DefItemKey m
changeContainerDef Bool
False (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)
        , (Char -> KM
K.mkKP '?', Bool -> Either Text KM -> DefItemKey m
changeContainerDef Bool
False (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 "")
        , let km :: KM
km = Char -> KM
K.mkChar '+'
          in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
    -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction = \_ -> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest
                               (ItemDialogState
 -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
       (ItemDialogMode, Either KM SlotChar)))
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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)
        , (Char -> KM
K.mkKP '*', 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 "")
        , let km :: KM
km = KM -> HumanCmd -> KM
revCmd (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier Key
K.Tab) HumanCmd
MemberCycle
          in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
    -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 = 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction = \_ -> do
               MError
err <- Bool -> m MError
forall (m :: * -> *). MonadClientUI m => Bool -> m MError
memberCycle Bool
False
               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) ()
               (cCurUpd :: ItemDialogMode
cCurUpd, cRestUpd :: [ItemDialogMode]
cRestUpd) <- ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader ItemDialogMode
cCur [ItemDialogMode]
cRest
               Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
recCall Int
numPrefix ItemDialogMode
cCurUpd [ItemDialogMode]
cRestUpd ItemDialogState
itemDialogState
           })
        , let km :: KM
km = KM -> HumanCmd -> KM
revCmd (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier Key
K.BackTab) HumanCmd
MemberBack
          in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
    -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 = 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction = \_ -> do
               MError
err <- Bool -> m MError
forall (m :: * -> *). MonadClientUI m => Bool -> m MError
memberBack Bool
False
               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) ()
               (cCurUpd :: ItemDialogMode
cCurUpd, cRestUpd :: [ItemDialogMode]
cRestUpd) <- ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader ItemDialogMode
cCur [ItemDialogMode]
cRest
               Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
recCall Int
numPrefix ItemDialogMode
cCurUpd [ItemDialogMode]
cRestUpd ItemDialogState
itemDialogState
           })
        , (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier Key
K.LeftButtonRelease, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
    -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction = \ekm :: Either KM SlotChar
ekm -> do
               MError
merror <- m MError
forall (m :: * -> *). MonadClientUI m => m MError
pickLeaderWithPointer
               case MError
merror of
                 Nothing -> do
                   (cCurUpd :: ItemDialogMode
cCurUpd, cRestUpd :: [ItemDialogMode]
cRestUpd) <- ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader ItemDialogMode
cCur [ItemDialogMode]
cRest
                   Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
recCall Int
numPrefix ItemDialogMode
cCurUpd [ItemDialogMode]
cRestUpd ItemDialogState
itemDialogState
                 Just{} -> (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left "not a teammate", (ItemDialogMode
cCur, Either KM SlotChar
ekm))
                             -- don't inspect the error, it's expected
           })
        , (KM
K.escKM, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
    -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction = \ekm :: Either KM SlotChar
ekm -> (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left "never mind", (ItemDialogMode
cCur, Either KM SlotChar
ekm))
           })
        ]
        [(KM, DefItemKey m)]
-> [(KM, DefItemKey m)] -> [(KM, DefItemKey m)]
forall a. [a] -> [a] -> [a]
++ [(KM, DefItemKey m)]
numberPrefixes
      changeContainerDef :: Bool -> Either Text KM -> DefItemKey m
changeContainerDef forward :: Bool
forward defLabel :: Either Text KM
defLabel = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
    -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
        { Either Text KM
defLabel :: Either Text KM
defLabel :: Either Text KM
defLabel
        , defCond :: Bool
defCond = Bool
True  -- even if single screen, just reset it
        , defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction = \_ -> do
            let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk
                mcCur :: [ItemDialogMode]
mcCur = (ItemDialogMode -> Bool) -> [ItemDialogMode] -> [ItemDialogMode]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemDialogMode -> [ItemDialogMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ItemDialogMode]
cLegal) [ItemDialogMode
cCur]
                (cCurAfterCalm :: ItemDialogMode
cCurAfterCalm, cRestAfterCalm :: [ItemDialogMode]
cRestAfterCalm) =
                  if Bool
forward
                  then case [ItemDialogMode]
cRest [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode]
mcCur of
                    c1 :: ItemDialogMode
c1@(MStore CSha) : c2 :: ItemDialogMode
c2 : rest :: [ItemDialogMode]
rest | Bool -> Bool
not Bool
calmE ->
                      (ItemDialogMode
c2, ItemDialogMode
c1 ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
rest)
                    [MStore CSha] | Bool -> Bool
not Bool
calmE -> 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
                    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
                  else case [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse ([ItemDialogMode] -> [ItemDialogMode])
-> [ItemDialogMode] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ [ItemDialogMode]
mcCur [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode]
cRest of
                    c1 :: ItemDialogMode
c1@(MStore CSha) : c2 :: ItemDialogMode
c2 : rest :: [ItemDialogMode]
rest | Bool -> Bool
not Bool
calmE ->
                      (ItemDialogMode
c2, [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse ([ItemDialogMode] -> [ItemDialogMode])
-> [ItemDialogMode] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ ItemDialogMode
c1 ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
rest)
                    [MStore CSha] | Bool -> Bool
not Bool
calmE -> 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
                    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
            Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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 ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction = \ekm :: Either KM SlotChar
ekm ->
            let eslots :: [ItemId]
eslots = SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
multipleSlots
            in (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Either Text ([ItemId], ItemBag, SingleItemSlots),
  (ItemDialogMode, Either KM SlotChar))
 -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
       (ItemDialogMode, Either KM SlotChar)))
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
    (ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ Either KM SlotChar
-> [ItemId]
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
    (ItemDialogMode, Either KM SlotChar))
getResult Either KM SlotChar
ekm [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 ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction = \_ ->
               Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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 ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall a. HasCallStack => String -> a
error (String
 -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
       (ItemDialogMode, Either KM SlotChar)))
-> String
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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 ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Either Text ([ItemId], ItemBag, SingleItemSlots),
  (ItemDialogMode, Either KM SlotChar))
 -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
       (ItemDialogMode, Either KM SlotChar)))
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
    (ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$! Either KM SlotChar
-> [ItemId]
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
    (ItemDialogMode, Either KM SlotChar))
getResult (SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
slot) [ItemId
iid]
        }
  case ItemDialogMode
cCur of
    MSkills -> do
      OKX
io <- ActorId -> m OKX
forall (m :: * -> *). MonadClientRead m => ActorId -> m OKX
skillsOverlay ActorId
leader
      let slotLabels :: [Either [KM] SlotChar]
slotLabels = ((Either [KM] SlotChar, (Int, Int, Int)) -> Either [KM] SlotChar)
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> [a] -> [b]
map (Either [KM] SlotChar, (Int, Int, Int)) -> Either [KM] SlotChar
forall a b. (a, b) -> a
fst ([(Either [KM] SlotChar, (Int, Int, Int))]
 -> [Either [KM] SlotChar])
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> a -> b
$ OKX -> [(Either [KM] SlotChar, (Int, Int, Int))]
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 ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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
                in (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left "skills", (ItemDialogMode
MSkills, SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
slot))
            }
      [(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
runDefItemKey [(KM, DefItemKey m)]
keyDefs DefItemKey m
skillsDef OKX
io [KM]
slotKeys Text
promptChosen ItemDialogMode
cCur
    MPlaces -> do
      OKX
io <- m OKX
forall (m :: * -> *). MonadClientRead m => m OKX
placesOverlay
      let slotLabels :: [Either [KM] SlotChar]
slotLabels = ((Either [KM] SlotChar, (Int, Int, Int)) -> Either [KM] SlotChar)
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> [a] -> [b]
map (Either [KM] SlotChar, (Int, Int, Int)) -> Either [KM] SlotChar
forall a b. (a, b) -> a
fst ([(Either [KM] SlotChar, (Int, Int, Int))]
 -> [Either [KM] SlotChar])
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> a -> b
$ OKX -> [(Either [KM] SlotChar, (Int, Int, Int))]
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
          placesDef :: DefItemKey m
          placesDef :: DefItemKey m
placesDef = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
    -> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
          (ItemDialogMode, Either KM SlotChar)))
-> 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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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
                in (Either Text ([ItemId], ItemBag, SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left "places", (ItemDialogMode
MPlaces, SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
slot))
            }
      [(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
runDefItemKey [(KM, DefItemKey m)]
keyDefs DefItemKey m
placesDef OKX
io [KM]
slotKeys Text
promptChosen ItemDialogMode
cCur
    _ -> do
      OKX
io <- SingleItemSlots -> LevelId -> ItemBag -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
SingleItemSlots -> LevelId -> ItemBag -> m OKX
itemOverlay SingleItemSlots
lSlots (Actor -> LevelId
blid Actor
body) ItemBag
bagFiltered
      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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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

legalWithUpdatedLeader :: MonadClientUI m
                       => ItemDialogMode
                       -> [ItemDialogMode]
                       -> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader :: ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader cCur :: ItemDialogMode
cCur cRest :: [ItemDialogMode]
cRest = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  let newLegal :: [ItemDialogMode]
newLegal = ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest  -- not updated in any way yet
  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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      legalAfterCalm :: (ItemDialogMode, [ItemDialogMode])
legalAfterCalm = case [ItemDialogMode]
newLegal of
        c1 :: ItemDialogMode
c1@(MStore CSha) : c2 :: ItemDialogMode
c2 : rest :: [ItemDialogMode]
rest | Bool -> Bool
not Bool
calmE -> (ItemDialogMode
c2, ItemDialogMode
c1 ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
rest)
        [MStore CSha] | Bool -> Bool
not Bool
calmE -> (CStore -> ItemDialogMode
MStore CStore
CGround, [ItemDialogMode]
newLegal)
        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, [ItemDialogMode]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemDialogMode
cCur, [ItemDialogMode]
cRest)
  (ItemDialogMode, [ItemDialogMode])
-> m (ItemDialogMode, [ItemDialogMode])
forall (m :: * -> *) a. Monad m => a -> m a
return (ItemDialogMode, [ItemDialogMode])
legalAfterCalm

-- We don't create keys from slots in @okx@, so they have to be
-- exolicitly given in @slotKeys@.
runDefItemKey :: MonadClientUI m
              => [(K.KM, DefItemKey m)]
              -> DefItemKey m
              -> OKX
              -> [K.KM]
              -> Text
              -> ItemDialogMode
              -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)
                   , (ItemDialogMode, Either K.KM SlotChar) )
runDefItemKey :: [(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
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
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 (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 :: * -> *).
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 ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction DefItemKey m
keyDef Either KM SlotChar
ekm
      Nothing -> DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction DefItemKey m
lettersDef Either KM SlotChar
ekm  -- pressed; with current prefix
    Right _slot :: SlotChar
_slot -> DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
defAction DefItemKey m
lettersDef Either KM SlotChar
ekm  -- selected; with the given prefix