{-# LANGUAGE TupleSections #-}
-- | Display all the initial (not including high scores) screens at game over.
module Game.LambdaHack.Client.UI.Watch.WatchQuitM
  ( quitFactionUI
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , displayGameOverLoot, displayGameOverAnalytics, displayGameOverLore
  , viewLoreItems
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified NLP.Miniutter.English as MU

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

quitFactionUI :: MonadClientUI m
              => FactionId -> Maybe Status
              -> Maybe (FactionAnalytics, GenerationAnalytics)
              -> m ()
quitFactionUI :: FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
quitFactionUI FactionId
fid Maybe Status
toSt Maybe (FactionAnalytics, GenerationAnalytics)
manalytics = do
  ClientOptions{Bool
sexposeItems :: ClientOptions -> Bool
sexposeItems :: Bool
sexposeItems} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  let fidName :: Part
fidName = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
      person :: Person
person = if Player -> Bool
fhasGender (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact then Person
MU.PlEtc else Person
MU.Sg3rd
      horror :: Bool
horror = Faction -> Bool
isHorrorFact Faction
fact
      camping :: Bool
camping = Bool -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Outcome -> Outcome -> Bool
forall a. Eq a => a -> a -> Bool
== Outcome
Camping) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome) Maybe Status
toSt
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
camping) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
tellGameClipPS
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetGameStart
  ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
  Int
allNframes <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
sallNframes
  let startingPart :: Maybe Part
startingPart = case Maybe Status
toSt of
        Maybe Status
_ | Bool
horror -> Maybe Part
forall a. Maybe a
Nothing  -- Ignore summoned actors' factions.
        Just Status{stOutcome :: Status -> Outcome
stOutcome=stOutcome :: Outcome
stOutcome@Outcome
Restart, stNewGame :: Status -> Maybe (GroupName ModeKind)
stNewGame=Just GroupName ModeKind
gn} ->
          Part -> Maybe Part
forall a. a -> Maybe a
Just (Part -> Maybe Part) -> Part -> Maybe Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Outcome -> Text
nameOutcomeVerb Outcome
stOutcome
                           Text -> Text -> Text
<+> Text
"to restart in"
                           Text -> Text -> Text
<+> GroupName ModeKind -> Text
forall c. GroupName c -> Text
displayGroupName GroupName ModeKind
gn
                           Text -> Text -> Text
<+> Text
"mode"
                             -- when multiplayer: "order mission restart in"
        Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Restart, stNewGame :: Status -> Maybe (GroupName ModeKind)
stNewGame=Maybe (GroupName ModeKind)
Nothing} ->
          [Char] -> Maybe Part
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe Part) -> [Char] -> Maybe Part
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (FactionId, Maybe Status) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (FactionId
fid, Maybe Status
toSt)
        Just Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome} -> Part -> Maybe Part
forall a. a -> Maybe a
Just (Part -> Maybe Part) -> Part -> Maybe Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Outcome -> Text
nameOutcomeVerb Outcome
stOutcome
          -- when multiplayer, for @Camping@: "order save and exit"
        Maybe Status
Nothing -> Maybe Part
forall a. Maybe a
Nothing
      middlePart :: Maybe Text
middlePart = case Maybe Status
toSt of
        Maybe Status
_ | FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side -> Maybe Text
forall a. Maybe a
Nothing
        Just Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome} -> Outcome -> [(Outcome, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Outcome
stOutcome ([(Outcome, Text)] -> Maybe Text)
-> [(Outcome, Text)] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ModeKind -> [(Outcome, Text)]
mendMsg ModeKind
gameMode
        Maybe Status
Nothing -> Maybe Text
forall a. Maybe a
Nothing
      partingPart :: Maybe Text
partingPart = if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side Bool -> Bool -> Bool
|| Int
allNframes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1
                    then Maybe Text
forall a. Maybe a
Nothing
                    else Outcome -> Text
endMessageOutcome (Outcome -> Text) -> (Status -> Outcome) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome (Status -> Text) -> Maybe Status -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Status
toSt
  case Maybe Part
startingPart of
    Maybe Part
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Part
sp ->
      let blurb :: Text
blurb = [Part] -> Text
makeSentence [Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
person Polarity
MU.Yes Part
fidName Part
sp]
      in MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgFinalOutcome Text
blurb
  case (Maybe Status
toSt, Maybe Text
partingPart) of
    (Just Status
status, Just Text
pp) -> do
      Bool
noConfirmsGame <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
      Bool
go <- if Bool
noConfirmsGame
            then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorFull Text
""  -- short, just @startingPart@
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
        -- we are going to exit or restart, so record and clear, but only once
      (ItemBag
itemBag, Int
total) <- (State -> (ItemBag, Int)) -> m (ItemBag, Int)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (ItemBag, Int)) -> m (ItemBag, Int))
-> (State -> (ItemBag, Int)) -> m (ItemBag, Int)
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> (ItemBag, Int)
calculateTotal FactionId
side
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
go (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        case Maybe Text
middlePart of
          Maybe Text
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Text
sp1 -> do
            EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
            ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
            let getTrunkFull :: (ActorId, Actor) -> (ActorId, ItemFull)
getTrunkFull (ActorId
aid, Actor
b) = (ActorId
aid, ItemId -> ItemFull
itemToF (ItemId -> ItemFull) -> ItemId -> ItemFull
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
b)
            [(ActorId, ItemFull)]
ourTrunks <- (State -> [(ActorId, ItemFull)]) -> m [(ActorId, ItemFull)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, ItemFull)]) -> m [(ActorId, ItemFull)])
-> (State -> [(ActorId, ItemFull)]) -> m [(ActorId, ItemFull)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> (ActorId, ItemFull))
-> [(ActorId, Actor)] -> [(ActorId, ItemFull)]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> (ActorId, ItemFull)
getTrunkFull
                                     ([(ActorId, Actor)] -> [(ActorId, ItemFull)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, ItemFull)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
            let smartFaction :: Faction -> Bool
smartFaction Faction
fact2 = Player -> Maybe AutoLeader
fleaderMode (Faction -> Player
gplayer Faction
fact2) Maybe AutoLeader -> Maybe AutoLeader -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe AutoLeader
forall a. Maybe a
Nothing
                canBeSmart :: [(a, Faction)] -> Bool
canBeSmart = ((a, Faction) -> Bool) -> [(a, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Faction -> Bool
smartFaction (Faction -> Bool)
-> ((a, Faction) -> Faction) -> (a, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Faction) -> Faction
forall a b. (a, b) -> b
snd)
                canBeOurFaction :: [(FactionId, Faction)] -> Bool
canBeOurFaction = ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(FactionId
fid2, Faction
_) -> FactionId
fid2 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side)
                smartEnemy :: ItemFull -> Bool
smartEnemy ItemFull
trunkFull =
                  let possible :: [(FactionId, Faction)]
possible =
                        ItemKind -> EnumMap FactionId Faction -> [(FactionId, Faction)]
possibleActorFactions (ItemFull -> ItemKind
itemKind ItemFull
trunkFull) EnumMap FactionId Faction
factionD
                  in Bool -> Bool
not ([(FactionId, Faction)] -> Bool
canBeOurFaction [(FactionId, Faction)]
possible) Bool -> Bool -> Bool
&& [(FactionId, Faction)] -> Bool
forall a. [(a, Faction)] -> Bool
canBeSmart [(FactionId, Faction)]
possible
                smartEnemiesOurs :: [(ActorId, ItemFull)]
smartEnemiesOurs = ((ActorId, ItemFull) -> Bool)
-> [(ActorId, ItemFull)] -> [(ActorId, ItemFull)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemFull -> Bool
smartEnemy (ItemFull -> Bool)
-> ((ActorId, ItemFull) -> ItemFull) -> (ActorId, ItemFull) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, ItemFull) -> ItemFull
forall a b. (a, b) -> b
snd) [(ActorId, ItemFull)]
ourTrunks
                uniqueActor :: ItemFull -> Bool
