-- | UI of inventory management.
module Game.LambdaHack.Client.UI.InventoryM
  ( Suitability(..), ResultItemDialogMode(..)
  , getFull, getGroupItem, getStoreItem
  , skillCloseUp, placeCloseUp, factionCloseUp
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , ItemDialogState(..), accessModeBag, storeItemPrompt, getItem
  , DefItemKey(..), transition
  , runDefMessage, runDefAction, runDefSkills, skillsInRightPane
  , runDefPlaces, placesInRightPane
  , runDefFactions, factionsInRightPane
  , runDefModes, runDefInventory
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Either
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import           Data.Function
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.HandleHelperM
import           Game.LambdaHack.Client.UI.HumanCmd
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 qualified Game.LambdaHack.Common.Faction as Faction
import           Game.LambdaHack.Common.Item
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.FactionKind as FK
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
$cshowsPrec :: Int -> ItemDialogState -> ShowS
showsPrec :: Int -> ItemDialogState -> ShowS
$cshow :: ItemDialogState -> String
show :: ItemDialogState -> String
$cshowList :: [ItemDialogState] -> ShowS
showList :: [ItemDialogState] -> ShowS
Show, ItemDialogState -> ItemDialogState -> Bool
(ItemDialogState -> ItemDialogState -> Bool)
-> (ItemDialogState -> ItemDialogState -> Bool)
-> Eq ItemDialogState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ItemDialogState -> ItemDialogState -> Bool
== :: ItemDialogState -> ItemDialogState -> Bool
$c/= :: ItemDialogState -> ItemDialogState -> Bool
/= :: ItemDialogState -> ItemDialogState -> Bool
Eq)

data ResultItemDialogMode =
    RStore CStore [ItemId]
  | ROwned ItemId
  | RLore SLore MenuSlot [(ItemId, ItemQuant)]
  | RSkills MenuSlot
  | RPlaces MenuSlot
  | RFactions MenuSlot
  | RModes MenuSlot
  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
$cshowsPrec :: Int -> ResultItemDialogMode -> ShowS
showsPrec :: Int -> ResultItemDialogMode -> ShowS
$cshow :: ResultItemDialogMode -> String
show :: ResultItemDialogMode -> String
$cshowList :: [ResultItemDialogMode] -> ShowS
showList :: [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
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
leader State
s (MLore SLore
SBody) = 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
_ 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
MFactions = ItemBag
forall k a. EnumMap k a
EM.empty
accessModeBag ActorId
_ State
_ ItemDialogMode
MModes = ItemBag
forall k a. EnumMap k a
EM.empty

-- | Let a human player choose any item from a given group.
-- Note that this does not guarantee the chosen item belongs to the group,
-- as the player can override the choice.
-- Used e.g., for applying and projecting.
getGroupItem :: MonadClientUI m
             => 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 :: forall (m :: * -> *).
MonadClientUI m =>
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
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  mstash <- getsState $ \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
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
  soc <- getFull leader 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)
                 stores True False
  case soc of
    Left Text
err -> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall a. a -> m a
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 a. a -> m a
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 :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> ItemDialogMode -> m (Either Text ResultItemDialogMode)
getStoreItem ActorId
leader ItemDialogMode
cInitial = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  let -- No @COrgan@, because triggerable organs are rare and,
      -- if really needed, accessible directly from the trigger menu.
      itemCs = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore
CStash, CStore
CEqp, CStore
CGround]
      -- This should match, including order, the items in standardKeysAndMouse
      -- marked with CmdDashboard up to @MSkills@.
      leaderCs = [ItemDialogMode]
