-- | 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
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side
  let ppItemDialogBody :: Text -> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Text
v Actor
body Skills
actorSk ItemDialogMode
cCur = case ItemDialogMode
cCur of
        MStore CStore
CEqp | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorSk ->
          Text
"distractedly attempt to" Text -> Text -> Text
<+> Text
v Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
        MStore CStore
CGround | Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
body, Actor -> Point
bpos Actor
body) ->
          Text
"greedily attempt to" Text -> Text -> Text
<+> Text
v Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
        ItemDialogMode
_ -> Text
v Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
  Either Text (CStore, [(ItemId, ItemQuant)])
soc <- ActorId
-> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
getFull ActorId
leader m Suitability
psuit
                 (\Actor
body ActorUI
_ Skills
actorSk ItemDialogMode
cCur State
_ ->
                    Text
prompt Text -> Text -> Text
<+> Text -> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Text
verb Actor
body Skills
actorSk ItemDialogMode
cCur)
                 (\Actor
body ActorUI
_ Skills
actorSk ItemDialogMode
cCur State
_ ->
                    Text
promptGeneric
                    Text -> Text -> Text
<+> Text -> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Text
verbGeneric Actor
body Skills
actorSk ItemDialogMode
cCur)
                 [CStore]
stores Bool
True Bool
False
  case Either Text (CStore, [(ItemId, ItemQuant)])
soc of
    Left Text
err -> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall 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
  FactionId
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 :: [ItemDialogMode]
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]
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 :: [ItemDialogMode]
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]
loreCs = [ItemDialogMode]
itemLoreCs [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
MPlaces, ItemDialogMode
MFactions, ItemDialogMode
MModes]
  let !_A1 :: ()
_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 :: ()
_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]
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
      ([ItemDialogMode]
pre, [ItemDialogMode]
rest) = (ItemDialogMode -> Bool)
-> [ItemDialogMode] -> ([ItemDialogMode], [ItemDialogMode])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== ItemDialogMode
cInitial) [ItemDialogMode]
allCs
      post :: [ItemDialogMode]
post = (ItemDialogMode -> Bool) -> [ItemDialogMode] -> [ItemDialogMode]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== ItemDialogMode
cInitial) [ItemDialogMode]
rest
      remCs :: [ItemDialogMode]
remCs = [ItemDialogMode]
post [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode]
pre
      prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt = FactionId
-> Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
storeItemPrompt FactionId
side
  ActorId
-> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
getItem ActorId
leader (Suitability -> m Suitability
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Suitability
SuitsEverything) Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt ItemDialogMode
cInitial [ItemDialogMode]
remCs
          Bool
True Bool
False

storeItemPrompt :: FactionId
                -> Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
                -> Text
storeItemPrompt :: FactionId
-> Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
storeItemPrompt FactionId
side Actor
body ActorUI
bodyUI Skills
actorCurAndMaxSk ItemDialogMode
c2 State
s =
  let COps{ContentData ItemKind
coitem :: 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
  Suitability
mpsuit <- m Suitability
psuit
  let psuitFun :: Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun = case Suitability
mpsuit of
        Suitability
SuitsEverything -> \Maybe CStore
_ ItemFull
_ ItemQuant
_ -> Bool
True
        SuitsSomething Maybe CStore -> ItemFull -> ItemQuant -> Bool
f -> Maybe CStore -> ItemFull -> ItemQuant -> Bool
f
  -- Move the first store that is non-empty for suitable items for this actor
  -- to the front, if any.
  Actor
b <- (State -> Actor) -> m Actor
forall 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
  CStore -> ItemBag
getCStoreBag <- (State -> CStore -> ItemBag) -> m (CStore -> ItemBag)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> CStore -> ItemBag) -> m (CStore -> ItemBag))
-> (State -> CStore -> ItemBag) -> m (CStore -> ItemBag)
forall a b. (a -> b) -> a -> b
$ \State
s CStore
cstore -> Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cstore State
s
  let hasThisActor :: CStore -> Bool