uniqueActor ItemFull
trunkFull = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique
                                        (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
trunkFull
                uniqueEnemiesOurs :: [(ActorId, ItemFull)]
uniqueEnemiesOurs = ((ActorId, ItemFull) -> Bool)
-> [(ActorId, ItemFull)] -> [(ActorId, ItemFull)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemFull -> Bool
uniqueActor (ItemFull -> Bool)
-> ((ActorId, ItemFull) -> ItemFull) -> (ActorId, ItemFull) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, ItemFull) -> ItemFull
forall a b. (a, b) -> b
snd) [(ActorId, ItemFull)]
smartEnemiesOurs
                smartUniqueEnemyCaptured :: Bool
smartUniqueEnemyCaptured = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(ActorId, ItemFull)] -> Bool
forall a. [a] -> Bool
null [(ActorId, ItemFull)]
uniqueEnemiesOurs
                smartEnemyCaptured :: Bool
smartEnemyCaptured = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(ActorId, ItemFull)] -> Bool
forall a. [a] -> Bool
null [(ActorId, ItemFull)]
smartEnemiesOurs
            Text
smartEnemySentence <- case [(ActorId, ItemFull)]
uniqueEnemiesOurs [(ActorId, ItemFull)]
-> [(ActorId, ItemFull)] -> [(ActorId, ItemFull)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, ItemFull)]
smartEnemiesOurs of
              [] -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
              (ActorId
enemyAid, ItemFull
_) : [(ActorId, ItemFull)]
_ -> do
                ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
enemyAid
                Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makePhrase [Part -> Part
MU.Capitalize (ActorUI -> Part
partActor ActorUI
bUI)] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?"
            let won :: Bool
won = Bool -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
victoryOutcomes) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome) Maybe Status
toSt
                lost :: Bool
lost = Bool -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
deafeatOutcomes) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome) Maybe Status
toSt
                msgClass :: MsgClassShowAndSave
msgClass | Bool
won = MsgClassShowAndSave
MsgGoodMiscEvent
                         | Bool
lost = MsgClassShowAndSave
MsgBadMiscEvent
                         | Bool
otherwise = MsgClassShowAndSave
MsgNeutralEvent
                (Text
sp2, Text
escPrompt) =
                  if | Bool
lost -> (Text
"", Text
"Accept the unacceptable?")
                     | Bool
smartUniqueEnemyCaptured ->
                       ( Text
"\nOh, wait, who is this, towering behind your escaping crew?" Text -> Text -> Text
<+> Text
smartEnemySentence Text -> Text -> Text
<+> Text
"This changes everything. For everybody. Everywhere. Forever. Did you plan for this? Are you sure it was your idea?"
                       , Text
"What happens now?" )
                     | Bool
smartEnemyCaptured ->
                       ( Text
"\nOh, wait, who is this, hunched among your escaping crew?" Text -> Text -> Text
<+> Text
smartEnemySentence Text -> Text -> Text
<+> Text
"Suddenly, this makes your crazy story credible. Suddenly, the door of knowledge opens again."
                       , Text
"How will you play that move?" )
                     | Bool
otherwise -> (Text
"", Text
"Let's see what we've got here.")
            MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
sp1
            MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel Text
sp2
            m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorFull Text
escPrompt
        case Maybe (FactionAnalytics, GenerationAnalytics)
manalytics of
          Maybe (FactionAnalytics, GenerationAnalytics)
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (FactionAnalytics
factionAn, GenerationAnalytics
generationAn) ->
            [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore []
              [ (ItemBag, Int) -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(ItemBag, Int) -> GenerationAnalytics -> m KM
displayGameOverLoot (ItemBag
itemBag, Int
total) GenerationAnalytics
generationAn
              , SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SOrgan Bool
True GenerationAnalytics
generationAn
              , FactionAnalytics -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
FactionAnalytics -> GenerationAnalytics -> m KM
displayGameOverAnalytics FactionAnalytics
factionAn GenerationAnalytics
generationAn
              , SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SCondition Bool
sexposeItems GenerationAnalytics
generationAn
              , SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SBlast Bool
True GenerationAnalytics
generationAn
              , SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SEmbed Bool
True GenerationAnalytics
generationAn ]
      Bool
go2 <- if Bool
noConfirmsGame then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do
        -- Show score for any UI client after any kind of game exit,
        -- even though it's saved only for human UI clients at game over
        -- (that is not a noConfirms or benchmark game).
        Slideshow
scoreSlides <- Int -> Status -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> Status -> m Slideshow
scoreToSlideshow Int
total Status
status
        KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM
K.spaceKM, KM
K.escKM] Slideshow
scoreSlides
        Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM
      let epilogue :: m ()
