-- | A set of Frame monad operations.
module Game.LambdaHack.Client.UI.FrameM
  ( drawOverlay, promptGetKey, addToMacro, dropEmptyMacroFrames
  , lastMacroFrame, stopPlayBack, renderAnimFrames, animate
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , resetPlayBack, restoreLeaderFromRun, basicFrameForAnimation
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Bifunctor as B
import qualified Data.EnumMap.Strict as EM
import qualified Data.Map.Strict as M
import qualified Data.Vector.Unboxed as U

import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.Animation
import           Game.LambdaHack.Client.UI.Content.Input
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.DrawM
import           Game.LambdaHack.Client.UI.Frame
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.MonadClientUI
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.MsgM
import           Game.LambdaHack.Client.UI.Overlay
import           Game.LambdaHack.Client.UI.PointUI
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.Slideshow
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.ClientOptions
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Definition.Color as Color

-- | Draw the current level with the overlay on top.
drawOverlay :: MonadClientUI m
            => ColorMode -> Bool -> FontOverlayMap -> LevelId
            -> m PreFrame3
drawOverlay :: forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Bool -> FontOverlayMap -> LevelId -> m PreFrame3
drawOverlay ColorMode
dm Bool
onBlank FontOverlayMap
ovs LevelId
lid = do
  CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  basicFrame <- if onBlank
                then do
                  let m = Int -> Word32 -> Vector Word32
forall a. Unbox a => Int -> a -> Vector a
U.replicate (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rheight)
                                      (AttrCharW32 -> Word32
Color.attrCharW32 AttrCharW32
Color.spaceAttrW32)
                  return (m, FrameForall $ \Mutable Vector s Word32
_v -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                else drawHudFrame dm lid
  FontSetup{..} <- getFontSetup
  let propWidth = if DisplayFont -> Bool
isMonoFont DisplayFont
propFont then Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rwidth else Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rwidth
      ovProp | Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont)
             = Bool
-> Int -> Int -> Bool -> Int -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False Int
propWidth Int
rheight Bool
False Int
0 Bool
onBlank
               (Overlay -> OverlaySpace) -> Overlay -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ Overlay -> DisplayFont -> FontOverlayMap -> Overlay
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault [] DisplayFont
propFont FontOverlayMap
ovs
             | Bool
otherwise = []
      ovMono = if Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
monoFont)
               then Bool
-> Int -> Int -> Bool -> Int -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rwidth) Int
rheight Bool
False Int
0 Bool
onBlank
                    (Overlay -> OverlaySpace) -> Overlay -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ Overlay -> DisplayFont -> FontOverlayMap -> Overlay
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault [] DisplayFont
monoFont FontOverlayMap
ovs
               else []
      ovSquare | Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont)
               = Bool
-> Int -> Int -> Bool -> Int -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rwidth) Int
rheight Bool
False Int
0 Bool
onBlank
                 (Overlay -> OverlaySpace) -> Overlay -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ Overlay -> DisplayFont -> FontOverlayMap -> Overlay
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault [] DisplayFont
squareFont FontOverlayMap
ovs
              | Bool
otherwise = []
      ovOther | Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont) = []
              | Bool
otherwise
              = Bool
-> Int -> Int -> Bool -> Int -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
True Int
rwidth Int
rheight Bool
True Int
20 Bool
onBlank
                (Overlay -> OverlaySpace) -> Overlay -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ [Overlay] -> Overlay
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Overlay] -> Overlay) -> [Overlay] -> Overlay
forall a b. (a -> b) -> a -> b
$ FontOverlayMap -> [Overlay]
forall k a. EnumMap k a -> [a]
EM.elems FontOverlayMap
ovs
                    -- 20 needed not to leave gaps in skill menu
                    -- in the absence of backdrop
      ovBackdrop =
        if Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onBlank
        then let propOutline :: OverlaySpace
propOutline =
                   Bool
-> Int -> Int -> Bool -> Int -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False Int
propWidth Int
rheight Bool
True Int
0 Bool
onBlank
                   (Overlay -> OverlaySpace) -> Overlay -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ Overlay -> DisplayFont -> FontOverlayMap -> Overlay
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault [] DisplayFont
propFont FontOverlayMap
ovs
                 monoOutline :: OverlaySpace
monoOutline =
                   Bool