hasThisActor = Bool -> Bool
not (Bool -> Bool) -> (CStore -> Bool) -> CStore -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null (ItemBag -> Bool) -> (CStore -> ItemBag) -> CStore -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStore -> ItemBag
getCStoreBag
  case (CStore -> Bool) -> [CStore] -> [CStore]
forall a. (a -> Bool) -> [a] -> [a]
filter CStore -> Bool
hasThisActor [CStore]
stores of
    [] -> do
      let dialogModes :: [ItemDialogMode]
dialogModes = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore]
stores
          ts :: [Part]
ts = (ItemDialogMode -> Part) -> [ItemDialogMode] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Part
MU.Text (Text -> Part)
-> (ItemDialogMode -> Text) -> ItemDialogMode -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemDialogMode -> Text
ppItemDialogModeIn) [ItemDialogMode]
dialogModes
      Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall 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
      ItemId -> ItemFull
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 -> Bool
suitsThisActor CStore
store =
            let bag :: ItemBag
bag = CStore -> ItemBag
getCStoreBag CStore
store
            in ((ItemId, ItemQuant) -> Bool) -> [(ItemId, ItemQuant)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ItemId
iid, ItemQuant
kit) -> Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
store) (ItemId -> ItemFull
itemToF ItemId
iid) ItemQuant
kit)
                   (ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag)
          firstStore :: CStore
firstStore = CStore -> Maybe CStore -> CStore
forall a. a -> Maybe a -> a
fromMaybe CStore
headThisActor (Maybe CStore -> CStore) -> Maybe CStore -> CStore
forall a b. (a -> b) -> a -> b
$ (CStore -> Bool) -> [CStore] -> Maybe CStore
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CStore -> Bool
suitsThisActor [CStore]
haveThis
          -- Don't display stores totally empty for all actors.
          breakStores :: CStore -> (ItemDialogMode, [ItemDialogMode])
breakStores CStore
cInit =
            let ([CStore]
pre, [CStore]
rest) = (CStore -> Bool) -> [CStore] -> ([CStore], [CStore])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
cInit) [CStore]
stores
                post :: [CStore]