epilogue = do
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
camping (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Saving..."
            -- Don't leave frozen old prompts on the browser screen.
            m ()
forall (m :: * -> *). MonadClientUI m => m ()
pushReportFrame
      if Bool
go2 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
noConfirmsGame Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
camping then do
        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
pp Text -> Text -> Text
<+> Text
"(Press RET to have one last look at the arena of your struggle before it gets forgotten.)"
        Slideshow
slides <-
          Bool -> [KM] -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Bool -> [KM] -> m Slideshow
reportToSlideshowKeepHalt Bool
True [KM
K.returnKM, KM
K.spaceKM, KM
K.escKM]
        KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM
K.returnKM, KM
K.spaceKM, KM
K.escKM] Slideshow
slides
        if KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.returnKM then do
          -- Enter aiming mode. At exit, game arena is wiped out.
          LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
          let saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> DetailLevel -> AimMode
AimMode LevelId
lidV DetailLevel
defaultDetailLevel
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess { sreqDelay :: ReqDelay
sreqDelay = ReqDelay
ReqDelayHandled
                                        , Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: Maybe AimMode
saimMode }
        else m ()
epilogue
      else do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
noConfirmsGame Bool -> Bool -> Bool
|| Bool
camping) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          -- The last prompt stays onscreen during shutdown, etc.
          MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
pp
          m ()
epilogue
    (Maybe Status, Maybe Text)
_ ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Part -> Bool
forall a. Maybe a -> Bool
isJust Maybe Part
startingPart Bool -> Bool -> Bool
&& (Status -> Outcome
stOutcome (Status -> Outcome) -> Maybe Status -> Maybe Outcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Status
toSt) Maybe Outcome -> Maybe Outcome -> Bool
forall a. Eq a => a -> a -> Bool
== Outcome -> Maybe Outcome
forall a. a -> Maybe a
Just Outcome
Killed) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"When a whole faction gets eliminated, no new members of the party will ever appear and its stashed belongings may remain far off, unclaimed and undefended. While some adventures require elimination a faction (to be verified in the adventure description screen in the help menu), for others it's an optional task, if possible at all. Instead, finding an exit may be necessary to win. It's enough if one character finds and triggers the exit. Others automatically follow, duly hauling all common belongings."
        -- Needed not to overlook the competitor dying in raid scenario.
        ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull Text
""

displayGameOverLoot :: MonadClientUI m
                    => (ItemBag, Int) -> GenerationAnalytics -> m K.KM
displayGameOverLoot :: (ItemBag, Int) -> GenerationAnalytics -> m KM
displayGameOverLoot (ItemBag
heldBag, Int
total) GenerationAnalytics
generationAn = do
  ClientOptions{Bool
sexposeItems :: Bool
sexposeItems :: ClientOptions -> Bool
sexposeItems} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ItemSlots EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
  -- 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
      lSlotsRaw :: SingleItemSlots
lSlotsRaw = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
heldBag) (SingleItemSlots -> SingleItemSlots)
-> SingleItemSlots -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SItem
      generationItem :: EnumMap ItemId Int
generationItem = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SItem
      (ItemBag
itemBag, SingleItemSlots
lSlots) =
        if Bool
sexposeItems
        then let generationBag :: ItemBag
generationBag = (Int -> (Int, [ItemTimer])) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\Int
k -> (-Int
k, [])) EnumMap ItemId Int
generationItem
                 bag :: ItemBag