itemCs [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
MOwned, SLore -> ItemDialogMode
MLore SLore
SBody, ItemDialogMode
MSkills]
      -- No @SBody@, because repeated in other lores and included elsewhere.
      itemLoreCs = (SLore -> ItemDialogMode) -> [SLore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map SLore -> ItemDialogMode
MLore [SLore
forall a. Bounded a => a
minBound..SLore
SEmbed]
      -- This should match, including order, the items in standardKeysAndMouse
      -- marked with CmdDashboard past @MSkills@ and up to @MModes@.
      loreCs = [ItemDialogMode]
itemLoreCs [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
MPlaces, ItemDialogMode
MFactions, ItemDialogMode
MModes]
  let !_A1 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert ([ItemDialogMode] -> Bool
forall a. [a] -> Bool
null ([ItemDialogMode]
leaderCs [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [ItemDialogMode]
loreCs)) ()
      !_A2 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert ([ItemDialogMode] -> [ItemDialogMode]
forall a. Ord a => [a] -> [a]
sort ([ItemDialogMode]
leaderCs [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode]
loreCs [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [CStore -> ItemDialogMode
MStore CStore
COrgan])
                     [ItemDialogMode] -> [ItemDialogMode] -> Bool
forall a. Eq a => a -> a -> Bool
== (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore
forall a. Bounded a => a
minBound..CStore
forall a. Bounded a => a
maxBound]
                        [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
MOwned, ItemDialogMode
MSkills]
                        [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ (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
MFactions, ItemDialogMode
MModes]) ()
      allCs | ItemDialogMode
cInitial ItemDialogMode -> [ItemDialogMode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ItemDialogMode]
leaderCs = [ItemDialogMode]
leaderCs
            | ItemDialogMode
cInitial ItemDialogMode -> [ItemDialogMode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ItemDialogMode]
loreCs = [ItemDialogMode]
loreCs
            | Bool
otherwise = Bool -> [ItemDialogMode] -> [ItemDialogMode]
forall a. HasCallStack => Bool -> a -> a
assert (ItemDialogMode
cInitial ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== CStore -> ItemDialogMode
MStore CStore
COrgan) [ItemDialogMode]
leaderCs
                            -- werrd content, but let it be
      (pre, rest) = break (== cInitial) allCs
      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]
post [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode]
pre
      prompt = FactionId
-> Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
storeItemPrompt FactionId
side
  getItem leader (return SuitsEverything) prompt prompt cInitial remCs
          True 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 :: ContentData ItemKind
coitem :: COps -> 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 -> [] )
          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
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 HasCallStack => Text -> Text
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
SBody ->
      [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 ]
    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
MFactions ->
      [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 :: 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 -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric [CStore]
stores Bool
askWhenLone Bool
permitMulitple = do
  mpsuit <- m Suitability
psuit
  let 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.
  b <- getsState $ getActorBody leader
  getCStoreBag <- getsState $ \State
s CStore
cstore -> Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cstore State
s
  let 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 filter hasThisActor 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 a. a -> m a
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
      itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a. (State -> a) -> m a
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
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 -> 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
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)
          (modeFirst, modeRest) = breakStores firstStore
      res <- getItem leader psuit prompt promptGeneric modeFirst modeRest
                     askWhenLone permitMulitple
      case res of
        Left Text
t -> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a. a -> m a
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 a. a -> m a
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 :: 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
cCur [ItemDialogMode]
cRest Bool
askWhenLone
        Bool
permitMulitple = do
  accessCBag <- (State -> ItemDialogMode -> ItemBag)
-> m (ItemDialogMode -> ItemBag)
forall a. (State -> a) -> m a
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 = 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 = (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 (allAssocs, 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 a. a -> m a
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
-> 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
-> 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
                    ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
ISuitable

data DefItemKey m = DefItemKey
  { forall (m :: * -> *). DefItemKey m -> Either Text KM
defLabel  :: Either Text K.KM
  , forall (m :: * -> *). DefItemKey m -> Bool
defCond   :: Bool
  , forall (m :: * -> *).
DefItemKey m -> m (Either Text ResultItemDialogMode)
defAction :: ~(m (Either Text ResultItemDialogMode))
      -- this field may be expensive or undefined when @defCond@ is false
  }

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
           -> ItemDialogMode
           -> [ItemDialogMode]
           -> ItemDialogState
           -> m (Either Text ResultItemDialogMode)
transition :: forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> 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
           ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState = do
  let recCall :: ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall 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.
        mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
        -- When run inside a test, without mleader, assume leader not changed.
        let leader2 = ActorId -> Maybe ActorId -> ActorId
forall a. a -> Maybe a -> a
fromMaybe ActorId
leader Maybe ActorId
mleader
        transition leader2 psuit prompt promptGeneric permitMulitple
                   cCur2 cRest2 itemDialogState2
  actorCurAndMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
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
  body <- getsState $ getActorBody leader
  bodyUI <- getsSession $ getActorUI leader
  fact <- getsState $ (EM.! bfid body) . sfactionD
  hs <- partyAfterLeader leader
  revCmd <- revCmdMap
  promptChosen <- getsState $ \State
s -> case ItemDialogState
itemDialogState of
    ItemDialogState
ISuitable -> 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 -> 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 keyDefsCommon :: [(K.KM, DefItemKey m)]
      keyDefsCommon = ((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)
        [ 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)
        , 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
           { 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 :: m (Either Text ResultItemDialogMode)
defAction = do
               -- This is verbose even in aiming mode, displaying
               -- terrain description, but it's fine, mouse may do that.
               merror <- ActorId -> m MError
forall (m :: * -> *). MonadClientUI m => ActorId -> m MError
pickLeaderWithPointer ActorId
leader
               case merror of
                 MError
Nothing -> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
                 Just{} -> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a. a -> m a
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
           { 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 :: m (Either Text ResultItemDialogMode)
defAction = Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a. a -> m a
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"
           })
        ]
      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
                { 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 :: m (Either Text ResultItemDialogMode)
defAction = do
                    err <- ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycleLevel ActorId
leader Bool
False Direction
direction
                    let !_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (MError -> Bool
forall a. Maybe a -> Bool
isNothing MError
err Bool -> MError -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` MError
err) ()
                    recCall cCur cRest itemDialogState
                })
      changeContainerDef Direction
direction Either Text KM
defLabel =
        let (ItemDialogMode
cCurAfterCalm, [ItemDialogMode]
cRestAfterCalm) = Direction -> (ItemDialogMode, [ItemDialogMode])
nextContainers Direction
direction
        in 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 :: m (Either Text ResultItemDialogMode)
defAction = ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall ItemDialogMode
cCurAfterCalm [ItemDialogMode]
cRestAfterCalm ItemDialogState
itemDialogState
          }
      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
      banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
      maySwitchLeader MStore{} = Bool
True
      maySwitchLeader ItemDialogMode
MOwned = Bool
False
      maySwitchLeader ItemDialogMode
MSkills = Bool
True
      maySwitchLeader (MLore SLore
SBody) = Bool
True
      maySwitchLeader MLore{} = Bool
False
      maySwitchLeader ItemDialogMode
MPlaces = Bool
False
      maySwitchLeader ItemDialogMode
MFactions = Bool
False
      maySwitchLeader ItemDialogMode
MModes = Bool
False
      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
               { 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
banned Bool -> Bool -> Bool
|| [(ActorId, Actor, ActorUI)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor, ActorUI)]
hs)
               , defAction :: m (Either Text ResultItemDialogMode)
defAction = do
                   err <- ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycle ActorId
leader Bool
False Direction
direction
                   let !_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (MError -> Bool
forall a. Maybe a -> Bool
isNothing MError
err Bool -> MError -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` MError
err) ()
                   recCall cCur cRest itemDialogState
               })
  case cCur of
    ItemDialogMode
MSkills -> [(KM, DefItemKey m)]
-> Text -> ActorId -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> Text -> ActorId -> m (Either Text ResultItemDialogMode)
runDefSkills [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen ActorId
leader
    ItemDialogMode
MPlaces -> [(KM, DefItemKey m)]
-> Text -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> Text -> m (Either Text ResultItemDialogMode)
runDefPlaces [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen
    ItemDialogMode
MFactions -> [(KM, DefItemKey m)]
-> Text -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> Text -> m (Either Text ResultItemDialogMode)
runDefFactions [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen
    ItemDialogMode
MModes -> [(KM, DefItemKey m)]
-> Text -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> Text -> m (Either Text ResultItemDialogMode)
runDefModes [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen
    ItemDialogMode
_ -> do
      bagHuge <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
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
      itemToF <- getsState $ flip itemToFull
      mpsuit <- psuit  -- when throwing, this sets eps and checks xhair validity
      psuitFun <- case mpsuit of
        Suitability
SuitsEverything -> (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
-> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
forall a. a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CStore -> ItemFull -> ItemQuant -> Bool
f  -- When throwing, this function takes
                                      -- missile range into accout.
      ItemRoles itemRoles <- getsSession sroles
      let slore = ItemDialogMode -> SLore
loreFromMode ItemDialogMode
cCur
          itemRole = EnumMap SLore (EnumSet ItemId)
itemRoles EnumMap SLore (EnumSet ItemId) -> SLore -> EnumSet ItemId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
          bagAll = (ItemId -> ItemQuant -> Bool) -> ItemBag -> ItemBag
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey (\ItemId
iid ItemQuant
_ -> ItemId
iid ItemId -> EnumSet ItemId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet ItemId
itemRole) ItemBag
bagHuge
          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 = Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun Maybe CStore
mstore (ItemFull -> ItemQuant -> Bool)
-> (ItemId -> ItemFull) -> ItemId -> ItemQuant -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemId -> ItemFull
itemToF
          bagSuit = (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
          bagFiltered = case ItemDialogState
itemDialogState of
            ItemDialogState
ISuitable -> ItemBag
bagSuit
            ItemDialogState
IAll -> ItemBag
bagAll
          iids = (ItemId -> ItemFull)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
sortIids ItemId -> ItemFull
itemToF ([(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)])
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bagFiltered
          keyDefsExtra =
            [ let km :: KM
km = Char -> KM
K.mkChar Char
'+'
              in (KM
km, DefItemKey
               { defLabel :: Either Text KM
defLabel = KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km
               , defCond :: Bool
defCond = ItemBag
bagAll ItemBag -> ItemBag -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemBag
bagSuit
               , defAction :: m (Either Text ResultItemDialogMode)
defAction = ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall 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'
            ]
          useMultipleDef Either Text KM
defLabel = DefItemKey
            { Either Text KM
defLabel :: Either Text KM
defLabel :: Either Text KM
defLabel
            , defCond :: Bool
defCond = Bool
permitMulitple Bool -> Bool -> Bool
&& Bool -> Bool
not ([(ItemId, ItemQuant)] -> Bool
forall a. [a] -> Bool
null [(ItemId, ItemQuant)]
iids)
            , defAction :: m (Either Text ResultItemDialogMode)
defAction = case ItemDialogMode
cCur of
                MStore CStore
rstore -> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a. a -> m a
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] -> ResultItemDialogMode)
-> [ItemId] -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> ItemId)
-> [(ItemId, ItemQuant)] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst [(ItemId, ItemQuant)]
iids
                ItemDialogMode
_ -> String -> m (Either Text ResultItemDialogMode)
forall a. HasCallStack => String -> a
error String
"transition: multiple items not for MStore"
            }
          keyDefs = [(KM, DefItemKey m)]
keyDefsCommon [(KM, DefItemKey m)]
-> [(KM, DefItemKey m)] -> [(KM, DefItemKey m)]
forall a. [a] -> [a] -> [a]
++ ((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)]
keyDefsExtra
      runDefInventory keyDefs promptChosen leader cCur iids

runDefMessage :: MonadClientUI m
              => [(K.KM, DefItemKey m)]
              -> Text
              -> m ()
runDefMessage :: forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)] -> Text -> m ()
runDefMessage [(KM, DefItemKey m)]
keyDefs Text
prompt = do
  let 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
"]"
      keyLabelsRaw :: [Text]
keyLabelsRaw = [Either Text KM] -> [Text]
forall a b. [Either a b] -> [a]
lefts ([Either Text KM] -> [Text]) -> [Either Text KM] -> [Text]
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

runDefAction :: MonadClientUI m
             => [(K.KM, DefItemKey m)]
             -> (MenuSlot -> Either Text ResultItemDialogMode)
             -> KeyOrSlot
             -> m (Either Text ResultItemDialogMode)
runDefAction :: forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
runDefAction [(KM, DefItemKey m)]
keyDefs MenuSlot -> Either Text ResultItemDialogMode
slotDef KeyOrSlot
ekm = 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 -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
keyDef
    Maybe (DefItemKey m)
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 key:" String -> ShowS
forall v. Show v => String -> v -> String
`showFailure` KM -> String
K.showKM KM
km
  Right MenuSlot
slot -> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a. a -> m a
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
$! MenuSlot -> Either Text ResultItemDialogMode
slotDef MenuSlot
slot

runDefSkills :: MonadClientUI m
             => [(K.KM, DefItemKey m)] -> Text -> ActorId
             -> m (Either Text ResultItemDialogMode)
runDefSkills :: forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> Text -> ActorId -> m (Either Text ResultItemDialogMode)
runDefSkills [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen ActorId
leader = do
  CCUI{coscreen=ScreenContent{rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  runDefMessage keyDefsCommon promptChosen
  let itemKeys = ((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)]
keyDefsCommon
      keys = [Either Text KM] -> [KM]
forall a b. [Either a b] -> [b]
rights ([Either Text KM] -> [KM]) -> [Either Text KM] -> [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)]
keyDefsCommon
  okx <- skillsOverlay leader
  sli <- overlayToSlideshow (rheight - 2) keys okx
  ekm <- displayChoiceScreenWithDefItemKey
           (skillsInRightPane leader) sli itemKeys (show MSkills)
  runDefAction keyDefsCommon (Right . RSkills) ekm

skillsInRightPane :: MonadClientUI m => ActorId -> Int -> MenuSlot -> m OKX
skillsInRightPane :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Int -> MenuSlot -> m OKX
skillsInRightPane ActorId
leader Int
width MenuSlot
slot = do
  FontSetup{propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  (prompt, attrString) <- skillCloseUp leader slot
  let 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 = 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
  return (ov, [])

runDefPlaces :: MonadClientUI m
             => [(K.KM, DefItemKey m)] -> Text
             -> m (Either Text ResultItemDialogMode)
runDefPlaces :: forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> Text -> m (Either Text ResultItemDialogMode)
runDefPlaces [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen = do
  COps{coplace} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui
  soptions <- getsClient soptions
  places <- getsState $ EM.assocs
                      . placesFromState coplace (sexposePlaces soptions)
  runDefMessage keyDefsCommon promptChosen
  let itemKeys = ((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)]
keyDefsCommon
      keys = [Either Text KM] -> [KM]
forall a b. [Either a b] -> [b]
rights ([Either Text KM] -> [KM]) -> [Either Text KM] -> [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)]
keyDefsCommon
  okx <- placesOverlay
  sli <- overlayToSlideshow (rheight - 2) keys okx
  ekm <- displayChoiceScreenWithDefItemKey
           (placesInRightPane places) sli itemKeys (show MPlaces)
  runDefAction keyDefsCommon (Right . RPlaces) ekm

placesInRightPane :: MonadClientUI m
                  => [( ContentId PK.PlaceKind
                      , (ES.EnumSet LevelId, Int, Int, Int) )]
                  -> Int -> MenuSlot
                  -> m OKX
placesInRightPane :: forall (m :: * -> *).
MonadClientUI m =>
[(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Int -> MenuSlot -> m OKX
placesInRightPane [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places Int
width MenuSlot
slot = do
  FontSetup{propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  soptions <- getsClient soptions
  (prompt, blurbs) <- placeCloseUp places (sexposePlaces soptions) slot
  let 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"
      splitText = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
      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 b c d. (b -> c) -> (d, b) -> (d, c)
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 AttrString -> [AttrLine]
splitText)
           ([(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, [AttrString])]
blurbs
  return (ov, [])

runDefFactions :: MonadClientUI m
               => [(K.KM, DefItemKey m)] -> Text
               -> m (Either Text ResultItemDialogMode)
runDefFactions :: forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> Text -> m (Either Text ResultItemDialogMode)
runDefFactions [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen = do
  CCUI{coscreen=ScreenContent{rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  sroles <- getsSession sroles
  factions <- getsState $ factionsFromState sroles
  runDefMessage keyDefsCommon promptChosen
  let itemKeys = ((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)]
keyDefsCommon
      keys = [Either Text KM] -> [KM]
forall a b. [Either a b] -> [b]
rights ([Either Text KM] -> [KM]) -> [Either Text KM] -> [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)]
keyDefsCommon
  okx <- factionsOverlay
  sli <- overlayToSlideshow (rheight - 2) keys okx
  ekm <- displayChoiceScreenWithDefItemKey
           (factionsInRightPane factions)
           sli itemKeys (show MFactions)
  runDefAction keyDefsCommon (Right . RFactions) ekm

factionsInRightPane :: MonadClientUI m
                    => [(FactionId, Faction)]
                    -> Int -> MenuSlot
                    -> m OKX
factionsInRightPane :: forall (m :: * -> *).
MonadClientUI m =>
[(FactionId, Faction)] -> Int -> MenuSlot -> m OKX
factionsInRightPane [(FactionId, Faction)]
factions Int
width MenuSlot
slot = do
  FontSetup{propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  (prompt, blurbs) <- factionCloseUp factions slot
  let 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"
      splitText = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
      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 b c d. (b -> c) -> (d, b) -> (d, c)
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 AttrString -> [AttrLine]
splitText)
           ([(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, [AttrString])]
blurbs
  return (ov, [])

runDefModes :: MonadClientUI m
            => [(K.KM, DefItemKey m)] -> Text
            -> m (Either Text ResultItemDialogMode)
runDefModes :: forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> Text -> m (Either Text ResultItemDialogMode)
runDefModes [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen = do
  CCUI{coscreen=ScreenContent{rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  runDefMessage keyDefsCommon promptChosen
  let itemKeys = ((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)]
keyDefsCommon
      keys = [Either Text KM] -> [KM]
forall a b. [Either a b] -> [b]
rights ([Either Text KM] -> [KM]) -> [Either Text KM] -> [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)]
keyDefsCommon
  okx <- modesOverlay
  sli <- overlayToSlideshow (rheight - 2) keys okx
  -- Modes would cover the whole screen, so we don't display in right pane.
  -- But we display and highlight menu bullets.
  ekm <- displayChoiceScreenWithDefItemKey
           (\Int
_ MenuSlot
_ -> OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return OKX
emptyOKX) sli itemKeys (show MModes)
  runDefAction keyDefsCommon (Right . RModes) ekm

runDefInventory :: MonadClientUI m
                => [(K.KM, DefItemKey m)]
                -> Text
                -> ActorId
                -> ItemDialogMode
                -> [(ItemId, ItemQuant)]
                -> m (Either Text ResultItemDialogMode)
runDefInventory :: forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> Text
-> ActorId
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> m (Either Text ResultItemDialogMode)
runDefInventory [(KM, DefItemKey m)]
keyDefs Text
promptChosen ActorId
leader ItemDialogMode
dmode [(ItemId, ItemQuant)]
iids = do
  CCUI{coscreen=ScreenContent{rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
  let meleeSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorCurAndMaxSk
      slotDef :: MenuSlot -> Either Text ResultItemDialogMode
      slotDef MenuSlot
slot =
        let iid :: ItemId
iid = (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst ((ItemId, ItemQuant) -> ItemId) -> (ItemId, ItemQuant) -> ItemId
forall a b. (a -> b) -> a -> b
$ [(ItemId, ItemQuant)]
iids [(ItemId, ItemQuant)] -> Int -> (ItemId, ItemQuant)
forall a. HasCallStack => [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
        in 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
dmode of
          MStore CStore
rstore -> CStore -> [ItemId] -> ResultItemDialogMode
RStore CStore
rstore [ItemId
iid]
          ItemDialogMode
MOwned -> ItemId -> ResultItemDialogMode
ROwned ItemId
iid
          MLore SLore
rlore -> SLore -> MenuSlot -> [(ItemId, ItemQuant)] -> ResultItemDialogMode
RLore SLore
rlore MenuSlot
slot [(ItemId, ItemQuant)]
iids
          ItemDialogMode
_ -> 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
dmode
      promptFun p
_iid p
_itemFull p
_k = a
""
        -- 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.
  runDefMessage keyDefs promptChosen
  let itemKeys = ((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
      keys = [Either Text KM] -> [KM]
forall a b. [Either a b] -> [b]
rights ([Either Text KM] -> [KM]) -> [Either Text KM] -> [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
  okx <- itemOverlay iids dmode
  sli <- overlayToSlideshow (rheight - 2) keys okx
  ekm <- displayChoiceScreenWithDefItemKey
           (okxItemLoreInline promptFun meleeSkill dmode iids)
           sli itemKeys (show dmode)
  runDefAction keyDefs slotDef ekm

skillCloseUp :: MonadClientUI m => ActorId -> MenuSlot -> m (Text, AttrString)
skillCloseUp :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> MenuSlot -> m (Text, AttrString)
skillCloseUp ActorId
leader MenuSlot
slot = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
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
  bUI <- getsSession $ getActorUI leader
  actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
  let skill = [Skill]
skillsInDisplayOrder [Skill] -> Int -> Skill
forall a. HasCallStack => [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
      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 = [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 = Text -> AttrString
textToAS (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Skill -> Text
skillDesc Skill
skill
  return (prompt, attrString)

placeCloseUp :: MonadClientUI m
             => [(ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))]
             -> Bool
             -> MenuSlot
             -> m (Text, [(DisplayFont, [AttrString])])
placeCloseUp :: forall (m :: * -> *).
MonadClientUI m =>
[(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Bool -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
placeCloseUp [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places Bool
sexposePlaces MenuSlot
slot = do
  COps{coplace} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  FontSetup{..} <- getFontSetup
  let (pk, (es, ne, na, _)) = places !! fromEnum slot
      pkind = ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk
      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
"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 | 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
"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 | [Part] -> Bool
forall a. [a] -> Bool
null [Part]
placeParts = []
                    | Bool
otherwise = [[Part] -> Text
makeSentence [Part]
placeParts, Text
"\n"]
      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)]
  return (prompt, map (second $ map textToAS) blurbs)

factionCloseUp :: MonadClientUI m
               => [(FactionId, Faction)]
               -> MenuSlot
               -> m (Text, [(DisplayFont, [AttrString])])
factionCloseUp :: forall (m :: * -> *).
MonadClientUI m =>
[(FactionId, Faction)]
-> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
factionCloseUp [(FactionId, Faction)]
factions MenuSlot
slot = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  FontSetup{propFont} <- getFontSetup
  factionD <- getsState sfactionD
  let (fid, fact@Faction{gkind=FK.FactionKind{..}, ..}) =
        factions !! fromEnum slot
      (name, person) = if fhasGender  -- but we ignore "Controlled", etc.
                       then (makePhrase [MU.Ws $ MU.Text fname], MU.PlEtc)
                       else (fname, MU.Sg3rd)
      (youThey, prompt) =
        if fid == side
        then ("You", makeSentence  ["you are the", MU.Text name])
        else ("They", makeSentence ["you are wary of the", MU.Text name])
               -- wary even if the faction is allied
      ts1 =
        -- Display only the main groups, not to spam.
        case ((GroupName ItemKind, Int) -> GroupName ItemKind)
-> Freqs ItemKind -> [GroupName ItemKind]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName ItemKind, Int) -> GroupName ItemKind
forall a b. (a, b) -> a
fst (Freqs ItemKind -> [GroupName ItemKind])
-> Freqs ItemKind -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ ((GroupName ItemKind, Int) -> Bool)
-> Freqs ItemKind -> Freqs ItemKind
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100) (Int -> Bool)
-> ((GroupName ItemKind, Int) -> Int)
-> (GroupName ItemKind, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, Int) -> Int
forall a b. (a, b) -> b
snd) Freqs ItemKind
fgroups of
          [] -> []  -- only initial actors in the faction?
          [GroupName ItemKind
fgroup] ->
            [[Part] -> Text
makeSentence [ Part
"the faction consists of"
                          , Part -> Part
MU.Ws (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
$ GroupName ItemKind -> Text
forall c. GroupName c -> Text
displayGroupName GroupName ItemKind
fgroup ]]
          [GroupName ItemKind]
grps -> [[Part] -> Text
makeSentence
                    [ Part
"the faction attracts members such as:"
                    ,  [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ (GroupName ItemKind -> Part) -> [GroupName ItemKind] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Part
MU.Text (Text -> Part)
-> (GroupName ItemKind -> Text) -> GroupName ItemKind -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupName ItemKind -> Text
forall c. GroupName c -> Text
displayGroupName) [GroupName ItemKind]
grps ]]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [if Skills
fskillsOther Skills -> Skills -> Bool
forall a. Eq a => a -> a -> Bool
== Skills
Ability.zeroSkills  -- simplified
            then Text
youThey Text -> Text -> Text
<+> Text
"don't care about each other and crowd and stampede all at once, sometimes brutally colliding by accident."
            else Text
youThey Text -> Text -> Text
<+> Text
"pay attention to each other and take care to move one at a time."]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ if Bool
fcanEscape
             then Text
"The faction is able to take part in races to an area exit."
             else Text
"The faction doesn't escape areas of conflict and attempts to block exits instead."]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"When all members are incapacitated, the faction dissolves."
           | Bool
fneverEmpty ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [if Bool
fhasGender
            then Text
"Its members are known to have sexual dimorphism and use gender pronouns."
            else Text
"Its members seem to prefer naked ground for sleeping."]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"Its ranks swell with time."
           | Bool
fspawnsFast ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"The faction is able to maintain activity on a level on its own, with a pointman coordinating each tactical maneuver."
           | Bool
fhasPointman ]
      -- Changes to all of these have visibility @PosAll@, so the player
      -- knows them fully, except for @gvictims@, which is coupled to tracking
      -- other factions' actors and so only incremented when we've seen
      -- their actor killed (mostly likely killed by us).
      ts2 =  -- reporting regardless of whether any of the factions are dead
        let renderDiplGroup :: [(FactionId, Diplomacy)] -> Part
renderDiplGroup [] = String -> Part
forall a. HasCallStack => String -> a
error String
"renderDiplGroup: null"
            renderDiplGroup ((FactionId
fid2, Diplomacy
diplomacy) : [(FactionId, Diplomacy)]
rest) = [Part] -> Part
MU.Phrase
              [ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Diplomacy -> Text
tshowDiplomacy Diplomacy
diplomacy
              , Part
"with"
              , [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ (FactionId -> Part) -> [FactionId] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map FactionId -> Part
renderFact2 ([FactionId] -> [Part]) -> [FactionId] -> [Part]
forall a b. (a -> b) -> a -> b
$ FactionId
fid2 FactionId -> [FactionId] -> [FactionId]
forall a. a -> [a] -> [a]
: ((FactionId, Diplomacy) -> FactionId)
-> [(FactionId, Diplomacy)] -> [FactionId]
forall a b. (a -> b) -> [a] -> [b]
map (FactionId, Diplomacy) -> FactionId
forall a b. (a, b) -> a
fst [(FactionId, Diplomacy)]
rest ]
            renderFact2 :: FactionId -> Part
renderFact2 FactionId
fid2 = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
Faction.gname (FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid2)
            valid :: (FactionId, Diplomacy) -> Bool
valid (FactionId
fid2, Diplomacy
diplomacy) = Maybe Faction -> Bool
forall a. Maybe a -> Bool
isJust (FactionId -> [(FactionId, Faction)] -> Maybe Faction
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FactionId
fid2 [(FactionId, Faction)]
factions)
                                      Bool -> Bool -> Bool
&& Diplomacy
diplomacy Diplomacy -> Diplomacy -> Bool
forall a. Eq a => a -> a -> Bool
/= Diplomacy
Unknown
            knownAssocsGroups :: [[(FactionId, Diplomacy)]]
knownAssocsGroups = ((FactionId, Diplomacy) -> (FactionId, Diplomacy) -> Bool)
-> [(FactionId, Diplomacy)] -> [[(FactionId, Diplomacy)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Diplomacy -> Diplomacy -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Diplomacy -> Diplomacy -> Bool)
-> ((FactionId, Diplomacy) -> Diplomacy)
-> (FactionId, Diplomacy)
-> (FactionId, Diplomacy)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (FactionId, Diplomacy) -> Diplomacy
forall a b. (a, b) -> b
snd) ([(FactionId, Diplomacy)] -> [[(FactionId, Diplomacy)]])
-> [(FactionId, Diplomacy)] -> [[(FactionId, Diplomacy)]]
forall a b. (a -> b) -> a -> b
$ ((FactionId, Diplomacy) -> Diplomacy)
-> [(FactionId, Diplomacy)] -> [(FactionId, Diplomacy)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (FactionId, Diplomacy) -> Diplomacy
forall a b. (a, b) -> b
snd
                                ([(FactionId, Diplomacy)] -> [(FactionId, Diplomacy)])
-> [(FactionId, Diplomacy)] -> [(FactionId, Diplomacy)]
forall a b. (a -> b) -> a -> b
$ ((FactionId, Diplomacy) -> Bool)
-> [(FactionId, Diplomacy)] -> [(FactionId, Diplomacy)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FactionId, Diplomacy) -> Bool
valid ([(FactionId, Diplomacy)] -> [(FactionId, Diplomacy)])
-> [(FactionId, Diplomacy)] -> [(FactionId, Diplomacy)]
forall a b. (a -> b) -> a -> b
$ Dipl -> [(FactionId, Diplomacy)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dipl
gdipl
        in [ [Part] -> Text
makeSentence [ Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
person Polarity
MU.Yes (Text -> Part
MU.Text Text
name) Part
"be"
                          , [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ([(FactionId, Diplomacy)] -> Part)
-> [[(FactionId, Diplomacy)]] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map [(FactionId, Diplomacy)] -> Part
renderDiplGroup [[(FactionId, Diplomacy)]]
knownAssocsGroups ]
           | Bool -> Bool
not ([[(FactionId, Diplomacy)]] -> Bool
forall a. [a] -> Bool
null [[(FactionId, Diplomacy)]]
knownAssocsGroups) ]
      ts3 =
        case Maybe Status
gquit of
          Just Status{Int
Maybe (GroupName ModeKind)
Outcome
stOutcome :: Outcome
stDepth :: Int
stNewGame :: Maybe (GroupName ModeKind)
stNewGame :: Status -> Maybe (GroupName ModeKind)
stDepth :: Status -> Int
stOutcome :: Status -> Outcome
..} | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Bool
isHorrorFact Faction
fact ->
            [Text
"The faction has already" Text -> Text -> Text
<+> Outcome -> Text
FK.nameOutcomePast Outcome
stOutcome
             Text -> Text -> Text
<+> Text
"around level" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int
forall a. Num a => a -> a
abs Int
stDepth) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]
          Maybe Status
_ -> []
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let nkilled :: Int
nkilled = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId ItemKind) Int -> [Int]
forall k a. EnumMap k a -> [a]
EM.elems EnumMap (ContentId ItemKind) Int
gvictims
               personKilled :: Person
personKilled = if Int
nkilled Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Person
MU.Sg3rd else Person
MU.PlEtc
           in [ [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
                  [ Part
"so far," | Maybe Status -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Status
gquit ]
                  [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [ Part
"at least"
                     , Int -> Part -> Part
MU.CardinalWs Int
nkilled Part
"member"
                     , Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
personKilled
                                      Polarity
MU.Yes
                                      Part
"of this faction"
                                      Part
"have been incapacitated" ]
              | Int
nkilled Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let adjective :: Text
adjective = if Maybe Status -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Status
gquit then Text
"current" else Text
"last"
               verb :: Text
verb = if Maybe Status -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Status
gquit then Text
"is" else Text
"was"
           in [Text
"Its" Text -> Text -> Text
<+> Text
adjective Text -> Text -> Text
<+> Text
"doctrine" Text -> Text -> Text
<+> Text
verb
               Text -> Text -> Text
<+> Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doctrine -> Text
Ability.nameDoctrine Doctrine
gdoctrine
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doctrine -> Text
Ability.describeDoctrine Doctrine
gdoctrine Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")."]
      -- Description of the score polynomial would go into a separate section,
      -- but it's hard to make it sound non-technical enough.
      blurbs = [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
intersperse [Text
"\n"] ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ ([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
forall a. [a] -> Bool
null) [[Text]
ts1, [Text]
ts2, [Text]
ts3]
  return (prompt, map (\[Text]
t -> (DisplayFont
propFont, (Text -> AttrString) -> [Text] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrString
textToAS [Text]
t)) blurbs)