File: WatchQuitM.hs

package info (click to toggle)
haskell-lambdahack 0.11.0.1-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 4,056 kB
  • sloc: haskell: 45,636; makefile: 219
file content (353 lines) | stat: -rw-r--r-- 17,765 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
{-# 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 fid toSt manalytics = do
  side <- getsClient sside
  gameModeId <- getsState sgameModeId
  when (side == fid) $ case toSt of
    Just Status{stOutcome=Camping} ->
      modifySession $ \sess ->
        sess {scampings = ES.insert gameModeId $ scampings sess}
    Just Status{stOutcome=Restart} ->
      modifySession $ \sess ->
        sess {srestarts = ES.insert gameModeId $ srestarts sess}
    Just Status{stOutcome} | stOutcome `elem` victoryOutcomes -> do
      scurChal <- getsClient scurChal
      let sing = M.singleton scurChal 1
          f = M.unionWith (+)
          g = EM.insertWith f gameModeId sing
      modifySession $ \sess -> sess {svictories = g $ svictories sess}
    _ -> return ()
  ClientOptions{sexposeItems} <- getsClient soptions
  fact <- getsState $ (EM.! fid) . sfactionD
  let fidName = MU.Text $ gname fact
      person = if fhasGender $ gkind fact then MU.PlEtc else MU.Sg3rd
      horror = isHorrorFact fact
      camping = maybe True ((== Camping) . stOutcome) toSt
  when (fid == side && not camping) $ do
    tellGameClipPS
    resetGameStart
  gameMode <- getGameMode
  allNframes <- getsSession sallNframes
  let startingPart = case toSt of
        _ | horror -> Nothing  -- Ignore summoned actors' factions.
        Just Status{stOutcome=stOutcome@Restart, stNewGame=Just gn} ->
          Just $ MU.Text $ nameOutcomeVerb stOutcome
                           <+> "to restart in"
                           <+> displayGroupName gn
                           <+> "mode"
                             -- when multiplayer: "order mission restart in"
        Just Status{stOutcome=Restart, stNewGame=Nothing} ->
          error $ "" `showFailure` (fid, toSt)
        Just Status{stOutcome} -> Just $ MU.Text $ nameOutcomeVerb stOutcome
          -- when multiplayer, for @Camping@: "order save and exit"
        Nothing -> Nothing
      middlePart = case toSt of
        _ | fid /= side -> Nothing
        Just Status{stOutcome} -> lookup stOutcome $ mendMsg gameMode
        Nothing -> Nothing
      partingPart = if fid /= side || allNframes == -1
                    then Nothing
                    else endMessageOutcome . stOutcome <$> toSt
  case startingPart of
    Nothing -> return ()
    Just sp ->
      let blurb = makeSentence [MU.SubjectVerb person MU.Yes fidName sp]
      in msgLnAdd MsgFinalOutcome blurb
  case (toSt, partingPart) of
    (Just status, Just pp) -> do
      noConfirmsGame <- 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
          Nothing -> return ()
          Just sp1 -> do
            factionD <- getsState sfactionD
            itemToF <- getsState $ flip itemToFull
            let getTrunkFull (aid, b) = (aid, itemToF $ btrunk b)
            ourTrunks <- getsState $ map getTrunkFull
                                     . fidActorNotProjGlobalAssocs side
            let smartFaction fact2 = fhasPointman (gkind fact2)
                canBeSmart = any (smartFaction . snd)
                canBeOurFaction = any (\(fid2, _) -> fid2 == side)
                smartEnemy trunkFull =
                  let possible =
                        possibleActorFactions [] (itemKind trunkFull) factionD
                  in not (canBeOurFaction possible) && canBeSmart possible
                smartEnemiesOurs = filter (smartEnemy . snd) ourTrunks
                uniqueActor trunkFull = IA.checkFlag Ability.Unique
                                        $ aspectRecordFull trunkFull
                uniqueEnemiesOurs = filter (uniqueActor . snd) smartEnemiesOurs
                smartUniqueEnemyCaptured = not $ null uniqueEnemiesOurs
                smartEnemyCaptured = not $ null smartEnemiesOurs
            smartEnemySentence <- case uniqueEnemiesOurs ++ smartEnemiesOurs of
              [] -> return ""
              (enemyAid, _) : _ -> do
                bUI <- getsSession $ getActorUI enemyAid
                return $! makePhrase [MU.Capitalize (partActor bUI)] <> "?"
            let won = maybe False ((`elem` victoryOutcomes) . stOutcome) toSt
                lost = maybe False ((`elem` deafeatOutcomes) . stOutcome) toSt
                msgClass | won = MsgGoodMiscEvent
                         | lost = MsgBadMiscEvent
                         | otherwise = 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
          Nothing -> return ()
          Just (factionAn, generationAn) ->
            cycleLore []
              [ displayGameOverLoot (itemBag, total) generationAn
              , displayGameOverLore SOrgan True generationAn
              , displayGameOverAnalytics factionAn generationAn
              , displayGameOverLore SCondition sexposeItems generationAn
              , displayGameOverLore SBlast True generationAn
              , displayGameOverLore SEmbed True 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
            when camping $ msgAdd MsgPromptGeneric "Saving..."
            -- Don't leave frozen old prompts on the browser screen.
            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 = Just $ AimMode lidV defaultDetailLevel
          modifySession $ \sess -> 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
    _ ->
      when (isJust startingPart && (stOutcome <$> toSt) == Just Killed) $ do
        msgAdd MsgTutorialHint "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.
        displayMore ColorFull "This is grave news. What now?"

displayGameOverLoot :: MonadClientUI m
                    => (ItemBag, Int) -> GenerationAnalytics -> m K.KM
displayGameOverLoot (heldBag, total) generationAn = do
  ClientOptions{sexposeItems} <- getsClient soptions
  COps{coitem} <- getsState scops
  -- We assume "gold grain", not "grain" with label "of gold":
  let currencyName = IK.iname $ okind coitem $ ouniqGroup coitem IK.S_CURRENCY
      generationItem = generationAn EM.! SItem
      itemBag =
        if sexposeItems
        then let generationBag = EM.map (\k -> (-k, [])) generationItem
             in heldBag `EM.union` generationBag
        else heldBag
      promptFun iid itemFull2 k =
        let worth = itemPrice 1 $ itemKind itemFull2
            lootMsg = if worth == 0 then "" else
              let pile = if k <= 1 then "exemplar" else "hoard"
              in makeSentence $
                   ["this treasure", pile, "is worth"]
                   ++ (if k > 1 then [ MU.Cardinal k, "times"] else [])
                   ++ [MU.CarWs worth $ MU.Text currencyName]
            holdsMsg =
              let n = generationItem EM.! iid
              in if | max 0 k == 1 && n == 1 ->
                      "You keep the only specimen extant:"
                    | max 0 k == 0 && n == 1 ->
                      "You don't have the only hypothesized specimen:"
                    | max 0 k == 0 && n == 0 ->
                      "No such specimen was recorded:"
                    | otherwise ->
                        makePhrase [ "You hold"
                                   , if k == n
                                     then "all pieces"
                                     else MU.CardinalAWs (max 0 k) "piece"
                                   , "out of"
                                   , MU.Car n
                                   , "scattered:" ]
        in lootMsg <+> holdsMsg
  dungeonTotal <- getsState sgold
  let promptGold = spoilsBlurb currencyName total dungeonTotal
      -- Total number of items is meaningless in the presence of so much junk.
      prompt =
        promptGold
        <+> (if sexposeItems
             then "Non-positive count means none held but this many generated."
             else "")
  viewFinalLore "GameOverLoot" itemBag prompt promptFun (MLore SItem)

displayGameOverAnalytics :: MonadClientUI m
                         => FactionAnalytics -> GenerationAnalytics
                         -> m K.KM
displayGameOverAnalytics factionAn generationAn = do
  ClientOptions{sexposeActors} <- getsClient soptions
  side <- getsClient sside
  ItemRoles itemRoles <- getsSession sroles
  let ourAn = akillCounts
              $ EM.findWithDefault emptyAnalytics side factionAn
      foesAn = EM.unionsWith (+) $ concatMap EM.elems
               $ mapMaybe (`EM.lookup` ourAn)
                          [KillKineticMelee .. KillOtherPush]
      killedBagIncludingProjectiles = EM.map (, []) foesAn
      killedBag = EM.filterWithKey
                    (\iid _ -> iid `ES.member` (itemRoles EM.! STrunk))
                    killedBagIncludingProjectiles
      generationTrunk = generationAn EM.! STrunk
      trunkBag =
        if sexposeActors
        then let generationBag = EM.map (\k -> (-k, [])) generationTrunk
             in killedBag `EM.union` generationBag
        else killedBag
      total = sum $ filter (> 0) $ map fst $ EM.elems 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 iid _ k =
        let n = generationTrunk EM.! iid
        in makePhrase [ "You recall the adversary, which you killed on"
                      , MU.CarWs (max 0 k) "occasion", "while reports mention"
                      , MU.CarWs n "individual", "in total:" ]
      prompt =
        makeSentence ["your team vanquished", MU.CarWs total "adversary"]
          -- total reported would include our own, so not given
        <+> (if sexposeActors
             then "Non-positive count means none killed but this many reported."
             else "")
  viewFinalLore "GameOverAnalytics" trunkBag prompt promptFun (MLore STrunk)

displayGameOverLore :: MonadClientUI m
                    => SLore -> Bool -> GenerationAnalytics -> m K.KM
displayGameOverLore slore exposeCount generationAn = do
  itemD <- getsState sitemD
  let -- In @sexposeItems@ mode this filtering passes all through
      -- thanks to @revealItems@.
      generationLore = EM.filterWithKey (\iid _ -> iid `EM.member` itemD)
                       $ generationAn EM.! slore
      generationBag = EM.map (\k -> (if exposeCount then k else 1, []))
                             generationLore
      total = sum $ map fst $ EM.elems generationBag
      promptFun :: ItemId -> ItemFull-> Int -> Text
      promptFun _ _ k =
        makeSentence
          [ "this", MU.Text (ppSLore slore), "manifested during your quest"
          , MU.CarWs k "time" ]
      verb = if | slore `elem` [SCondition, SBlast] -> "experienced"
                | slore == SEmbed -> "ambled among"
                | otherwise -> "lived among"
      prompt = case total of
        0 -> makeSentence [ "you didn't experience any"
                          , MU.Ws $ MU.Text (headingSLore slore)
                          , "this time" ]
        1 -> makeSentence [ "you saw the following"
                          , MU.Text (headingSLore slore) ]
        _ -> makeSentence [ "you", verb, "the following variety of"
                          , MU.CarWs total $ MU.Text (headingSLore 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 menuName trunkBag prompt promptFun dmode = do
  CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui
  itemToF <- getsState $ flip itemToFull
  let iids = sortIids itemToF $ EM.assocs trunkBag
      viewAtSlot :: MenuSlot -> m K.KM
      viewAtSlot slot = do
        let renderOneItem = okxItemLoreMsg promptFun 0 dmode iids
            extraKeys = []
            slotBound = length iids - 1
        km <- displayOneMenuItem renderOneItem extraKeys slotBound slot
        case K.key km of
          K.Space -> viewFinalLore menuName trunkBag prompt promptFun dmode
          K.Esc -> return km
          _ -> error $ "" `showFailure` km
  msgAdd MsgPromptGeneric prompt
  let keys = [K.spaceKM, K.mkChar '<', K.mkChar '>', 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 `elem` keys -> return km
    Left km -> error $ "" `showFailure` km
    Right slot -> viewAtSlot slot