bag = ItemBag
heldBag ItemBag -> ItemBag -> ItemBag
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` ItemBag
generationBag
                 slots :: SingleItemSlots
slots = [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
             in (ItemBag
bag, SingleItemSlots
slots)
        else (ItemBag
heldBag, SingleItemSlots
lSlotsRaw)
      promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun ItemId
iid ItemFull
itemFull2 Int
k =
        let worth :: Int
worth = Int -> ItemKind -> Int
itemPrice Int
1 (ItemKind -> Int) -> ItemKind -> Int
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull2
            lootMsg :: Text
lootMsg = if Int
worth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Text
"" else
              let pile :: Part
pile = if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then Part
"exemplar" else Part
"hoard"
              in [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
                   [Part
"this treasure", Part
pile, Part
"is worth"]
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ (if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then [ Int -> Part
MU.Cardinal Int
k, Part
"times"] else [])
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Int -> Part -> Part
MU.CarWs Int
worth (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
currencyName]
            holdsMsg :: Text
holdsMsg =
              let n :: Int
n = EnumMap ItemId Int
generationItem EnumMap ItemId Int -> ItemId -> Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
              in if | Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
                      Text
"You keep the only specimen extant:"
                    | Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
                      Text
"You don't have the only hypothesized specimen:"
                    | Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                      Text
"No such specimen was recorded:"
                    | Bool
otherwise ->
                        [Part] -> Text
makePhrase [ Part
"You hold"
                                   , if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
                                     then Part
"all pieces"
                                     else Int -> Part -> Part
MU.CardinalAWs (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
k) Part
"piece"
                                   , Part
"out of"
                                   , Int -> Part
MU.Car Int
n
                                   , Part
"scattered:" ]
        in Text
lootMsg Text -> Text -> Text
<+> Text
holdsMsg
  Int
dungeonTotal <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Int
sgold
  let promptGold :: Text
promptGold = Text -> Int -> Int -> Text
spoilsBlurb Text
currencyName Int
total Int
dungeonTotal
      -- Total number of items is meaningless in the presence of so much junk.
      prompt :: Text
prompt =
        Text
promptGold
        Text -> Text -> Text
<+> (if Bool
sexposeItems
             then Text
"Non-positive count means none held but this many generated."
             else Text
"")
  [Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> Bool
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> Bool
-> m KM
viewLoreItems [Char]
"GameOverLoot" SingleItemSlots
lSlots ItemBag
itemBag Text
prompt ItemId -> ItemFull -> Int -> Text
promptFun Bool
True

displayGameOverAnalytics :: MonadClientUI m
                         => FactionAnalytics -> GenerationAnalytics
                         -> m K.KM
displayGameOverAnalytics :: FactionAnalytics -> GenerationAnalytics -> m KM
displayGameOverAnalytics FactionAnalytics
factionAn GenerationAnalytics
generationAn = do
  ClientOptions{Bool
sexposeActors :: ClientOptions -> Bool
sexposeActors :: Bool
sexposeActors} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ItemSlots EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
  let ourAn :: EnumMap KillHow KillMap
ourAn = Analytics -> EnumMap KillHow KillMap
akillCounts
              (Analytics -> EnumMap KillHow KillMap)
-> Analytics -> EnumMap KillHow KillMap
forall a b. (a -> b) -> a -> b
$ Analytics -> FactionId -> FactionAnalytics -> Analytics
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Analytics
emptyAnalytics FactionId
side FactionAnalytics
factionAn
      foesAn :: EnumMap ItemId Int
foesAn = (Int -> Int -> Int) -> [EnumMap ItemId Int] -> EnumMap ItemId Int
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
               ([EnumMap ItemId Int] -> EnumMap ItemId Int)
-> [EnumMap ItemId Int] -> EnumMap ItemId Int
forall a b. (a -> b) -> a -> b
$ (KillMap -> [EnumMap ItemId Int])
-> [KillMap] -> [EnumMap ItemId Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap KillMap -> [EnumMap ItemId Int]
forall k a. EnumMap k a -> [a]
EM.elems ([KillMap] -> [EnumMap ItemId Int])
-> [KillMap] -> [EnumMap ItemId Int]
forall a b. (a -> b) -> a -> b
$ [Maybe KillMap] -> [KillMap]
forall a. [Maybe a] -> [a]
catMaybes
               ([Maybe KillMap] -> [KillMap]) -> [Maybe KillMap] -> [KillMap]
forall a b. (a -> b) -> a -> b
$ (KillHow -> Maybe KillMap) -> [KillHow] -> [Maybe KillMap]
forall a b. (a -> b) -> [a] -> [b]
map (KillHow -> EnumMap KillHow KillMap -> Maybe KillMap
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap KillHow KillMap
ourAn) [KillHow
KillKineticMelee .. KillHow
KillOtherPush]
      trunkBagRaw :: ItemBag
trunkBagRaw = (Int -> (Int, [ItemTimer])) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (, []) EnumMap ItemId Int
foesAn
      lSlotsRaw :: SingleItemSlots
lSlotsRaw = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
trunkBagRaw) (SingleItemSlots -> SingleItemSlots)
-> SingleItemSlots -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
      killedBag :: ItemBag
killedBag = [(ItemId, (Int, [ItemTimer]))] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, (Int, [ItemTimer]))] -> ItemBag)
-> [(ItemId, (Int, [ItemTimer]))] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, (Int, [ItemTimer])))
-> [ItemId] -> [(ItemId, (Int, [ItemTimer]))]
forall a b. (a -> b) -> [a] -> [b]
map (\ItemId
iid -> (ItemId
iid, ItemBag
trunkBagRaw ItemBag -> ItemId -> (Int, [ItemTimer])
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid))
                                    (SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlotsRaw)
      generationTrunk :: EnumMap ItemId Int
generationTrunk = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
      (ItemBag
trunkBag, SingleItemSlots
lSlots) =
        if Bool
sexposeActors
        then let generationBag :: ItemBag
generationBag = (Int -> (Int, [ItemTimer])) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\Int
k -> (-Int
k, [])) EnumMap ItemId Int
generationTrunk
                 bag :: ItemBag
bag = ItemBag
killedBag ItemBag -> ItemBag -> ItemBag
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` ItemBag
generationBag
                 slots :: SingleItemSlots