-> Int -> Int -> Bool -> Int -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rwidth) Int
rheight Bool
True Int
0 Bool
onBlank
                   (Overlay -> OverlaySpace) -> Overlay -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ Overlay -> DisplayFont -> FontOverlayMap -> Overlay
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault [] DisplayFont
monoFont FontOverlayMap
ovs
                 squareOutline :: OverlaySpace
squareOutline =
                   Bool
-> Int -> Int -> Bool -> Int -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rwidth) Int
rheight Bool
True Int
0 Bool
onBlank
                   (Overlay -> OverlaySpace) -> Overlay -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ Overlay -> DisplayFont -> FontOverlayMap -> Overlay
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault [] DisplayFont
squareFont FontOverlayMap
ovs
                 g :: Int -> [a] -> Maybe (Int, Int) -> Maybe (Int, Int)
g Int
x [a]
al Maybe (Int, Int)
Nothing = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
x, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall a. [a] -> Int
length [a]
al Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                 g Int
x [a]
al (Just (Int
xmin, Int
xmax)) =
                   (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
xmin Int
x, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
xmax (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall a. [a] -> Int
length [a]
al Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
                 f :: EnumMap Int (Int, Int) -> (PointUI, [a]) -> EnumMap Int (Int, Int)
f EnumMap Int (Int, Int)
em (PointUI Int
x Int
y, [a]
al) = (Maybe (Int, Int) -> Maybe (Int, Int))
-> Int -> EnumMap Int (Int, Int) -> EnumMap Int (Int, Int)
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter (Int -> [a] -> Maybe (Int, Int) -> Maybe (Int, Int)
forall {a}. Int -> [a] -> Maybe (Int, Int) -> Maybe (Int, Int)
g Int
x [a]
al) Int
y EnumMap Int (Int, Int)
em
                 extentMap :: EnumMap Int (Int, Int)
extentMap = (EnumMap Int (Int, Int)
 -> (PointUI, [AttrCharW32]) -> EnumMap Int (Int, Int))
-> EnumMap Int (Int, Int) -> OverlaySpace -> EnumMap Int (Int, Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' EnumMap Int (Int, Int)
-> (PointUI, [AttrCharW32]) -> EnumMap Int (Int, Int)
forall {a}.
EnumMap Int (Int, Int) -> (PointUI, [a]) -> EnumMap Int (Int, Int)
f EnumMap Int (Int, Int)
forall k a. EnumMap k a
EM.empty
                             (OverlaySpace -> EnumMap Int (Int, Int))
-> OverlaySpace -> EnumMap Int (Int, Int)
forall a b. (a -> b) -> a -> b
$ OverlaySpace
propOutline OverlaySpace -> OverlaySpace -> OverlaySpace
forall a. [a] -> [a] -> [a]
++ OverlaySpace
monoOutline OverlaySpace -> OverlaySpace -> OverlaySpace
forall a. [a] -> [a] -> [a]
++ OverlaySpace
squareOutline
                 listBackdrop :: (Int, (Int, Int)) -> (PointUI, [AttrCharW32])
listBackdrop (Int
y, (Int
xmin, Int
xmax)) =
                   ( Int -> Int -> PointUI
PointUI (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
xmin Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)) Int
y
                   , Int -> [AttrCharW32]
blankAttrString
                     (Int -> [AttrCharW32]) -> Int -> [AttrCharW32]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
xmin Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2))
                           (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xmax Int -> Int -> Int
forall a. Integral a => a -> a -> a
`divUp` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xmin Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) )
             in ((Int, (Int, Int)) -> (PointUI, [AttrCharW32]))
