{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Client.UI.Watch.WatchQuitM
( quitFactionUI
#ifdef EXPOSE_INTERNAL
, 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
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"
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
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
""
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
(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
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..."
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
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
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."
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
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
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
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"]
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)
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
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