slots = [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
             in (ItemBag
bag, SingleItemSlots
slots)
        else (ItemBag
killedBag, SingleItemSlots
lSlotsRaw)
      total :: Int
total = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Int, [ItemTimer]) -> Int) -> [(Int, [ItemTimer])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [ItemTimer]) -> Int
forall a b. (a, b) -> a
fst ([(Int, [ItemTimer])] -> [Int]) -> [(Int, [ItemTimer])] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(Int, [ItemTimer])]
forall k a. EnumMap k a -> [a]
EM.elems ItemBag
trunkBag
      -- Not just "killed 1 out of 4", because it's sometimes "2 out of 1",
      -- if an enemy was revived.
      promptFun :: ItemId -> ItemFull-> Int -> Text
      promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun ItemId
iid ItemFull
_ Int
k =
        let n :: Int
n = EnumMap ItemId Int
generationTrunk EnumMap ItemId Int -> ItemId -> Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
        in [Part] -> Text
makePhrase [ Part
"You recall the adversary, which you killed on"
                      , Int -> Part -> Part
MU.CarWs (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
k) Part
"occasion", Part
"while reports mention"
                      , Int -> Part -> Part
MU.CarWs Int
n Part
"individual", Part
"in total:" ]
      prompt :: Text
prompt =
        [Part] -> Text
makeSentence [Part
"your team vanquished", Int -> Part -> Part
MU.CarWs Int
total Part
"adversary"]
          -- total reported would include our own, so not given
        Text -> Text -> Text
<+> (if Bool
sexposeActors
             then Text
"Non-positive count means none killed but this many reported."
             else Text
"")
  [Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> Bool
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> Bool
-> m KM
viewLoreItems [Char]
"GameOverAnalytics" SingleItemSlots
lSlots ItemBag
trunkBag Text
prompt ItemId -> ItemFull -> Int -> Text
promptFun Bool
False

displayGameOverLore :: MonadClientUI m
                    => SLore -> Bool -> GenerationAnalytics -> m K.KM
displayGameOverLore :: SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
slore Bool
exposeCount GenerationAnalytics
generationAn = do
  let generationLore :: EnumMap ItemId Int
generationLore = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
      generationBag :: ItemBag
generationBag = (Int -> (Int, [ItemTimer])) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\Int
k -> (if Bool
exposeCount then Int
k else Int
1, []))
                             EnumMap ItemId Int
generationLore
      total :: Int
total = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, [ItemTimer]) -> Int) -> [(Int, [ItemTimer])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [ItemTimer]) -> Int
forall a b. (a, b) -> a
fst ([(Int, [ItemTimer])] -> [Int]) -> [(Int, [ItemTimer])] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(Int, [ItemTimer])]
forall k a. EnumMap k a -> [a]
EM.elems ItemBag
generationBag
      slots :: SingleItemSlots
