{-# 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
  , viewFinalLore
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
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 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.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.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           Game.LambdaHack.Content.FactionKind
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 :: forall (m :: * -> *).
MonadClientUI m =>
FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
quitFactionUI FactionId
fid Maybe Status
toSt Maybe (FactionAnalytics, GenerationAnalytics)
manalytics = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  gameModeId <- getsState sgameModeId
  when (side == fid) $ case toSt of
    Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Camping} ->
      (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 {scampings = ES.insert gameModeId $ scampings sess}
    Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Restart} ->
      (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 {srestarts = ES.insert gameModeId $ srestarts sess}
    Just Status{Outcome
stOutcome :: Status -> Outcome
stOutcome :: Outcome
stOutcome} | Outcome
stOutcome Outcome -> [Outcome] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
victoryOutcomes -> do
      scurChal <- (StateClient -> Challenge) -> m Challenge
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
scurChal
      let sing = Challenge -> Int -> Map Challenge Int
forall k a. k -> a -> Map k a
M.singleton Challenge
scurChal Int
1
          f = (Int -> Int -> Int)
-> Map Challenge Int -> Map Challenge Int -> Map Challenge Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
          g = (Map Challenge Int -> Map Challenge Int -> Map Challenge Int)
-> ContentId ModeKind
-> Map Challenge Int
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Map Challenge Int -> Map Challenge Int -> Map Challenge Int
f ContentId ModeKind
gameModeId Map Challenge Int
sing
      modifySession $ \SessionUI
sess -> SessionUI
sess {svictories = g $ svictories sess}
    Maybe Status
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ClientOptions{sexposeItems} <- getsClient soptions
  fact <- getsState $ (EM.! fid) . sfactionD
  let fidName = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
      person = if FactionKind -> Bool
fhasGender (FactionKind -> Bool) -> FactionKind -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact then Person
MU.PlEtc else Person
MU.Sg3rd
      horror = Faction -> Bool
isHorrorFact Faction
fact
      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
  when (fid == side && not camping) $ do
    tellGameClipPS
    resetGameStart
  gameMode <- getGameMode
  allNframes <- getsSession sallNframes
  let 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} ->
          String -> Maybe Part
forall a. HasCallStack => String -> a
error (String -> Maybe Part) -> String -> Maybe Part
forall a b. (a -> b) -> a -> b
$ String
"" String -> (FactionId, Maybe Status) -> String
forall v. Show v => String -> v -> String
`showFailure` (FactionId
fid, Maybe Status
toSt)
        Just Status{Outcome
stOutcome :: Status -> Outcome
stOutcome :: 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 = 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 :: Status -> Outcome
stOutcome :: 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 = 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 startingPart of
    Maybe Part
Nothing -> () -> m ()
forall a. a -> m a
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 (toSt, partingPart) of
    (Just Status
status, Just Text
pp) -> do
      noConfirmsGame <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
      go <- if noConfirmsGame
            then return False
            else displaySpaceEsc ColorFull ""  -- short, just @startingPart@
      recordHistory
        -- we are going to exit or restart, so record and clear, but only once
      (itemBag, total) <- getsState $ calculateTotal side
      when go $ do
        case middlePart of
          Maybe Text
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Text
sp1 -> do
            factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
            itemToF <- getsState $ flip itemToFull
            let 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)
            ourTrunks <- getsState $ map getTrunkFull
                                     . fidActorNotProjGlobalAssocs side
            let smartFaction Faction
fact2 = FactionKind -> Bool
fhasPointman (Faction -> FactionKind
gkind Faction
fact2)
                canBeSmart = ((a, Faction) -> Bool) -> Frequency (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)
-> Frequency (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
trunkFull =
                  let possible :: Frequency (FactionId, Faction)
possible =
                        [GroupName ItemKind]
-> ItemKind
-> EnumMap FactionId Faction
-> Frequency (FactionId, Faction)
possibleActorFactions [] (ItemFull -> ItemKind
itemKind ItemFull
trunkFull) EnumMap FactionId Faction
factionD
                  in Bool -> Bool
not (Frequency (FactionId, Faction) -> Bool
canBeOurFaction Frequency (FactionId, Faction)
possible) Bool -> Bool -> Bool
&& Frequency (FactionId, Faction) -> Bool
forall {a}. Frequency (a, Faction) -> Bool
canBeSmart Frequency (FactionId, Faction)
possible
                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
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) -> 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 -> 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 -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(ActorId, ItemFull)] -> Bool
forall a. [a] -> Bool
null [(ActorId, ItemFull)]
smartEnemiesOurs
            smartEnemySentence <- case uniqueEnemiesOurs ++ smartEnemiesOurs of
              [] -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
              (ActorId
enemyAid, ItemFull
_) : [(ActorId, ItemFull)]
_ -> do
                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
enemyAid
                return $! makePhrase [MU.Capitalize (partActor bUI)] <> "?"
            let won = Bool -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Outcome -> [Outcome] -> Bool