post = (CStore -> Bool) -> [CStore] -> [CStore]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
cInit) [CStore]
rest
            in (CStore -> ItemDialogMode
MStore CStore
cInit, (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore ([CStore] -> [ItemDialogMode]) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ [CStore]
post [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore]
pre)
          (ItemDialogMode
modeFirst, [ItemDialogMode]
modeRest) = CStore -> (ItemDialogMode, [ItemDialogMode])
breakStores CStore
firstStore
      Either Text ResultItemDialogMode
res <- ActorId
-> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
getItem ActorId
leader m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric ItemDialogMode
modeFirst [ItemDialogMode]
modeRest
                     Bool
askWhenLone Bool
permitMulitple
      case Either Text ResultItemDialogMode
res of
        Left Text
t -> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall 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
  ItemDialogMode -> ItemBag
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 :: ItemDialogMode -> [(ItemId, ItemQuant)]
storeAssocs = ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
-> (ItemDialogMode -> ItemBag)
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemDialogMode -> ItemBag
accessCBag
      allAssocs :: [(ItemId, ItemQuant)]
allAssocs = (ItemDialogMode -> [(ItemId, ItemQuant)])
-> [ItemDialogMode] -> [(ItemId, ItemQuant)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ItemDialogMode -> [(ItemId, ItemQuant)]
storeAssocs (ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest)
  case ([(ItemId, ItemQuant)]
allAssocs, ItemDialogMode
cCur) of
    ([(ItemId
iid, ItemQuant
_)], MStore CStore
rstore) | [ItemDialogMode] -> Bool
forall a. [a] -> Bool
null [ItemDialogMode]
cRest Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
askWhenLone ->
      Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall 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.
        Maybe ActorId
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
leader2 = ActorId -> Maybe ActorId -> ActorId
forall a. a -> Maybe a -> a
fromMaybe ActorId
leader Maybe ActorId
mleader
        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
leader2 m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Bool
permitMulitple
                   ItemDialogMode
cCur2 [ItemDialogMode]
cRest2 ItemDialogState
itemDialogState2
  Skills
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
  Actor
body <- (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
  ActorUI
bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
  [(ActorId, Actor, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
  HumanCmd -> KM
revCmd <- m (HumanCmd -> KM)
forall (m :: * -> *). MonadClientUI m => m (HumanCmd -> KM)
revCmdMap
  Text
promptChosen <- (State -> Text) -> m Text
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ \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)]
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
merror <- ActorId -> m MError
forall (m :: * -> *). MonadClientUI m => ActorId -> m MError
pickLeaderWithPointer ActorId
leader
               case MError
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 -> (KM, DefItemKey m)
cycleLevelKeyDef Direction
direction =
        let km :: KM
km = HumanCmd -> KM
revCmd (HumanCmd -> KM) -> HumanCmd -> KM
forall a b. (a -> b) -> a -> b
$ Direction -> HumanCmd
PointmanCycleLevel Direction
direction
        in (KM
km, DefItemKey
                { 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
                    MError
err <- ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycleLevel ActorId
leader Bool
False Direction
direction
                    let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (MError -> Bool
forall a. Maybe a -> Bool
isNothing MError
err Bool -> MError -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` MError
err) ()
                    ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
                })
      changeContainerDef :: Direction -> Either Text KM -> DefItemKey m
changeContainerDef Direction
direction Either Text KM
defLabel =
        let (ItemDialogMode
cCurAfterCalm, [ItemDialogMode]
cRestAfterCalm) = Direction -> (ItemDialogMode, [ItemDialogMode])
nextContainers Direction
direction
        in DefItemKey
          { 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 -> (ItemDialogMode, [ItemDialogMode])
nextContainers Direction
direction = case Direction
direction of
        Direction
Forward -> case [ItemDialogMode]
cRest [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
cCur] of
          ItemDialogMode
c1 : [ItemDialogMode]
rest -> (ItemDialogMode
c1, [ItemDialogMode]
rest)
          [] -> String -> (ItemDialogMode, [ItemDialogMode])
forall a. HasCallStack => String -> a
error (String -> (ItemDialogMode, [ItemDialogMode]))
-> String -> (ItemDialogMode, [ItemDialogMode])
forall a b. (a -> b) -> a -> b
$ String
"" String -> [ItemDialogMode] -> String
forall v. Show v => String -> v -> String
`showFailure` [ItemDialogMode]
cRest
        Direction
Backward -> case [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse ([ItemDialogMode] -> [ItemDialogMode])
-> [ItemDialogMode] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest of
          ItemDialogMode
c1 : [ItemDialogMode]
rest -> (ItemDialogMode
c1, [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse [ItemDialogMode]
rest)
          [] -> String -> (ItemDialogMode, [ItemDialogMode])
forall a. HasCallStack => String -> a
error (String -> (ItemDialogMode, [ItemDialogMode]))
-> String -> (ItemDialogMode, [ItemDialogMode])
forall a b. (a -> b) -> a -> b
$ String
"" String -> [ItemDialogMode] -> String
forall v. Show v => String -> v -> String
`showFailure` [ItemDialogMode]
cRest
      banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
      maySwitchLeader :: ItemDialogMode -> Bool
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 -> (KM, DefItemKey m)
cycleKeyDef Direction
direction =
        let km :: KM
km = HumanCmd -> KM
revCmd (HumanCmd -> KM) -> HumanCmd -> KM
forall a b. (a -> b) -> a -> b
$ Direction -> HumanCmd
PointmanCycle Direction
direction
        in (KM
km, DefItemKey
               { 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
                   MError
err <- ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycle ActorId
leader Bool
False Direction
direction
                   let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (MError -> Bool
forall a. Maybe a -> Bool
isNothing MError
err Bool -> MError -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` MError
err) ()
                   ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
               })
  case ItemDialogMode
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
      ItemBag
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
      ItemId -> ItemFull
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
      Suitability
mpsuit <- m Suitability
psuit  -- when throwing, this sets eps and checks xhair validity
      Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun <- case Suitability
mpsuit of
        Suitability
SuitsEverything -> (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
-> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
forall 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 EnumMap SLore (EnumSet ItemId)
itemRoles <- (SessionUI -> ItemRoles) -> m ItemRoles
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemRoles
sroles
      let slore :: SLore
slore = ItemDialogMode -> SLore
loreFromMode ItemDialogMode
cCur
          itemRole :: EnumSet ItemId
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 :: ItemBag
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 :: Maybe CStore
mstore = case ItemDialogMode
cCur of
            MStore CStore
store -> CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
store
            ItemDialogMode
_ -> Maybe CStore
forall a. Maybe a
Nothing
          filterP :: ItemId -> ItemQuant -> Bool
filterP = 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 :: ItemBag
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 :: ItemBag
bagFiltered = case ItemDialogState
itemDialogState of
            ItemDialogState
ISuitable -> ItemBag
bagSuit
            ItemDialogState
IAll -> ItemBag
bagAll
          iids :: [(ItemId, ItemQuant)]
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 :: [(KM, DefItemKey m)]
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 -> DefItemKey m
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)]
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
      [(KM, DefItemKey m)]
-> Text
-> ActorId
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> m (Either Text ResultItemDialogMode)
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
cCur [(ItemId, ItemQuant)]
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 :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  [(KM, DefItemKey m)] -> Text -> m ()
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)] -> Text -> m ()
runDefMessage [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen
  let itemKeys :: [KM]
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 :: [KM]
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
okx <- ActorId -> m OKX
forall (m :: * -> *). MonadClientUI m => ActorId -> m OKX
skillsOverlay ActorId
leader
  Slideshow
sli <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [KM]
keys OKX
okx
  KeyOrSlot
ekm <- (Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
(Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
displayChoiceScreenWithDefItemKey
           (ActorId -> Int -> MenuSlot -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Int -> MenuSlot -> m OKX
skillsInRightPane ActorId
leader) Slideshow
sli [KM]
itemKeys (ItemDialogMode -> String
forall a. Show a => a -> String
show ItemDialogMode
MSkills)
  [(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
runDefAction [(KM, DefItemKey m)]
keyDefsCommon (ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (ResultItemDialogMode -> Either Text ResultItemDialogMode)
-> (MenuSlot -> ResultItemDialogMode)
-> MenuSlot
-> Either Text ResultItemDialogMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuSlot -> ResultItemDialogMode
RSkills) KeyOrSlot
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{DisplayFont
propFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  (Text
prompt, AttrString
attrString) <- ActorId -> MenuSlot -> m (Text, AttrString)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> MenuSlot -> m (Text, AttrString)
skillCloseUp ActorId
leader MenuSlot
slot
  let promptAS :: AttrString
promptAS | Text -> Bool
T.null Text
prompt = []
               | Bool
otherwise = Color -> Text -> AttrString
textFgToAS Color
Color.Brown (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
      ov :: EnumMap DisplayFont Overlay
ov = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
                                 ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
                                 (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrString
promptAS AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
attrString
  OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
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{ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
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 :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places <- (State
 -> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State
  -> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
 -> m [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> (State
    -> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs
                      (EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
 -> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> (State
    -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> State
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentData PlaceKind
-> Bool
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState ContentData PlaceKind
coplace (ClientOptions -> Bool
sexposePlaces ClientOptions
soptions)
  [(KM, DefItemKey m)] -> Text -> m ()
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)] -> Text -> m ()
runDefMessage [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen
  let itemKeys :: [KM]
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 :: [KM]
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
okx <- m OKX
forall (m :: * -> *). MonadClientUI m => m OKX
placesOverlay
  Slideshow
sli <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [KM]
keys OKX
okx
  KeyOrSlot
ekm <- (Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
(Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
displayChoiceScreenWithDefItemKey
           ([(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Int -> MenuSlot -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
[(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Int -> MenuSlot -> m OKX
placesInRightPane [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places) Slideshow
sli [KM]
itemKeys (ItemDialogMode -> String
forall a. Show a => a -> String
show ItemDialogMode
MPlaces)
  [(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
runDefAction [(KM, DefItemKey m)]
keyDefsCommon (ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (ResultItemDialogMode -> Either Text ResultItemDialogMode)
-> (MenuSlot -> ResultItemDialogMode)
-> MenuSlot
-> Either Text ResultItemDialogMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuSlot -> ResultItemDialogMode
RPlaces) KeyOrSlot
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{DisplayFont
propFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  (Text
prompt, [(DisplayFont, [AttrString])]
blurbs) <- [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Bool -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
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 (ClientOptions -> Bool
sexposePlaces ClientOptions
soptions) MenuSlot
slot
  let promptAS :: AttrString
promptAS | Text -> Bool
T.null Text
prompt = []
               | Bool
otherwise = Color -> Text -> AttrString
textFgToAS Color
Color.Brown (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
      splitText :: AttrString -> [AttrLine]
splitText = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
      ov :: EnumMap DisplayFont Overlay
ov = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
           ([(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay)
-> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map (([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine])
forall 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
  OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
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 :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  ItemRoles
sroles <- (SessionUI -> ItemRoles) -> m ItemRoles
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemRoles
sroles
  [(FactionId, Faction)]
factions <- (State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)])
-> (State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ ItemRoles -> State -> [(FactionId, Faction)]
factionsFromState ItemRoles
sroles
  [(KM, DefItemKey m)] -> Text -> m ()
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)] -> Text -> m ()
runDefMessage [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen
  let itemKeys :: [KM]
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 :: [KM]
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
okx <- m OKX
forall (m :: * -> *). MonadClientUI m => m OKX
factionsOverlay
  Slideshow
sli <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [KM]
keys OKX
okx
  KeyOrSlot
ekm <- (Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
(Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
displayChoiceScreenWithDefItemKey
           ([(FactionId, Faction)] -> Int -> MenuSlot -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
[(FactionId, Faction)] -> Int -> MenuSlot -> m OKX
factionsInRightPane [(FactionId, Faction)]
factions)
           Slideshow
sli [KM]
itemKeys (ItemDialogMode -> String
forall a. Show a => a -> String
show ItemDialogMode
MFactions)
  [(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
runDefAction [(KM, DefItemKey m)]
keyDefsCommon (ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (ResultItemDialogMode -> Either Text ResultItemDialogMode)
-> (MenuSlot -> ResultItemDialogMode)
-> MenuSlot
-> Either Text ResultItemDialogMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuSlot -> ResultItemDialogMode
RFactions) KeyOrSlot
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{DisplayFont
propFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  (Text
prompt, [(DisplayFont, [AttrString])]
blurbs) <- [(FactionId, Faction)]
-> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
forall (m :: * -> *).
MonadClientUI m =>
[(FactionId, Faction)]
-> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
factionCloseUp [(FactionId, Faction)]
factions MenuSlot
slot
  let promptAS :: AttrString
promptAS | Text -> Bool
T.null Text
prompt = []
               | Bool
otherwise = Color -> Text -> AttrString
textFgToAS Color
Color.Brown (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
      splitText :: AttrString -> [AttrLine]
splitText = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
      ov :: EnumMap DisplayFont Overlay
ov = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
           ([(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay)
-> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map (([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine])
forall 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
  OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
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 :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  [(KM, DefItemKey m)] -> Text -> m ()
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)] -> Text -> m ()
runDefMessage [(KM, DefItemKey m)]
keyDefsCommon Text
promptChosen
  let itemKeys :: [KM]
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 :: [KM]
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
okx <- m OKX
forall (m :: * -> *). MonadClientUI m => m OKX
modesOverlay
  Slideshow
sli <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [KM]
keys OKX
okx
  -- Modes would cover the whole screen, so we don't display in right pane.
  -- But we display and highlight menu bullets.
  KeyOrSlot
ekm <- (Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
(Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
displayChoiceScreenWithDefItemKey
           (\Int
_ MenuSlot
_ -> OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return OKX
emptyOKX) Slideshow
sli [KM]
itemKeys (ItemDialogMode -> String
forall a. Show a => a -> String
show ItemDialogMode
MModes)
  [(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
runDefAction [(KM, DefItemKey m)]
keyDefsCommon (ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (ResultItemDialogMode -> Either Text ResultItemDialogMode)
-> (MenuSlot -> ResultItemDialogMode)
-> MenuSlot
-> Either Text ResultItemDialogMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuSlot -> ResultItemDialogMode
RModes) KeyOrSlot
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 :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  Skills
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
  let meleeSkill :: Int
meleeSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorCurAndMaxSk
      slotDef :: MenuSlot -> Either Text ResultItemDialogMode
      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 -> p -> p -> a
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.
  [(KM, DefItemKey m)] -> Text -> m ()
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)] -> Text -> m ()
runDefMessage [(KM, DefItemKey m)]
keyDefs Text
promptChosen
  let itemKeys :: [KM]
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 :: [KM]
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
okx <- [(ItemId, ItemQuant)] -> ItemDialogMode -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
[(ItemId, ItemQuant)] -> ItemDialogMode -> m OKX
itemOverlay [(ItemId, ItemQuant)]
iids ItemDialogMode
dmode
  Slideshow
sli <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [KM]
keys OKX
okx
  KeyOrSlot
ekm <- (Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
(Int -> MenuSlot -> m OKX)
-> Slideshow -> [KM] -> String -> m KeyOrSlot
displayChoiceScreenWithDefItemKey
           ((ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> Int
-> MenuSlot
-> m OKX
forall (m :: * -> *).
MonadClientUI m =>
(ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> Int
-> MenuSlot
-> m OKX
okxItemLoreInline ItemId -> ItemFull -> Int -> Text
forall {a} {p} {p} {p}. IsString a => p -> p -> p -> a
promptFun Int
meleeSkill ItemDialogMode
dmode [(ItemId, ItemQuant)]
iids)
           Slideshow
sli [KM]
itemKeys (ItemDialogMode -> String
forall a. Show a => a -> String
show ItemDialogMode
dmode)
  [(KM, DefItemKey m)]
-> (MenuSlot -> Either Text ResultItemDialogMode)
-> KeyOrSlot
-> m (Either Text ResultItemDialogMode)
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

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

placeCloseUp :: MonadClientUI m
             => [(ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))]
             -> Bool
             -> 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{ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace :: ContentData PlaceKind
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{DisplayFont
propFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let (ContentId PlaceKind
pk, (EnumSet LevelId
es, Int
ne, Int
na, Int
_)) = [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Int -> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
forall a. HasCallStack => [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
      pkind :: PlaceKind
pkind = ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk
      prompt :: Text
prompt = [Part] -> Text
makeSentence [Part
"you remember", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ PlaceKind -> Text
PK.pname PlaceKind
pkind]
      freqsText :: Text
freqsText = Text
"Frequencies:" Text -> Text -> Text
<+> Text -> [Text] -> Text
T.intercalate Text
" "
        (((GroupName PlaceKind, Int) -> Text)
-> [(GroupName PlaceKind, Int)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(GroupName PlaceKind
grp, Int
n) -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GroupName PlaceKind -> Text
forall c. GroupName c -> Text
displayGroupName GroupName PlaceKind
grp
                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
         ([(GroupName PlaceKind, Int)] -> [Text])
-> [(GroupName PlaceKind, Int)] -> [Text]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
PK.pfreq PlaceKind
pkind)
      onLevels :: [Text]
onLevels | EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es = []
               | Bool
otherwise = [[Part] -> Text
makeSentence
                               [ Part
"Appears on"
                               , Int -> Part -> Part
MU.CarWs (EnumSet LevelId -> Int
forall k. EnumSet k -> Int
ES.size EnumSet LevelId
es) Part
"level" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Part
":"
                               , [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ (Int -> Part) -> [Int] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Part
MU.Car ([Int] -> [Part]) -> [Int] -> [Part]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort
                                 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (LevelId -> Int) -> [LevelId] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> (LevelId -> Int) -> LevelId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LevelId -> Int
forall a. Enum a => a -> Int
fromEnum) ([LevelId] -> [Int]) -> [LevelId] -> [Int]
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
es ]]
      placeParts :: [Part]
placeParts = [Part
"it has" | Int
ne Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
na Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Int -> Part -> Part
MU.CarWs Int
ne Part
"entrance" | Int
ne Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part
"and" | Int
ne Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
na Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Int -> Part -> Part
MU.CarWs Int
na Part
"surrounding" | Int
na Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
      partsSentence :: [Text]
partsSentence | [Part] -> Bool
forall a. [a] -> Bool
null [Part]
placeParts = []
                    | Bool
otherwise = [[Part] -> Text
makeSentence [Part]
placeParts, Text
"\n"]
      blurbs :: [(DisplayFont, [Text])]
blurbs = [(DisplayFont
propFont, [Text]
partsSentence)]
               [(DisplayFont, [Text])]
-> [(DisplayFont, [Text])] -> [(DisplayFont, [Text])]
forall a. [a] -> [a] -> [a]
++ [(DisplayFont
monoFont, [Text
freqsText, Text
"\n"]) | Bool
sexposePlaces]
               [(DisplayFont, [Text])]
-> [(DisplayFont, [Text])] -> [(DisplayFont, [Text])]
forall a. [a] -> [a] -> [a]
++ [(DisplayFont
squareFont, PlaceKind -> [Text]
PK.ptopLeft PlaceKind
pkind [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"\n"]) | Bool
sexposePlaces]
               [(DisplayFont, [Text])]
-> [(DisplayFont, [Text])] -> [(DisplayFont, [Text])]
forall a. [a] -> [a] -> [a]
++ [(DisplayFont
propFont, [Text]
onLevels)]
  (Text, [(DisplayFont, [AttrString])])
-> m (Text, [(DisplayFont, [AttrString])])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
prompt, ((DisplayFont, [Text]) -> (DisplayFont, [AttrString]))
-> [(DisplayFont, [Text])] -> [(DisplayFont, [AttrString])]
forall a b. (a -> b) -> [a] -> [b]
map (([Text] -> [AttrString])
-> (DisplayFont, [Text]) -> (DisplayFont, [AttrString])
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 (([Text] -> [AttrString])
 -> (DisplayFont, [Text]) -> (DisplayFont, [AttrString]))
-> ([Text] -> [AttrString])
-> (DisplayFont, [Text])
-> (DisplayFont, [AttrString])
forall a b. (a -> b) -> a -> b
$ (Text -> AttrString) -> [Text] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrString
textToAS) [(DisplayFont, [Text])]
blurbs)

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
  FactionId
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{DisplayFont
propFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
  let (FactionId
fid, fact :: Faction
fact@Faction{gkind :: Faction -> FactionKind
gkind=FK.FactionKind{Bool
HiCondPoly
Freqs ItemKind
Freqs FactionKind
[TeamContinuity]
Text
Doctrine
Skills
TeamContinuity
fname :: Text
ffreq :: Freqs FactionKind
fteam :: TeamContinuity
fgroups :: Freqs ItemKind
fskillsOther :: Skills
fcanEscape :: Bool
fneverEmpty :: Bool
fhiCondPoly :: HiCondPoly
fhasGender :: Bool
finitDoctrine :: Doctrine
fspawnsFast :: Bool
fhasPointman :: Bool
fhasUI :: Bool
finitUnderAI :: Bool
fenemyTeams :: [TeamContinuity]
falliedTeams :: [TeamContinuity]
fname :: FactionKind -> Text
ffreq :: FactionKind -> Freqs FactionKind
fteam :: FactionKind -> TeamContinuity
fgroups :: FactionKind -> Freqs ItemKind
fskillsOther :: FactionKind -> Skills
fcanEscape :: FactionKind -> Bool
fneverEmpty :: FactionKind -> Bool
fhiCondPoly :: FactionKind -> HiCondPoly
fhasGender :: FactionKind -> Bool
finitDoctrine :: FactionKind -> Doctrine
fspawnsFast :: FactionKind -> Bool
fhasPointman :: FactionKind -> Bool
fhasUI :: FactionKind -> Bool
finitUnderAI :: FactionKind -> Bool
fenemyTeams :: FactionKind -> [TeamContinuity]
falliedTeams :: FactionKind -> [TeamContinuity]
..}, Bool
[(Int, Int, GroupName ItemKind)]
Maybe (LevelId, Point)
Maybe ActorId
Maybe Status
Text
EnumMap (ContentId ItemKind) Int
Dipl
Doctrine
Color
gstash :: Faction -> Maybe (LevelId, Point)
gname :: Text
gcolor :: Color
gdoctrine :: Doctrine
gunderAI :: Bool
ginitial :: [(Int, Int, GroupName ItemKind)]
gdipl :: Dipl
gquit :: Maybe Status
_gleader :: Maybe ActorId
gstash :: Maybe (LevelId, Point)
gvictims :: EnumMap (ContentId ItemKind) Int
gname :: Faction -> Text
gcolor :: Faction -> Color
gdoctrine :: Faction -> Doctrine
gunderAI :: Faction -> Bool
ginitial :: Faction -> [(Int, Int, GroupName ItemKind)]
gdipl :: Faction -> Dipl
gquit :: Faction -> Maybe Status
_gleader :: Faction -> Maybe ActorId
gvictims :: Faction -> EnumMap (ContentId ItemKind) Int
..}) =
        [(FactionId, Faction)]
factions [(FactionId, Faction)] -> Int -> (FactionId, Faction)
forall a. HasCallStack => [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
      (Text
name, Person
person) = if Bool
fhasGender  -- but we ignore "Controlled", etc.
                       then ([Part] -> Text
makePhrase [Part -> Part
MU.Ws (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
fname], Person
MU.PlEtc)
                       else (Text
fname, Person
MU.Sg3rd)
      (Text
youThey, Text
prompt) =
        if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
        then (Text
"You", [Part] -> Text
makeSentence  [Part
"you are the", Text -> Part
MU.Text Text
name])
        else (Text
"They", [Part] -> Text
makeSentence [Part
"you are wary of the", Text -> Part
MU.Text Text
name])
               -- wary even if the faction is allied
      ts1 :: [Text]
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 :: [Text]
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 :: [Text]
ts3 =
        case Maybe Status
gquit of
          Just Status{Int
Maybe (GroupName ModeKind)
Outcome
stOutcome :: Outcome
stDepth :: Int
stNewGame :: Maybe (GroupName ModeKind)
stOutcome :: Status -> Outcome
stDepth :: Status -> Int
stNewGame :: Status -> Maybe (GroupName ModeKind)
..} | 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]]
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]
  (Text, [(DisplayFont, [AttrString])])
-> m (Text, [(DisplayFont, [AttrString])])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
prompt, ([Text] -> (DisplayFont, [AttrString]))
-> [[Text]] -> [(DisplayFont, [AttrString])]
forall a b. (a -> b) -> [a] -> [b]
map (\[Text]
t -> (DisplayFont
propFont, (Text -> AttrString) -> [Text] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrString
textToAS [Text]
t)) [[Text]]
blurbs)