slots = [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
generationBag
      promptFun :: ItemId -> ItemFull-> Int -> Text
      promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun ItemId
_ ItemFull
_ Int
k =
        [Part] -> Text
makeSentence
          [ Part
"this", Text -> Part
MU.Text (SLore -> Text
ppSLore SLore
slore), Part
"manifested during your quest"
          , Int -> Part -> Part
MU.CarWs Int
k Part
"time" ]
      verb :: Part
verb = if | SLore
slore SLore -> [SLore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SLore
SCondition, SLore
SBlast] -> Part
"experienced"
                | SLore
slore SLore -> SLore -> Bool
forall a. Eq a => a -> a -> Bool
== SLore
SEmbed -> Part
"strived through"
                | Bool
otherwise -> Part
"lived among"
      prompt :: Text
prompt = case Int
total of
        Int
0 -> [Part] -> Text
makeSentence [ Part
"you didn't experience any"
                          , Part -> Part
MU.Ws (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore)
                          , Part
"this time" ]
        Int
1 -> [Part] -> Text
makeSentence [ Part
"you", Part
verb, Part
"the following"
                          , Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore) ]
        Int
_ -> [Part] -> Text
makeSentence [ Part
"you", Part
verb, Part
"the following variety of"
                          , Int -> Part -> Part
MU.CarWs Int
total (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore) ]
      displayRanged :: Bool