-> [(Int, (Int, Int))] -> OverlaySpace
forall a b. (a -> b) -> [a] -> [b]
map (Int, (Int, Int)) -> (PointUI, [AttrCharW32])
listBackdrop ([(Int, (Int, Int))] -> OverlaySpace)
-> [(Int, (Int, Int))] -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ EnumMap Int (Int, Int) -> [(Int, (Int, Int))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap Int (Int, Int)
extentMap
        else []
      overlayedFrame = Int
-> OverlaySpace
-> (Vector Word32, FrameForall)
-> (Vector Word32, FrameForall)
overlayFrame Int
rwidth OverlaySpace
ovOther
                       ((Vector Word32, FrameForall) -> (Vector Word32, FrameForall))
-> (Vector Word32, FrameForall) -> (Vector Word32, FrameForall)
forall a b. (a -> b) -> a -> b
$ Int
-> OverlaySpace
-> (Vector Word32, FrameForall)
-> (Vector Word32, FrameForall)
overlayFrame Int
rwidth OverlaySpace
ovBackdrop (Vector Word32, FrameForall)
basicFrame
  return (overlayedFrame, (ovProp, ovSquare, ovMono))

promptGetKey :: MonadClientUI m
             => ColorMode -> FontOverlayMap -> Bool -> [K.KM]
             -> m K.KM
promptGetKey :: forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> FontOverlayMap -> Bool -> [KM] -> m KM
promptGetKey ColorMode
dm FontOverlayMap
ovs Bool
onBlank [KM]
frontKeyKeys = do
  lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  report <- getsSession $ newReport . shistory
  sreqQueried <- getsSession sreqQueried
  macroFrame <- getsSession smacroFrame
  let interrupted =
        -- If server is not querying for request, then the key is needed due to
        -- a special event, not ordinary querying the player for command,
        -- so interrupt.
        Bool -> Bool
not Bool
sreqQueried
        -- Any alarming message interupts macros, except when the macro
        -- displays help and ends, which is a helpful thing to do.
        Bool -> Bool -> Bool
|| ((MsgClass -> Bool) -> Report -> Bool
anyInReport MsgClass -> Bool
disturbsResting Report
report
            Bool -> Bool -> Bool
&& KeyMacroFrame -> KeyMacro
keyPending KeyMacroFrame
macroFrame KeyMacro -> KeyMacro -> Bool
forall a. Eq a => a -> a -> Bool
/= [KM] -> KeyMacro
KeyMacro [String -> KM
K.mkKM String
"F1"])
  km <- case keyPending macroFrame of
    KeyMacro (KM
km : [KM]
kms) | Bool -> Bool
not Bool
interrupted
                          -- A faulty key in a macro is a good reason
                          -- to interrupt it, as well.
                          Bool -> Bool -> Bool
&& ([KM] -> Bool
forall a. [a] -> Bool
null [KM]
frontKeyKeys Bool -> Bool -> Bool
|| 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]
frontKeyKeys) -> do
      -- No need to display the frame, because a frame was displayed
      -- when the player chose to play a macro and each turn or more often
      -- a frame is displayed elsewhere.
      -- The only excepton is when navigating menus through macros,
      -- but there the speed is particularly welcome.
      (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 {smacroFrame = (smacroFrame sess) {keyPending = KeyMacro kms}}
      MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgMacroOperation (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Voicing '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> KM -> Text
forall a. Show a => a -> Text
tshow KM
km Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'."
      KM -> m KM
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
    KeyMacro [KM]
kms -> do
      if [KM] -> Bool
forall a. [a] -> Bool
null [KM]
kms then do
        -- There was no macro. Not important if there was a reason
        -- for interrupt or not.
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ColorMode
dm ColorMode -> ColorMode -> Bool
forall a. Eq a => a -> a -> Bool
/= ColorMode
ColorFull) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          -- This marks a special event, regardless of @sreqQueried@.
          side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
          fact <- getsState $ (EM.! side) . sfactionD
          unless (gunderAI fact) -- don't forget special autoplay keypresses
            -- Forget the furious keypresses just before a special event.
            resetPressedKeys
        -- Running, if any, must have ended naturally, because no macro.
        -- Therefore no need to restore leader back to initial run leader,
        -- but running itself is cancelled below.
      else do
        -- The macro was not empty, but not played, so it must have been
        -- interrupted, so we can't continue playback, so wipe out the macro.
        m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPlayBack
        -- This might have been an unexpected end of a run, too.
        m ()
forall (m :: * -> *). MonadClientUI m => m ()
restoreLeaderFromRun
        -- Macro was killed, so emergency, so reset input, too.
        m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
      frontKeyFrame <- ColorMode -> Bool -> FontOverlayMap -> LevelId -> m PreFrame3
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Bool -> FontOverlayMap -> LevelId -> m PreFrame3
drawOverlay ColorMode
dm Bool
onBlank FontOverlayMap
ovs LevelId
lidV
      recordHistory
      modifySession $ \SessionUI
sess ->
        SessionUI
sess { srunning = Nothing
             , sxhairGoTo = Nothing
             , sdisplayNeeded = False
             , sturnDisplayed = True }
      connFrontendFrontKey frontKeyKeys frontKeyFrame
  -- In-game macros need to be recorded here, not in @UI.humanCommand@,
  -- to also capture choice of items from menus, etc.
  -- Notice that keys coming from macros (from content, in-game, config)
  -- are recorded as well and this is well defined and essential.
  --
  -- Only keys pressed when player is queried for a command are recorded.
  when sreqQueried $ do
    CCUI{coinput=InputContent{bcmdMap}} <- getsSession sccui
    modifySession $ \SessionUI
sess ->
      SessionUI
sess {smacroFrame = addToMacro bcmdMap km $ smacroFrame sess}
  return km

addToMacro :: M.Map K.KM HumanCmd.CmdTriple -> K.KM -> KeyMacroFrame
           -> KeyMacroFrame
addToMacro :: Map KM CmdTriple -> KM -> KeyMacroFrame -> KeyMacroFrame
addToMacro Map KM CmdTriple
bcmdMap KM
km KeyMacroFrame
macroFrame =
  case (\([CmdCategory]
_, Text
_, HumanCmd
cmd) -> HumanCmd
cmd) (CmdTriple -> HumanCmd) -> Maybe CmdTriple -> Maybe HumanCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KM
km Map KM CmdTriple
bcmdMap of
    Maybe HumanCmd
Nothing -> KeyMacroFrame
macroFrame
    Just HumanCmd
HumanCmd.Record -> KeyMacroFrame
macroFrame
    Just HumanCmd.RepeatLast{} -> KeyMacroFrame
macroFrame
    Maybe HumanCmd
_ -> KeyMacroFrame
macroFrame { keyMacroBuffer =
                        (km :) `B.first` keyMacroBuffer macroFrame }
           -- This is noop when not recording a macro,
           -- which is exactly the required semantics.

dropEmptyMacroFrames :: KeyMacroFrame -> [KeyMacroFrame]
                     -> (KeyMacroFrame, [KeyMacroFrame])
dropEmptyMacroFrames :: KeyMacroFrame
-> [KeyMacroFrame] -> (KeyMacroFrame, [KeyMacroFrame])
dropEmptyMacroFrames KeyMacroFrame
mf [] = (KeyMacroFrame
mf, [])
dropEmptyMacroFrames (KeyMacroFrame Either [KM] KeyMacro
_ (KeyMacro []) Maybe KM
_)
                     (KeyMacroFrame
mf : [KeyMacroFrame]
mfs) = KeyMacroFrame
-> [KeyMacroFrame] -> (KeyMacroFrame, [KeyMacroFrame])
dropEmptyMacroFrames KeyMacroFrame
mf [KeyMacroFrame]
mfs
dropEmptyMacroFrames KeyMacroFrame
mf [KeyMacroFrame]
mfs = (KeyMacroFrame
mf, [KeyMacroFrame]
mfs)

lastMacroFrame :: KeyMacroFrame -> [KeyMacroFrame] -> KeyMacroFrame
lastMacroFrame :: KeyMacroFrame -> [KeyMacroFrame] -> KeyMacroFrame
lastMacroFrame KeyMacroFrame
mf [] = KeyMacroFrame
mf
lastMacroFrame KeyMacroFrame
_ (KeyMacroFrame
mf : [KeyMacroFrame]
mfs) = KeyMacroFrame -> [KeyMacroFrame] -> KeyMacroFrame
lastMacroFrame KeyMacroFrame
mf [KeyMacroFrame]
mfs

stopPlayBack :: MonadClientUI m => m ()
stopPlayBack :: forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack = MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgStopPlayback Text
"!"

-- | We wipe any actions in progress, but keep the data needed to repeat
-- the last global macros and the last command.
resetPlayBack :: MonadClientUI m => m ()
resetPlayBack :: forall (m :: * -> *). MonadClientUI m => m ()
resetPlayBack =
  (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 ->
    let lastFrame :: KeyMacroFrame
lastFrame = KeyMacroFrame -> [KeyMacroFrame] -> KeyMacroFrame
lastMacroFrame (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) (SessionUI -> [KeyMacroFrame]
smacroStack SessionUI
sess)
    in SessionUI
sess { smacroFrame = lastFrame {keyPending = mempty}
            , smacroStack = [] }

restoreLeaderFromRun :: MonadClientUI m => m ()
restoreLeaderFromRun :: forall (m :: * -> *). MonadClientUI m => m ()
restoreLeaderFromRun = do
  srunning <- (SessionUI -> Maybe RunParams) -> m (Maybe RunParams)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RunParams
srunning
  case srunning of
    Maybe RunParams
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just RunParams{ActorId
runLeader :: ActorId
runLeader :: RunParams -> ActorId
runLeader} -> do
      -- Switch to the original leader, from before the run start,
      -- unless dead or unless the faction never runs with multiple
      -- (but could have the leader changed automatically meanwhile).
      side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
      fact <- getsState $ (EM.! side) . sfactionD
      arena <- getArenaUI
      memA <- getsState $ memActor runLeader arena
      when (memA && not (noRunWithMulti fact)) $
        updateClientLeader runLeader

-- This is not our turn, so we can't obstruct screen with messages
-- and message reformatting causes distraction, so there's no point
-- trying to squeeze the report into the single available line,
-- except when it's not our turn permanently, because AI runs UI.
basicFrameForAnimation :: MonadClientUI m
                        => LevelId -> Maybe Bool -> m PreFrame3
basicFrameForAnimation :: forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Maybe Bool -> m PreFrame3
basicFrameForAnimation LevelId
arena Maybe Bool
forceReport = do
  FontSetup{propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  sbenchMessages <- getsClient $ sbenchMessages . soptions
  side <- getsClient sside
  fact <- getsState $ (EM.! side) . sfactionD
  report <- getReportUI False
  let par1 = [AttrCharW32] -> AttrLine
firstParagraph ([AttrCharW32] -> AttrLine) -> [AttrCharW32] -> AttrLine
forall a b. (a -> b) -> a -> b
$ ([AttrCharW32] -> [AttrCharW32] -> [AttrCharW32])
-> [AttrCharW32] -> [[AttrCharW32]] -> [AttrCharW32]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [AttrCharW32] -> [AttrCharW32] -> [AttrCharW32]
(<+:>) [] ([[AttrCharW32]] -> [AttrCharW32])
-> [[AttrCharW32]] -> [AttrCharW32]
forall a b. (a -> b) -> a -> b
$ Bool -> Report -> [[AttrCharW32]]
renderReport Bool
True Report
report
      -- If messages are benchmarked, they can't be displayed under AI,
      -- because this is not realistic when player is in control.
      truncRep | Bool -> Bool
not Bool
sbenchMessages Bool -> Bool -> Bool
&& Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Faction -> Bool
gunderAI Faction
fact) Maybe Bool
forceReport =
                   [(DisplayFont, Overlay)] -> FontOverlayMap
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList [(DisplayFont
propFont, [(Int -> Int -> PointUI
PointUI Int
0 Int
0, AttrLine
par1)])]
               | Bool
otherwise = FontOverlayMap
forall k a. EnumMap k a
EM.empty
  drawOverlay ColorFull False truncRep arena

-- | Render animations on top of the current screen frame.
renderAnimFrames :: MonadClientUI m
                 => LevelId -> Animation -> Maybe Bool -> m PreFrames3
renderAnimFrames :: forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> Maybe Bool -> m PreFrames3
renderAnimFrames LevelId
arena Animation
anim Maybe Bool
forceReport = do
  CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  snoAnim <- getsClient $ snoAnim . soptions
  basicFrame <- basicFrameForAnimation arena forceReport
  smuteMessages <- getsSession smuteMessages
  return $! if | smuteMessages -> []
               | fromMaybe False snoAnim -> [Just basicFrame]
               | otherwise -> map (fmap (\(Vector Word32, FrameForall)
fr -> ((Vector Word32, FrameForall)
fr, PreFrame3 -> (OverlaySpace, OverlaySpace, OverlaySpace)
forall a b. (a, b) -> b
snd PreFrame3
basicFrame)))
                              $ renderAnim rwidth (fst basicFrame) anim

-- | Render and display animations on top of the current screen frame.
animate :: MonadClientUI m => LevelId -> Animation -> m ()
animate :: forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate LevelId
arena Animation
anim = do
  -- The delay before reaction to keypress was too long in case of many
  -- projectiles hitting actors, so frames need to be skipped.
  keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
  unless keyPressed $ do
    frames <- renderAnimFrames arena anim Nothing
    displayFrames arena frames