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

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.EffectDescription
import           Game.LambdaHack.Client.UI.Frame
import           Game.LambdaHack.Client.UI.HandleHelperM
import           Game.LambdaHack.Client.UI.HumanCmd
import           Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.MonadClientUI
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.MsgM
import           Game.LambdaHack.Client.UI.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.ClientOptions
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.PlaceKind as PK
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.Defs

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

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

accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag ActorId
leader State
s (MStore 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 ActorId
leader State
s ItemDialogMode
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 ActorId
leader State
s ItemDialogMode
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 ActorId
_ State
_ ItemDialogMode
MSkills = ItemBag
forall k a. EnumMap k a
EM.empty
accessModeBag ActorId
_ State
s MLore{} = (Item -> ItemQuant) -> EnumMap ItemId Item -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (ItemQuant -> Item -> ItemQuant
forall a b. a -> b -> a
const ItemQuant
quantSingle) (EnumMap ItemId Item -> ItemBag) -> EnumMap ItemId Item -> ItemBag
forall a b. (a -> b) -> a -> b
$ State -> EnumMap ItemId Item
sitemD State
s
accessModeBag ActorId
_ State
_ ItemDialogMode
MPlaces = ItemBag
forall k a. EnumMap k a
EM.empty
accessModeBag ActorId
_ State
_ ItemDialogMode
MModes = ItemBag
forall k a. EnumMap k a
EM.empty

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

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

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

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

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

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

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

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

keyOfEKM :: Int -> KeyOrSlot -> Maybe K.KM
keyOfEKM :: Int -> KeyOrSlot -> Maybe KM
keyOfEKM Int
_ (Left 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
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
kms
keyOfEKM Int
numPrefix (Right SlotChar{Char
Int
slotChar :: SlotChar -> Char
slotChar :: Char
slotPrefix :: Int
slotPrefix :: SlotChar -> Int
..}) | 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 Int
_ KeyOrSlot
_ = Maybe KM
forall a. Maybe a
Nothing

-- We don't create keys from slots in @okx@, so they have to be
-- exolicitly given in @slotKeys@.
runDefItemKey :: MonadClientUI m
              => ActorId
              -> SingleItemSlots
              -> ItemBag
              -> [(K.KM, DefItemKey m)]
              -> DefItemKey m
              -> OKX
              -> [K.KM]
              -> Text
              -> ItemDialogMode
              -> m (Either Text ResultItemDialogMode)
runDefItemKey :: ActorId
-> SingleItemSlots
-> ItemBag
-> [(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
runDefItemKey ActorId
leader SingleItemSlots
lSlots ItemBag
bag [(KM, DefItemKey m)]
keyDefs DefItemKey m
lettersDef OKX
okx [KM]
slotKeys Text
prompt 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 a
s = a
"[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"]"
      ([Text]
keyLabelsRaw, [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] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapB ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
keyLabels
        -- switch to Data.Containers.ListUtils.nubOrd when we drop GHC 8.4.4
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
<+> Text
choice
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  KeyOrSlot
ekm <- do
    Slideshow
sli <- 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
- Int
2) [KM]
keys OKX
okx
    (KeyOrSlot -> m OKX)
-> String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
(KeyOrSlot -> m OKX)
-> String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreenWithRightPane
      (ActorId
-> SingleItemSlots
-> ItemBag
-> ItemDialogMode
-> KeyOrSlot
-> m OKX
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> SingleItemSlots
-> ItemBag
-> ItemDialogMode
-> KeyOrSlot
-> m OKX
inventoryInRightPane ActorId
leader SingleItemSlots
lSlots ItemBag
bag ItemDialogMode
cCur)
      (ItemDialogMode -> String
forall a. Show a => a -> String
show ItemDialogMode
cCur) ColorMode
ColorFull Bool
False Slideshow
sli [KM]
itemKeys
  case KeyOrSlot
ekm of
    Left 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 DefItemKey m
keyDef -> DefItemKey m -> KeyOrSlot -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m -> KeyOrSlot -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
keyDef KeyOrSlot
ekm
      Maybe (DefItemKey m)
Nothing -> DefItemKey m -> KeyOrSlot -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m -> KeyOrSlot -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
lettersDef KeyOrSlot
ekm  -- pressed; with current prefix
    Right SlotChar
_slot -> DefItemKey m -> KeyOrSlot -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m -> KeyOrSlot -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
lettersDef KeyOrSlot
ekm  -- selected; with the given prefix

inventoryInRightPane :: MonadClientUI m
                     => ActorId -> SingleItemSlots -> ItemBag -> ItemDialogMode
                     -> KeyOrSlot
                     -> m OKX
inventoryInRightPane :: ActorId
-> SingleItemSlots
-> ItemBag
-> ItemDialogMode
-> KeyOrSlot
-> m OKX
inventoryInRightPane ActorId
leader SingleItemSlots
lSlots ItemBag
bag ItemDialogMode
c KeyOrSlot
ekm = case KeyOrSlot
ekm of
  Left{} -> OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return OKX
emptyOKX
  Right SlotChar
slot -> do
    CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
    FontSetup{DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
    let -- Lower width, to permit extra vertical space at the start,
        -- because gameover menu prompts are sometimes wide and/or long.
       width :: Int
width = Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
       slotIndex :: Int
slotIndex = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error String
"illegal slot") (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ SlotChar -> [SlotChar] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex SlotChar
slot [SlotChar]
allSlots
    case ItemDialogMode
c of
      ItemDialogMode
_ | DisplayFont -> Bool
isSquareFont DisplayFont
propFont -> OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return OKX
emptyOKX
      ItemDialogMode
MSkills -> do
        (Text
prompt, AttrString
attrString) <- ActorId -> Int -> m (Text, AttrString)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Int -> m (Text, AttrString)
skillCloseUp ActorId
leader Int
slotIndex
        let promptAS :: AttrString
promptAS | Text -> Bool
T.null Text
prompt = []
                     | Bool
otherwise = Color -> Text -> AttrString
textFgToAS Color
Color.Brown (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
            ov :: EnumMap DisplayFont Overlay
ov = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
                                       ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
                                       (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrString
promptAS AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
attrString
        OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov, [])
      ItemDialogMode
MPlaces -> do
        COps{ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
        ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
        -- This is very slow when many places are exposed,
        -- because this is computed once per place menu keypress.
        -- Fortunately, the mode after entering a place and with pressing
        -- up and down arrow keys is not quadratic, so should be used instead,
        -- particularly with @sexposePlaces@.
        [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places <- (State
 -> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State
  -> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
 -> m [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> (State
    -> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs
                              (EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
 -> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> (State
    -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> State
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentData PlaceKind
-> Bool
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState ContentData PlaceKind
coplace (ClientOptions -> Bool
sexposePlaces ClientOptions
soptions)
        (Text
prompt, [(DisplayFont, [Text])]
blurbs) <-
          [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Bool -> Int -> m (Text, [(DisplayFont, [Text])])
forall (m :: * -> *).
MonadClientUI m =>
[(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Bool -> Int -> m (Text, [(DisplayFont, [Text])])
placeCloseUp [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places (ClientOptions -> Bool
sexposePlaces ClientOptions
soptions) Int
slotIndex
        let promptAS :: AttrString
promptAS | Text -> Bool
T.null Text
prompt = []
                     | Bool
otherwise = Color -> Text -> AttrString
textFgToAS Color
Color.Brown (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
            ov :: EnumMap DisplayFont Overlay
ov = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
                 ([(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay)
-> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map (([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([AttrString] -> [AttrLine])
 -> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> ([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString])
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ (AttrString -> [AttrLine]) -> [AttrString] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width))
                 ([(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])])
-> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> a -> b
$ (DisplayFont
propFont, [AttrString
promptAS]) (DisplayFont, [AttrString])
-> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrString])]
forall a. a -> [a] -> [a]
: ((DisplayFont, [Text]) -> (DisplayFont, [AttrString]))
-> [(DisplayFont, [Text])] -> [(DisplayFont, [AttrString])]
forall a b. (a -> b) -> [a] -> [b]
map (([Text] -> [AttrString])
-> (DisplayFont, [Text]) -> (DisplayFont, [AttrString])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Text] -> [AttrString])
 -> (DisplayFont, [Text]) -> (DisplayFont, [AttrString]))
-> ([Text] -> [AttrString])
-> (DisplayFont, [Text])
-> (DisplayFont, [AttrString])
forall a b. (a -> b) -> a -> b
$ (Text -> AttrString) -> [Text] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrString
textToAS) [(DisplayFont, [Text])]
blurbs
        OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov, [])
      ItemDialogMode
MModes -> OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return OKX
emptyOKX
        -- modes cover the right part of screen, so let's keep it empty
      ItemDialogMode
_ -> do
        let ix0 :: Int
ix0 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ SlotChar -> String
forall a. Show a => a -> String
show SlotChar
slot)
                            (SlotChar -> [SlotChar] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex SlotChar
slot ([SlotChar] -> Maybe Int) -> [SlotChar] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [SlotChar]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys SingleItemSlots
lSlots)
            promptFun :: p -> p -> p -> p
promptFun p
_iid p
_itemFull p
_k = p
""
              -- TODO, e.g., if the party still owns any copies, if the actor
              -- was ever killed by us or killed ours, etc.
              -- This can be the same prompt or longer than what entering
              -- the item screen shows.
        -- Mono font used, because lots of numbers in these blurbs
        -- and because some prop fonts wider than mono (e.g., in the
        -- dejavuBold font set).
        -- A side effect is a larger space between the symbol and description,
        -- so this is not a bug, not a double space, not worth focusing on.
        DisplayFont
-> Int
-> Bool
-> ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m OKX
forall (m :: * -> *).
MonadClientUI m =>
DisplayFont
-> Int
-> Bool
-> ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m OKX
okxItemLorePointedAt
          DisplayFont
monoFont (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Bool
True ItemBag
bag Int
0 ItemId -> ItemFull -> Int -> Text
forall p p p p. IsString p => p -> p -> p -> p
promptFun Int
ix0 SingleItemSlots
lSlots

skillCloseUp :: MonadClientUI m => ActorId -> Int -> m (Text, AttrString)
skillCloseUp :: ActorId -> Int -> m (Text, AttrString)
skillCloseUp ActorId
leader Int
slotIndex = do
  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
  ActorUI
bUI <- (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
actorCurAndMaxSk <- (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 skill :: Skill
skill = [Skill]
skillSlots [Skill] -> Int -> Skill
forall a. [a] -> Int -> a
!! Int
slotIndex
      valueText :: Text
valueText = Skill -> Actor -> Int -> Text
skillToDecorator Skill
skill Actor
b
                  (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
skill Skills
actorCurAndMaxSk
      prompt :: Text
prompt = [Part] -> Text
makeSentence
        [ Part -> Part -> Part
MU.WownW (ActorUI -> Part
partActor ActorUI
bUI) (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Skill -> Text
skillName Skill
skill)
        , Part
"is", Text -> Part
MU.Text Text
valueText ]
      attrString :: AttrString
attrString = Text -> AttrString
textToAS (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Skill -> Text
skillDesc Skill
skill
  (Text, AttrString) -> m (Text, AttrString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
prompt, AttrString
attrString)

placeCloseUp :: MonadClientUI m
             => [(ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))]
             -> Bool
             -> Int
             -> m (Text, [(DisplayFont, [Text])])
placeCloseUp :: [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Bool -> Int -> m (Text, [(DisplayFont, [Text])])
placeCloseUp [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places Bool
sexposePlaces Int
slotIndex = do
  COps{ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let (ContentId PlaceKind
pk, (EnumSet LevelId
es, Int
ne, Int
na, Int
_)) = [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Int -> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
forall a. [a] -> Int -> a
!! Int
slotIndex
      pkind :: PlaceKind
pkind = ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk
      prompt :: Text
prompt = [Part] -> Text
makeSentence [Part
"you remember", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ PlaceKind -> Text
PK.pname PlaceKind
pkind]
      freqsText :: Text
freqsText = Text
"Frequencies:" Text -> Text -> Text
<+> Text -> [Text] -> Text
T.intercalate Text
" "
        (((GroupName PlaceKind, Int) -> Text)
-> [(GroupName PlaceKind, Int)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(GroupName PlaceKind
grp, Int
n) -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GroupName PlaceKind -> Text
forall c. GroupName c -> Text
displayGroupName GroupName PlaceKind
grp
                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
         ([(GroupName PlaceKind, Int)] -> [Text])
-> [(GroupName PlaceKind, Int)] -> [Text]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
PK.pfreq PlaceKind
pkind)
      onLevels :: [Text]
onLevels | EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es = []
               | Bool
otherwise = [[Part] -> Text
makeSentence
                               [ Part
"Appears on"
                               , Int -> Part -> Part
MU.CarWs (EnumSet LevelId -> Int
forall k. EnumSet k -> Int
ES.size EnumSet LevelId
es) Part
"level" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Part
":"
                               , [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ (Int -> Part) -> [Int] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Part
MU.Car ([Int] -> [Part]) -> [Int] -> [Part]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort
                                 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (LevelId -> Int) -> [LevelId] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> (LevelId -> Int) -> LevelId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LevelId -> Int
forall a. Enum a => a -> Int
fromEnum) ([LevelId] -> [Int]) -> [LevelId] -> [Int]
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
es ]]
      placeParts :: [Part]
placeParts = [Part
"it has" | Int
ne Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
na Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Int -> Part -> Part
MU.CarWs Int
ne Part
"entrance" | Int
ne Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part
"and" | Int
ne Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
na Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Int -> Part -> Part
MU.CarWs Int
na Part
"surrounding" | Int
na Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
      partsSentence :: [Text]
partsSentence | [Part] -> Bool
forall a. [a] -> Bool
null [Part]
placeParts = []
                    | Bool
otherwise = [[Part] -> Text
makeSentence [Part]
placeParts, Text
"\n"]
      -- Ideally, place layout would be in SquareFont and the rest
      -- in PropFont, but this is mostly a debug screen, so KISS.
      blurbs :: [(DisplayFont, [Text])]
blurbs = [(DisplayFont
propFont, [Text]
partsSentence)]
               [(DisplayFont, [Text])]
-> [(DisplayFont, [Text])] -> [(DisplayFont, [Text])]
forall a. [a] -> [a] -> [a]
++ [(DisplayFont
monoFont, [Text
freqsText, Text
"\n"]) | Bool
sexposePlaces]
               [(DisplayFont, [Text])]
-> [(DisplayFont, [Text])] -> [(DisplayFont, [Text])]
forall a. [a] -> [a] -> [a]
++ [(DisplayFont
squareFont, PlaceKind -> [Text]
PK.ptopLeft PlaceKind
pkind [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"\n"]) | Bool
sexposePlaces]
               [(DisplayFont, [Text])]
-> [(DisplayFont, [Text])] -> [(DisplayFont, [Text])]
forall a. [a] -> [a] -> [a]
++ [(DisplayFont
propFont, [Text]
onLevels)]
  (Text, [(DisplayFont, [Text])])
-> m (Text, [(DisplayFont, [Text])])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
prompt, [(DisplayFont, [Text])]
blurbs)