displayRanged = SLore
slore SLore -> [SLore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [SLore
SOrgan, SLore
STrunk]
  [Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> Bool
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> Bool
-> m KM
viewLoreItems ([Char]
"GameOverLore" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SLore -> [Char]
forall a. Show a => a -> [Char]
show SLore
slore)
                SingleItemSlots
slots ItemBag
generationBag Text
prompt ItemId -> ItemFull -> Int -> Text
promptFun Bool
displayRanged

viewLoreItems :: forall m . MonadClientUI m
              => String -> SingleItemSlots -> ItemBag -> Text
              -> (ItemId -> ItemFull -> Int -> Text)
              -> Bool
              -> m K.KM
viewLoreItems :: [Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> Bool
-> m KM
viewLoreItems [Char]
menuName SingleItemSlots
lSlotsRaw ItemBag
trunkBag Text
prompt ItemId -> ItemFull -> Int -> Text
promptFun Bool
displayRanged = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth, Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  FontSetup{DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
  let keysPre :: [KM]
keysPre = [KM
K.spaceKM, Char -> KM
K.mkChar Char
'<', Char -> KM
K.mkChar Char
'>', KM
K.escKM]
      lSlots :: SingleItemSlots
lSlots = (ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF SingleItemSlots
lSlotsRaw
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt
  OKX
io <- SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
itemOverlay SingleItemSlots
lSlots LevelId
arena ItemBag
trunkBag Bool
displayRanged
  Slideshow
itemSlides <- 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]
keysPre OKX
io
  let keyOfEKM :: Either KM SlotChar -> KM
keyOfEKM (Left KM
km) = KM
km
      keyOfEKM (Right SlotChar{Char
slotChar :: SlotChar -> Char
slotChar :: Char
slotChar}) = Char -> KM
K.mkChar Char
slotChar
      allOKX :: [KYX]
allOKX = (OKX -> [KYX]) -> [OKX] -> [KYX]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [KYX]
forall a b. (a, b) -> b
snd ([OKX] -> [KYX]) -> [OKX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ Slideshow -> [OKX]
slideshow Slideshow
itemSlides
      keysMain :: [KM]
keysMain = [KM]
keysPre [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ (KYX -> KM) -> [KYX] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Either KM SlotChar -> KM
keyOfEKM (Either KM SlotChar -> KM)
-> (KYX -> Either KM SlotChar) -> KYX -> KM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KYX -> Either KM SlotChar
forall a b. (a, b) -> a
fst) [KYX]
allOKX
      displayInRightPane :: KeyOrSlot -> m OKX
      displayInRightPane :: Either KM SlotChar -> m OKX
displayInRightPane Either KM SlotChar
ekm = case Either KM SlotChar
ekm of
        Either KM SlotChar
_ | DisplayFont -> Bool
isSquareFont DisplayFont
propFont -> OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return OKX
emptyOKX
        Left{} -> OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return OKX
emptyOKX
        Right SlotChar
slot -> do
          let ix0 :: Int
ix0 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ SlotChar -> [Char]
forall a. Show a => a -> [Char]
show SlotChar
slot)
                              (SlotChar -> [SlotChar] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex SlotChar
slot ([SlotChar] -> Maybe Int) -> [SlotChar] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [SlotChar]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys SingleItemSlots
lSlots)
          -- Mono font used, because lots of numbers in these blurbs
          -- and because some prop fonts wider than mono (e.g., in the
          -- dejavuBold font set).
          -- Lower width, to permit extra vertical space at the start,
          -- because gameover menu prompts are sometimes wide and/or long.
          DisplayFont
-> Int
-> Bool
-> ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m OKX
forall (m :: * -> *).
MonadClientUI m =>
DisplayFont
-> Int
-> Bool
-> ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m OKX
okxItemLorePointedAt
            DisplayFont
monoFont (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Bool
True ItemBag
trunkBag Int
0 ItemId -> ItemFull -> Int -> Text
promptFun Int
ix0 SingleItemSlots
lSlots
      viewAtSlot :: SlotChar -> m K.KM
      viewAtSlot :: SlotChar -> m KM
viewAtSlot SlotChar
slot = do
        let ix0 :: Int
ix0 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ SlotChar -> [Char]
forall a. Show a => a -> [Char]
show SlotChar
slot)
                            (SlotChar -> [SlotChar] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex SlotChar
slot ([SlotChar] -> Maybe Int) -> [SlotChar] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [SlotChar]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys SingleItemSlots
lSlots)
        KM
km <- ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
displayItemLore ItemBag
trunkBag Int
0 ItemId -> ItemFull -> Int -> Text
promptFun Int
ix0 SingleItemSlots
lSlots Bool
False
        case KM -> Key
K.key KM
km of
          Key
K.Space -> [Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> Bool
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> Bool
-> m KM
viewLoreItems [Char]
menuName SingleItemSlots
lSlots ItemBag
trunkBag Text
prompt
                                   ItemId -> ItemFull -> Int -> Text
promptFun Bool
displayRanged
          Key
K.Esc -> KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
          Key
_ -> [Char] -> m KM
forall a. HasCallStack => [Char] -> a
error ([Char] -> m KM) -> [Char] -> m KM
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> KM -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` KM
km
  Either KM SlotChar
ekm <- (Either KM SlotChar -> m OKX)
-> [Char]
-> ColorMode
-> Bool
-> Slideshow
-> [KM]
-> m (Either KM SlotChar)
forall (m :: * -> *).
MonadClientUI m =>
(Either KM SlotChar -> m OKX)
-> [Char]
-> ColorMode
-> Bool
-> Slideshow
-> [KM]
-> m (Either KM SlotChar)
displayChoiceScreenWithRightPane Either KM SlotChar -> m OKX
displayInRightPane
           [Char]
menuName ColorMode
ColorFull Bool
False Slideshow
itemSlides [KM]
keysMain
  case Either KM SlotChar
ekm of
    Left KM
km | KM
km KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM
K.spaceKM, Char -> KM
K.mkChar Char
'<', Char -> KM
K.mkChar Char
'>', KM
K.escKM] ->
      KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
    Left K.KM{key :: KM -> Key
key=K.Char Char
l} -> SlotChar -> m KM
viewAtSlot (SlotChar -> m KM) -> SlotChar -> m KM
forall a b. (a -> b) -> a -> b
$ Int -> Char -> SlotChar
SlotChar Int
0 Char
l
      -- other prefixes are not accessible via keys; tough luck; waste of effort
    Left KM
km -> [Char] -> m KM
forall a. HasCallStack => [Char] -> a
error ([Char] -> m KM) -> [Char] -> m KM
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> KM -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` KM
km
    Right SlotChar
slot -> SlotChar -> m KM
viewAtSlot SlotChar
slot