forall a. Eq a => a -> [a] -> 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 -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Outcome -> [Outcome] -> Bool
forall a. Eq a => a -> [a] -> 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 | Bool
won = MsgClassShowAndSave
MsgGoodMiscEvent
                         | Bool
lost = MsgClassShowAndSave
MsgBadMiscEvent
                         | Bool
otherwise = MsgClassShowAndSave
MsgNeutralEvent
                (sp2, escPrompt) =
                  if | lost -> ("", "Accept the unacceptable?")
                     | smartUniqueEnemyCaptured ->
                       ( "\nOh, wait, who is this, towering behind your escaping crew?" <+> smartEnemySentence <+> "This changes everything. For everybody. Everywhere. Forever. Did you plan for this? Are you sure it was your idea?"
                       , "What happens now?" )
                     | smartEnemyCaptured ->
                       ( "\nOh, wait, who is this, hunched among your escaping crew?" <+> smartEnemySentence <+> "Suddenly, this makes your crazy story credible. Suddenly, the door of knowledge opens again."
                       , "How will you play that move?" )
                     | otherwise -> ("", "Let's see what we've got here.")
            msgAdd msgClass sp1
            msgAdd MsgFactionIntel sp2
            void $ displaySpaceEsc ColorFull escPrompt
        case manalytics of
          Maybe (FactionAnalytics, GenerationAnalytics)
Nothing -> () -> m ()
forall a. a -> m a
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 ]
      go2 <- if noConfirmsGame then return 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).
        scoreSlides <- scoreToSlideshow total status
        km <- getConfirms ColorFull [K.spaceKM, K.escKM] scoreSlides
        return $! km == K.spaceKM
      let 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 go2 && not noConfirmsGame && not camping then do
        msgAdd MsgPromptGeneric $ pp <+> "(Press RET to have one last look at the arena of your struggle before it gets forgotten.)"
        slides <-
          reportToSlideshowKeepHalt True [K.returnKM, K.spaceKM, K.escKM]
        km <- getConfirms ColorFull [K.returnKM, K.spaceKM, K.escKM] slides
        if km == K.returnKM then do
          -- Enter aiming mode. At exit, game arena is wiped out.
          lidV <- viewedLevelUI
          let 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
          modifySession $ \SessionUI
sess -> SessionUI
sess { sreqDelay = ReqDelayHandled
                                        , saimMode }
        else epilogue
      else do
        when (not noConfirmsGame || camping) $ do
          -- The last prompt stays onscreen during shutdown, etc.
          msgAdd MsgPromptGeneric pp
          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. Similarly, if eliminating foes ends a challenge, it happens immediately, with no need to move party members anywhere."
        -- Needed not to overlook the competitor dying in raid scenario.
        ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull Text
"This is grave news. What now?"

displayGameOverLoot :: MonadClientUI m
                    => (ItemBag, Int) -> GenerationAnalytics -> m K.KM
displayGameOverLoot :: forall (m :: * -> *).
MonadClientUI m =>
(ItemBag, Int) -> GenerationAnalytics -> m KM
displayGameOverLoot (ItemBag
heldBag, Int
total) GenerationAnalytics
generationAn = do
  ClientOptions{sexposeItems} <- (StateClient -> ClientOptions) -> m ClientOptions
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  COps{coitem} <- getsState scops
  -- We assume "gold grain", not "grain" with label "of gold":
  let 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
      generationItem = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SItem
      itemBag =
        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
             in ItemBag
heldBag ItemBag -> ItemBag -> ItemBag
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` ItemBag
generationBag
        else ItemBag
heldBag
      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
  dungeonTotal <- getsState sgold
  let 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
promptGold
        Text -> Text -> Text
<+> (if Bool
sexposeItems
             then Text
"Non-positive count means none held but this many generated."
             else Text
"")
  viewFinalLore "GameOverLoot" itemBag prompt promptFun (MLore SItem)

displayGameOverAnalytics :: MonadClientUI m
                         => FactionAnalytics -> GenerationAnalytics
                         -> m K.KM
displayGameOverAnalytics :: forall (m :: * -> *).
MonadClientUI m =>
FactionAnalytics -> GenerationAnalytics -> m KM
displayGameOverAnalytics FactionAnalytics
factionAn GenerationAnalytics
generationAn = do
  ClientOptions{sexposeActors} <- (StateClient -> ClientOptions) -> m ClientOptions
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  side <- getsClient sside
  ItemRoles itemRoles <- getsSession sroles
  let 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 = (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
$ (KillHow -> Maybe KillMap) -> [KillHow] -> [KillMap]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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]
      killedBagIncludingProjectiles = (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
      killedBag = (ItemId -> (Int, [ItemTimer]) -> Bool) -> ItemBag -> ItemBag
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey
                    (\ItemId
iid (Int, [ItemTimer])
_ -> ItemId
iid ItemId -> EnumSet ItemId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` (EnumMap SLore (EnumSet ItemId)
itemRoles EnumMap SLore (EnumSet ItemId) -> SLore -> EnumSet ItemId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk))
                    ItemBag
