-- | A set of Frame monad operations.
module Game.LambdaHack.Client.UI.FrameM
  ( pushFrame, promptGetKey, addToMacro, dropEmptyMacroFrames, lastMacroFrame
  , stopPlayBack, animate, fadeOutOrIn
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , drawOverlay, oneLineBasicFrame, renderAnimFrames, resetPlayBack
#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.Frontend as Frontend
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 :: ColorMode -> Bool -> FontOverlayMap -> LevelId -> m PreFrame3
drawOverlay dm :: ColorMode
dm onBlank :: Bool
onBlank ovs :: FontOverlayMap
ovs lid :: LevelId
lid = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: ScreenContent -> X
rwidth :: X
rwidth, X
rheight :: ScreenContent -> X
rheight :: X
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  (Vector Word32, FrameForall)
basicFrame <- if Bool
onBlank
                then do
                  let m :: Vector Word32
m = X -> Word32 -> Vector Word32
forall a. Unbox a => X -> a -> Vector a
U.replicate (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
* X
rheight)
                                      (AttrCharW32 -> Word32
Color.attrCharW32 AttrCharW32
Color.spaceAttrW32)
                  (Vector Word32, FrameForall) -> m (Vector Word32, FrameForall)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Word32
m, (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \_v :: Mutable Vector s Word32
_v -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                else ColorMode -> LevelId -> m (Vector Word32, FrameForall)
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> LevelId -> m (Vector Word32, FrameForall)
drawHudFrame ColorMode
dm LevelId
lid
  FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  let isTeletype :: Bool
isTeletype = ClientOptions -> String
Frontend.frontendName ClientOptions
soptions String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "teletype"
      propWidth :: X
propWidth = if DisplayFont -> Bool
isMonoFont DisplayFont
propFont then 2 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth else 4 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth
      ovProp :: OverlaySpace
ovProp | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Bool
isSquareFont DisplayFont
propFont
             = Bool -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False X
propWidth X
rheight Bool
False 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
isTeletype  -- hack for debug output
             = ((PointUI, AttrLine) -> (PointUI, AttrString))
-> Overlay -> OverlaySpace
forall a b. (a -> b) -> [a] -> [b]
map ((AttrLine -> AttrString)
-> (PointUI, AttrLine) -> (PointUI, AttrString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second AttrLine -> AttrString
attrLine) (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
             | Bool
otherwise = []
      ovMono :: OverlaySpace
ovMono = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Bool
isSquareFont DisplayFont
monoFont
               then Bool -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False (2 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth) X
rheight Bool
False 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 []
      ovOther :: OverlaySpace
ovOther | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Bool
isSquareFont DisplayFont
propFont
              = Bool -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
True X
rwidth X
rheight Bool
True 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
                  -- no backdrop for square font, so @wipeAdjacent@
                  -- needs to be @True@ or the extra blank line starts too late
              | Bool
isTeletype  -- hack for debug output
              = []
              | Bool
otherwise
              = Bool -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
True X
rwidth X
rheight Bool
True 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 :: OverlaySpace
ovBackdrop =
        if Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onBlank
        then let propOutline :: OverlaySpace
propOutline =
                   Bool -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False X
propWidth X
rheight Bool
True 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 -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False (2 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth) X
rheight Bool
True 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
                 g :: X -> [a] -> Maybe (X, X) -> Maybe (X, X)
g x :: X
x al :: [a]
al Nothing = (X, X) -> Maybe (X, X)
forall a. a -> Maybe a
Just (X
x, X
x X -> X -> X
forall a. Num a => a -> a -> a
+ [a] -> X
forall a. [a] -> X
length [a]
al X -> X -> X
forall a. Num a => a -> a -> a
- 1)
                 g x :: X
x al :: [a]
al (Just (xmin :: X
xmin, xmax :: X
xmax)) =
                   (X, X) -> Maybe (X, X)
forall a. a -> Maybe a
Just (X -> X -> X
forall a. Ord a => a -> a -> a
min X
xmin X
x, X -> X -> X
forall a. Ord a => a -> a -> a
max X
xmax (X
x X -> X -> X
forall a. Num a => a -> a -> a
+ [a] -> X
forall a. [a] -> X
length [a]
al X -> X -> X
forall a. Num a => a -> a -> a
- 1))
                 f :: EnumMap X (X, X) -> (PointUI, [a]) -> EnumMap X (X, X)
f em :: EnumMap X (X, X)
em (PointUI x :: X
x y :: X
y, al :: [a]
al) = (Maybe (X, X) -> Maybe (X, X))
-> X -> EnumMap X (X, X) -> EnumMap X (X, X)
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter (X -> [a] -> Maybe (X, X) -> Maybe (X, X)
forall a. X -> [a] -> Maybe (X, X) -> Maybe (X, X)
g X
x [a]
al) X
y EnumMap X (X, X)
em
                 extentMap :: EnumMap X (X, X)
extentMap = (EnumMap X (X, X) -> (PointUI, AttrString) -> EnumMap X (X, X))
-> EnumMap X (X, X) -> OverlaySpace -> EnumMap X (X, X)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' EnumMap X (X, X) -> (PointUI, AttrString) -> EnumMap X (X, X)
forall a. EnumMap X (X, X) -> (PointUI, [a]) -> EnumMap X (X, X)
f EnumMap X (X, X)
forall k a. EnumMap k a
EM.empty (OverlaySpace -> EnumMap X (X, X))
-> OverlaySpace -> EnumMap X (X, X)
forall a b. (a -> b) -> a -> b
$ OverlaySpace
propOutline OverlaySpace -> OverlaySpace -> OverlaySpace
forall a. [a] -> [a] -> [a]
++ OverlaySpace
monoOutline
                 listBackdrop :: (X, (X, X)) -> (PointUI, AttrString)
listBackdrop (y :: X
y, (xmin :: X
xmin, xmax :: X
xmax)) =
                   ( X -> X -> PointUI
PointUI (2 X -> X -> X
forall a. Num a => a -> a -> a
* (X
xmin X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2)) X
y
                   , X -> AttrString
blankAttrString
                     (X -> AttrString) -> X -> AttrString
forall a b. (a -> b) -> a -> b
$ X -> X -> X
forall a. Ord a => a -> a -> a
min (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 2 X -> X -> X
forall a. Num a => a -> a -> a
* (X
xmin X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2))
                           (1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
xmax X -> X -> X
forall a. Integral a => a -> a -> a
`divUp` 2 X -> X -> X
forall a. Num a => a -> a -> a
- X
xmin X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2) )
             in ((X, (X, X)) -> (PointUI, AttrString))
-> [(X, (X, X))] -> OverlaySpace
forall a b. (a -> b) -> [a] -> [b]
map (X, (X, X)) -> (PointUI, AttrString)
listBackdrop ([(X, (X, X))] -> OverlaySpace) -> [(X, (X, X))] -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ EnumMap X (X, X) -> [(X, (X, X))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap X (X, X)
extentMap
        else []
      overlayedFrame :: (Vector Word32, FrameForall)
overlayedFrame = X
-> OverlaySpace
-> (Vector Word32, FrameForall)
-> (Vector Word32, FrameForall)
overlayFrame X
rwidth OverlaySpace
ovOther
                       ((Vector Word32, FrameForall) -> (Vector Word32, FrameForall))
-> (Vector Word32, FrameForall) -> (Vector Word32, FrameForall)
forall a b. (a -> b) -> a -> b
$ X
-> OverlaySpace
-> (Vector Word32, FrameForall)
-> (Vector Word32, FrameForall)
overlayFrame X
rwidth OverlaySpace
ovBackdrop (Vector Word32, FrameForall)
basicFrame
  PreFrame3 -> m PreFrame3
forall (m :: * -> *) a. Monad m => a -> m a
return ((Vector Word32, FrameForall)
overlayedFrame, (OverlaySpace
ovProp, OverlaySpace
ovMono))

oneLineBasicFrame :: MonadClientUI m => LevelId -> DisplayFont -> m PreFrame3
oneLineBasicFrame :: LevelId -> DisplayFont -> m PreFrame3
oneLineBasicFrame arena :: LevelId
arena font :: DisplayFont
font = do
  Report
report <- Bool -> m Report
forall (m :: * -> *). MonadClientUI m => Bool -> m Report
getReportUI Bool
False
  let par1 :: AttrLine
par1 = AttrString -> AttrLine
firstParagraph (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ (AttrString -> AttrString -> AttrString)
-> AttrString -> [AttrString] -> AttrString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AttrString -> AttrString -> AttrString
(<+:>) [] ([AttrString] -> AttrString) -> [AttrString] -> AttrString
forall a b. (a -> b) -> a -> b
$ Bool -> Report -> [AttrString]
renderReport Bool
True Report
report
      truncRep :: FontOverlayMap
truncRep = [(DisplayFont, Overlay)] -> FontOverlayMap
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList [(DisplayFont
font, [(X -> X -> PointUI
PointUI 0 0, AttrLine
par1)])]
  ColorMode -> Bool -> FontOverlayMap -> LevelId -> m PreFrame3
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Bool -> FontOverlayMap -> LevelId -> m PreFrame3
drawOverlay ColorMode
ColorFull Bool
False FontOverlayMap
truncRep LevelId
arena

-- | Push the frame depicting the current level to the frame queue.
-- Only one line of the report is shown, as in animations,
-- because it may not be our turn, so we can't clear the message
-- to see what is underneath.
pushFrame :: MonadClientUI m => Bool -> m ()
pushFrame :: Bool -> m ()
pushFrame delay :: Bool
delay = do
  -- The delay before reaction to keypress was too long in case of many
  -- projectiles flying and ending flight, so frames need to be skipped.
  Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
keyPressed (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
    FontSetup{DisplayFont
propFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
    PreFrame3
frame <- LevelId -> DisplayFont -> m PreFrame3
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> DisplayFont -> m PreFrame3
oneLineBasicFrame LevelId
lidV DisplayFont
propFont
    -- Pad with delay before and after to let player see, e.g., door being
    -- opened a few ticks after it came into vision, the same turn.
    LevelId -> PreFrames3 -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames3 -> m ()
displayFrames LevelId
lidV (PreFrames3 -> m ()) -> PreFrames3 -> m ()
forall a b. (a -> b) -> a -> b
$
      if Bool
delay then [Maybe PreFrame3
forall a. Maybe a
Nothing, PreFrame3 -> Maybe PreFrame3
forall a. a -> Maybe a
Just PreFrame3
frame, Maybe PreFrame3
forall a. Maybe a
Nothing] else [PreFrame3 -> Maybe PreFrame3
forall a. a -> Maybe a
Just PreFrame3
frame]

promptGetKey :: (MonadClient m, MonadClientUI m)
             => ColorMode -> FontOverlayMap -> Bool -> [K.KM]
             -> m K.KM
promptGetKey :: ColorMode -> FontOverlayMap -> Bool -> [KM] -> m KM
promptGetKey dm :: ColorMode
dm ovs :: FontOverlayMap
ovs onBlank :: Bool
onBlank frontKeyKeys :: [KM]
frontKeyKeys = do
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  Report
report <- (SessionUI -> Report) -> m Report
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Report) -> m Report)
-> (SessionUI -> Report) -> m Report
forall a b. (a -> b) -> a -> b
$ History -> Report
newReport (History -> Report)
-> (SessionUI -> History) -> SessionUI -> Report
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> History
shistory
  let interrupted :: Bool
interrupted = (MsgClass -> Bool) -> Report -> Bool
anyInReport MsgClass -> Bool
disturbsResting Report
report
  KeyMacroFrame
macroFrame <- (SessionUI -> KeyMacroFrame) -> m KeyMacroFrame
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> KeyMacroFrame
smacroFrame
  KM
km <- case KeyMacroFrame -> KeyMacro
keyPending KeyMacroFrame
macroFrame of
    KeyMacro (km :: KM
km : kms :: [KM]
kms) | ([KM] -> Bool
forall a. [a] -> Bool
null [KM]
frontKeyKeys Bool -> Bool -> Bool
|| KM
km KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
frontKeyKeys)
                          Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
interrupted -> 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
$ \sess :: SessionUI
sess ->
        SessionUI
sess {smacroFrame :: KeyMacroFrame
smacroFrame = (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) {keyPending :: KeyMacro
keyPending = [KM] -> KeyMacro
KeyMacro [KM]
kms}}
      MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgMacroOperation (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "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
<> "'."
      KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
    KeyMacro (_ : _) -> do
      PreFrame3
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
      -- We can't continue playback, so wipe out macros, etc.
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPlayBack
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
        SessionUI
sess { sdisplayNeeded :: Bool
sdisplayNeeded = Bool
False
             , sturnDisplayed :: Bool
sturnDisplayed = Bool
True }
      [KM] -> PreFrame3 -> m KM
forall (m :: * -> *). MonadClientUI m => [KM] -> PreFrame3 -> m KM
connFrontendFrontKey [KM]
frontKeyKeys PreFrame3
frontKeyFrame
    KeyMacro [] -> do
      PreFrame3
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
      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
        FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
        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
side) (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
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Faction -> Bool
isAIFact Faction
fact) -- don't forget special autoplay keypresses
          -- Forget the furious keypresses just before a special event.
          m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
      -- If we ask for a key, then we don't want to run any more
      -- and we want to avoid changing leader back to initial run leader
      -- at the nearest @stopPlayBack@, etc.
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
        SessionUI
sess { srunning :: Maybe RunParams
srunning = Maybe RunParams
forall a. Maybe a
Nothing
             , sdisplayNeeded :: Bool
sdisplayNeeded = Bool
False
             , sturnDisplayed :: Bool
sturnDisplayed = Bool
True }
      [KM] -> PreFrame3 -> m KM
forall (m :: * -> *). MonadClientUI m => [KM] -> PreFrame3 -> m KM
connFrontendFrontKey [KM]
frontKeyKeys PreFrame3
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.
  CCUI{coinput :: CCUI -> InputContent
coinput=InputContent{Map KM CmdTriple
bcmdMap :: InputContent -> Map KM CmdTriple
bcmdMap :: Map KM CmdTriple
bcmdMap}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
    SessionUI
sess {smacroFrame :: KeyMacroFrame
smacroFrame = Map KM CmdTriple -> KM -> KeyMacroFrame -> KeyMacroFrame
addToMacro Map KM CmdTriple
bcmdMap KM
km (KeyMacroFrame -> KeyMacroFrame) -> KeyMacroFrame -> KeyMacroFrame
forall a b. (a -> b) -> a -> b
$ SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess}
  KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km

addToMacro :: M.Map K.KM HumanCmd.CmdTriple -> K.KM -> KeyMacroFrame
           -> KeyMacroFrame
addToMacro :: Map KM CmdTriple -> KM -> KeyMacroFrame -> KeyMacroFrame
addToMacro bcmdMap :: Map KM CmdTriple
bcmdMap km :: KM
km macroFrame :: KeyMacroFrame
macroFrame =
  case (\(_, _, cmd :: 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
    Nothing -> KeyMacroFrame
macroFrame
    Just HumanCmd.Record -> KeyMacroFrame
macroFrame
    Just HumanCmd.RepeatLast{} -> KeyMacroFrame
macroFrame
    _ -> KeyMacroFrame
macroFrame { keyMacroBuffer :: Either [KM] KeyMacro
keyMacroBuffer =
                        (KM
km KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
:) ([KM] -> [KM]) -> Either [KM] KeyMacro -> Either [KM] KeyMacro
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
`B.first` KeyMacroFrame -> Either [KM] KeyMacro
keyMacroBuffer KeyMacroFrame
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 mf :: KeyMacroFrame
mf [] = (KeyMacroFrame
mf, [])
dropEmptyMacroFrames (KeyMacroFrame _ (KeyMacro []) _)
                     (mf :: KeyMacroFrame
mf : mfs :: [KeyMacroFrame]
mfs) = KeyMacroFrame
-> [KeyMacroFrame] -> (KeyMacroFrame, [KeyMacroFrame])
dropEmptyMacroFrames KeyMacroFrame
mf [KeyMacroFrame]
mfs
dropEmptyMacroFrames mf :: KeyMacroFrame
mf mfs :: [KeyMacroFrame]
mfs = (KeyMacroFrame
mf, [KeyMacroFrame]
mfs)

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

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

resetPlayBack :: MonadClientUI m => m ()
resetPlayBack :: m ()
resetPlayBack = do
  -- We wipe any actions in progress, but keep the data needed to repeat
  -- the last global macros and the last command.
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
    let lastFrame :: KeyMacroFrame
lastFrame = KeyMacroFrame -> [KeyMacroFrame] -> KeyMacroFrame
lastMacroFrame (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) (SessionUI -> [KeyMacroFrame]
smacroStack SessionUI
sess)
    in SessionUI
sess { smacroFrame :: KeyMacroFrame
smacroFrame = KeyMacroFrame
lastFrame {keyPending :: KeyMacro
keyPending = KeyMacro
forall a. Monoid a => a
mempty}
            , smacroStack :: [KeyMacroFrame]
smacroStack = []
            , sxhairGoTo :: Maybe Target
sxhairGoTo = Maybe Target
forall a. Maybe a
Nothing }
  Maybe RunParams
srunning <- (SessionUI -> Maybe RunParams) -> m (Maybe RunParams)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RunParams
srunning
  case Maybe RunParams
srunning of
    Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just RunParams{ActorId
runLeader :: RunParams -> ActorId
runLeader :: 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).
      FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
      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
side) (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
      LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
      Bool
memA <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
runLeader LevelId
arena
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
memA Bool -> Bool -> Bool
&& Bool -> Bool
not (Faction -> Bool
noRunWithMulti Faction
fact)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
updateClientLeader ActorId
runLeader
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession (\sess :: SessionUI
sess -> SessionUI
sess {srunning :: Maybe RunParams
srunning = Maybe RunParams
forall a. Maybe a
Nothing})

-- | Render animations on top of the current screen frame.
renderAnimFrames :: MonadClientUI m
                 => Bool -> LevelId -> Animation -> m PreFrames3
renderAnimFrames :: Bool -> LevelId -> Animation -> m PreFrames3
renderAnimFrames onBlank :: Bool
onBlank arena :: LevelId
arena anim :: Animation
anim = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: X
rwidth :: ScreenContent -> X
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  Maybe Bool
snoAnim <- (StateClient -> Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Bool) -> m (Maybe Bool))
-> (StateClient -> Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Maybe Bool
snoAnim (ClientOptions -> Maybe Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
  FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  -- This hack is needed so that the prop part of the overlay does not
  -- overwrite the fadeout animation.
  let ovFont :: DisplayFont
ovFont = if Bool -> Bool
not Bool
onBlank Bool -> Bool -> Bool
|| Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
snoAnim
               then DisplayFont
propFont
               else DisplayFont
squareFont
  PreFrame3
basicFrame <- LevelId -> DisplayFont -> m PreFrame3
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> DisplayFont -> m PreFrame3
oneLineBasicFrame LevelId
arena DisplayFont
ovFont
  PreFrames3 -> m PreFrames3
forall (m :: * -> *) a. Monad m => a -> m a
return (PreFrames3 -> m PreFrames3) -> PreFrames3 -> m PreFrames3
forall a b. (a -> b) -> a -> b
$! if Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
snoAnim
            then [PreFrame3 -> Maybe PreFrame3
forall a. a -> Maybe a
Just PreFrame3
basicFrame]
            else (Maybe (Vector Word32, FrameForall) -> Maybe PreFrame3)
-> [Maybe (Vector Word32, FrameForall)] -> PreFrames3
forall a b. (a -> b) -> [a] -> [b]
map (((Vector Word32, FrameForall) -> PreFrame3)
-> Maybe (Vector Word32, FrameForall) -> Maybe PreFrame3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\fr :: (Vector Word32, FrameForall)
fr -> ((Vector Word32, FrameForall)
fr, PreFrame3 -> (OverlaySpace, OverlaySpace)
forall a b. (a, b) -> b
snd PreFrame3
basicFrame)))
                 ([Maybe (Vector Word32, FrameForall)] -> PreFrames3)
-> [Maybe (Vector Word32, FrameForall)] -> PreFrames3
forall a b. (a -> b) -> a -> b
$ X
-> (Vector Word32, FrameForall)
-> Animation
-> [Maybe (Vector Word32, FrameForall)]
renderAnim X
rwidth (PreFrame3 -> (Vector Word32, FrameForall)
forall a b. (a, b) -> a
fst PreFrame3
basicFrame) Animation
anim

-- | Render and display animations on top of the current screen frame.
animate :: MonadClientUI m => LevelId -> Animation -> m ()
animate :: LevelId -> Animation -> m ()
animate arena :: LevelId
arena anim :: 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.
  Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
keyPressed (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    PreFrames3
frames <- Bool -> LevelId -> Animation -> m PreFrames3
forall (m :: * -> *).
MonadClientUI m =>
Bool -> LevelId -> Animation -> m PreFrames3
renderAnimFrames Bool
False LevelId
arena Animation
anim
    LevelId -> PreFrames3 -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames3 -> m ()
displayFrames LevelId
arena PreFrames3
frames

fadeOutOrIn :: MonadClientUI m => Bool -> m ()
fadeOutOrIn :: Bool -> m ()
fadeOutOrIn out :: Bool
out = do
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  CCUI{ScreenContent
coscreen :: ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  Animation
animMap <- Rnd Animation -> m Animation
forall (m :: * -> *) a. MonadClientUI m => Rnd a -> m a
rndToActionUI (Rnd Animation -> m Animation) -> Rnd Animation -> m Animation
forall a b. (a -> b) -> a -> b
$ ScreenContent -> Bool -> X -> Rnd Animation
fadeout ScreenContent
coscreen Bool
out 2
  PreFrames3
animFrs <- Bool -> LevelId -> Animation -> m PreFrames3
forall (m :: * -> *).
MonadClientUI m =>
Bool -> LevelId -> Animation -> m PreFrames3
renderAnimFrames Bool
True LevelId
arena Animation
animMap
  LevelId -> PreFrames3 -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames3 -> m ()
displayFrames LevelId
arena (PreFrames3 -> PreFrames3
forall a. [a] -> [a]
tail PreFrames3
animFrs)  -- no basic frame between fadeout and in