killedBagIncludingProjectiles
      generationTrunk = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
      trunkBag =
        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
             in ItemBag
killedBag ItemBag -> ItemBag -> ItemBag
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` ItemBag
generationBag
        else ItemBag
killedBag
      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
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 =
        [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
"")
  viewFinalLore "GameOverAnalytics" trunkBag prompt promptFun (MLore STrunk)

displayGameOverLore :: MonadClientUI m
                    => SLore -> Bool -> GenerationAnalytics -> m K.KM
displayGameOverLore :: forall (m :: * -> *).
MonadClientUI m =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
slore Bool
exposeCount GenerationAnalytics
generationAn = do
  itemD <- (State -> ItemDict) -> m ItemDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
  let -- In @sexposeItems@ mode this filtering passes all through
      -- thanks to @revealItems@.
      generationLore = (ItemId -> Int -> Bool) -> EnumMap ItemId Int -> EnumMap ItemId Int
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey (\ItemId
iid Int
_ -> ItemId
iid ItemId -> ItemDict -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemDict
itemD)
                       (EnumMap ItemId Int -> EnumMap ItemId Int)
-> EnumMap ItemId Int -> EnumMap ItemId Int
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
      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] -> 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
      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 = if | SLore
slore SLore -> [SLore] -> Bool
forall a. Eq a => a -> [a] -> 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
"ambled among"
                | Bool
otherwise -> Part
"lived among"
      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 saw 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) ]
  viewFinalLore ("GameOverLore" ++ show slore)
                generationBag prompt promptFun (MLore slore)

viewFinalLore :: forall m . MonadClientUI m
              => String -> ItemBag -> Text
              -> (ItemId -> ItemFull -> Int -> Text)
              -> ItemDialogMode
              -> m K.KM
viewFinalLore :: forall (m :: * -> *).
MonadClientUI m =>
String
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> ItemDialogMode
-> m KM
viewFinalLore String
menuName ItemBag
trunkBag Text
prompt ItemId -> ItemFull -> Int -> Text
promptFun ItemDialogMode
dmode = do
  CCUI{coscreen=ScreenContent{rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  itemToF <- getsState $ flip itemToFull
  let iids = (ItemId -> ItemFull)
-> [(ItemId, (Int, [ItemTimer]))] -> [(ItemId, (Int, [ItemTimer]))]
sortIids ItemId -> ItemFull
itemToF ([(ItemId, (Int, [ItemTimer]))] -> [(ItemId, (Int, [ItemTimer]))])
-> [(ItemId, (Int, [ItemTimer]))] -> [(ItemId, (Int, [ItemTimer]))]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, (Int, [ItemTimer]))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
trunkBag
      viewAtSlot :: MenuSlot -> m K.KM
      viewAtSlot MenuSlot
slot = do
        let renderOneItem :: MenuSlot -> m OKX
renderOneItem = (ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, (Int, [ItemTimer]))]
-> MenuSlot
-> m OKX
forall (m :: * -> *).
MonadClientUI m =>
(ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, (Int, [ItemTimer]))]
-> MenuSlot
-> m OKX
okxItemLoreMsg ItemId -> ItemFull -> Int -> Text
promptFun Int
0 ItemDialogMode
dmode [(ItemId, (Int, [ItemTimer]))]
iids
            extraKeys :: [a]
extraKeys = []
            slotBound :: Int
slotBound = [(ItemId, (Int, [ItemTimer]))] -> Int
forall a. [a] -> Int
length [(ItemId, (Int, [ItemTimer]))]
iids Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
forall a. [a]
extraKeys Int
slotBound MenuSlot
slot
        case K.key km of
          Key
K.Space -> String
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> ItemDialogMode
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
String
-> ItemBag
-> Text
-> (ItemId -> ItemFull -> Int -> Text)
-> ItemDialogMode
-> m KM
viewFinalLore String
menuName ItemBag
trunkBag Text
prompt ItemId -> ItemFull -> Int -> Text
promptFun ItemDialogMode
dmode
          Key
K.Esc -> KM -> m KM
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
          Key
_ -> String -> m KM
forall a. HasCallStack => String -> a
error (String -> m KM) -> String -> m KM
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
  msgAdd MsgPromptGeneric prompt
  let keys = [KM
K.spaceKM, Char -> KM
K.mkChar Char
'<', Char -> KM
K.mkChar Char
'>', KM
K.escKM]
  okx <- itemOverlay iids dmode
  sli <- overlayToSlideshow (rheight - 2) keys okx
  ekm <- displayChoiceScreenWithDefItemKey
           (okxItemLoreInline promptFun 0 dmode iids) sli keys menuName
  case ekm of
    Left KM
km | KM
km KM -> [KM] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys -> KM -> m KM
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
    Left KM
km -> String -> m KM
forall a. HasCallStack => String -> a
error (String -> m KM) -> String -> m KM
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
    Right MenuSlot
slot -> MenuSlot -> m KM
viewAtSlot MenuSlot
slot