-- | 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 :: ColorMode -> Bool -> FontOverlayMap -> LevelId -> m PreFrame3
drawOverlay ColorMode
dm Bool
onBlank FontOverlayMap
ovs 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
$ \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{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
  let propWidth :: X
propWidth = if DisplayFont -> Bool
isMonoFont DisplayFont
propFont then X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth else X
4 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth
      ovProp :: OverlaySpace
ovProp | Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont)
             = Bool -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False X
propWidth X
rheight Bool
False X
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 :: OverlaySpace
ovMono = if Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
monoFont)
               then Bool -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth) X
rheight Bool
False X
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 :: OverlaySpace
ovSquare | Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont)
               = Bool -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth) X
rheight Bool
False X
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 :: OverlaySpace
ovOther | Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont) = []
              | Bool
otherwise
              = Bool -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
True X
rwidth X
rheight Bool
True X
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 X
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 (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth) X
rheight Bool
True X
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 -> X -> X -> Bool -> X -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
False (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth) X
rheight Bool
True X
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 :: X -> [a] -> Maybe (X, X) -> Maybe (X, X)
g X
x [a]
al Maybe (X, X)
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
- X
1)
                 g X
x [a]
al (Just (X
xmin, 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
- X
1))
                 f :: EnumMap X (X, X) -> (PointUI, [a]) -> EnumMap X (X, X)
f EnumMap X (X, X)
em (PointUI X
x X
y, [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, [AttrCharW32]) -> 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, [AttrCharW32]) -> 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 OverlaySpace -> OverlaySpace -> OverlaySpace
forall a. [a] -> [a] -> [a]
++ OverlaySpace
squareOutline
                 listBackdrop :: (X, (X, X)) -> (PointUI, [AttrCharW32])
listBackdrop (X
y, (X
xmin, X
xmax)) =
                   ( X -> X -> PointUI
PointUI (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* (X
xmin X -> X -> X
forall a. Integral a => a -> a -> a
`div` X
2)) X
y
                   , X -> [AttrCharW32]
blankAttrString
                     (X -> [AttrCharW32]) -> X -> [AttrCharW32]
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
- X
2 X -> X -> X
forall a. Num a => a -> a -> a
* (X
xmin X -> X -> X
forall a. Integral a => a -> a -> a
`div` X
2))
                           (X
1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
xmax X -> X -> X
forall a. Integral a => a -> a -> a
`divUp` X
2 X -> X -> X
forall a. Num a => a -> a -> a
- X
xmin X -> X -> X
forall a. Integral a => a -> a -> a
`div` X
2) )
             in ((X, (X, X)) -> (PointUI, [AttrCharW32]))
-> [(X, (X, X))] -> OverlaySpace
forall a b. (a -> b) -> [a] -> [b]
map (X, (X, X)) -> (PointUI, [AttrCharW32])
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
ovSquare, OverlaySpace
ovMono))

promptGetKey :: MonadClientUI m
             => ColorMode -> FontOverlayMap -> Bool -> [K.KM]
             -> m K.KM
promptGetKey :: ColorMode -> FontOverlayMap -> Bool -> [KM] -> m KM
promptGetKey ColorMode
dm FontOverlayMap
ovs Bool
onBlank [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
  Bool
sreqQueried <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sreqQueried
  let interrupted :: Bool
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.
        Bool -> Bool -> Bool
|| (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) | 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 (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 :: KeyMacroFrame
smacroFrame = (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) {keyPending :: KeyMacro
keyPending = [KM] -> KeyMacro
KeyMacro [KM]
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 (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@.
          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
        -- 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
      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
      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
$ \SessionUI
sess ->
        SessionUI
sess { srunning :: Maybe RunParams
srunning = Maybe RunParams
forall a. Maybe a
Nothing
             , sxhairGoTo :: Maybe Target
sxhairGoTo = Maybe Target
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.
  --
  -- Only keys pressed when player is queried for a command are recorded.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sreqQueried (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    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
$ \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 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 :: 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 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 :: 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 :: 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 :: KeyMacroFrame
smacroFrame = KeyMacroFrame
lastFrame {keyPending :: KeyMacro
keyPending = KeyMacro
forall a. Monoid a => a
mempty}
            , smacroStack :: [KeyMacroFrame]
smacroStack = [] }

restoreLeaderFromRun :: MonadClientUI m => m ()
restoreLeaderFromRun :: m ()
restoreLeaderFromRun = do
  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
    Maybe RunParams
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

-- 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 :: LevelId -> Maybe Bool -> m PreFrame3
basicFrameForAnimation LevelId
arena Maybe Bool
forceReport = do
  FontSetup{DisplayFont
propFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  Bool
sbenchMessages <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Bool) -> m Bool)
-> (StateClient -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
sbenchMessages (ClientOptions -> Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
  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
  Report
report <- Bool -> m Report
forall (m :: * -> *). MonadClientUI m => Bool -> m Report
getReportUI Bool
False
  let par1 :: AttrLine
par1 = [AttrCharW32] -> AttrLine
firstParagraph ([AttrCharW32] -> AttrLine) -> [AttrCharW32] -> AttrLine
forall a b. (a -> b) -> a -> b
$ ([AttrCharW32] -> [AttrCharW32] -> [AttrCharW32])
-> [AttrCharW32] -> [[AttrCharW32]] -> [AttrCharW32]
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
      underAI :: Bool
underAI = Faction -> Bool
isAIFact Faction
fact
      -- If messages are benchmarked, they can't be displayed under AI,
      -- because this is not realistic when player is in control.
      truncRep :: FontOverlayMap
truncRep | Bool -> Bool
not Bool
sbenchMessages Bool -> Bool -> Bool
&& Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
underAI Maybe Bool
forceReport =
                   [(DisplayFont, Overlay)] -> FontOverlayMap
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList [(DisplayFont
propFont, [(X -> X -> PointUI
PointUI X
0 X
0, AttrLine
par1)])]
               | Bool
otherwise = FontOverlayMap
forall k a. EnumMap k a
EM.empty
  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

-- | Render animations on top of the current screen frame.
renderAnimFrames :: MonadClientUI m
                 => LevelId -> Animation -> Maybe Bool -> m PreFrames3
renderAnimFrames :: LevelId -> Animation -> Maybe Bool -> m PreFrames3
renderAnimFrames LevelId
arena Animation
anim Maybe Bool
forceReport = 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
  PreFrame3
basicFrame <- LevelId -> Maybe Bool -> m PreFrame3
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Maybe Bool -> m PreFrame3
basicFrameForAnimation LevelId
arena Maybe Bool
forceReport
  Bool
smuteMessages <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smuteMessages
  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
smuteMessages -> []
               | Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
snoAnim -> [PreFrame3 -> Maybe PreFrame3
forall a. a -> Maybe a
Just PreFrame3
basicFrame]
               | Bool
otherwise -> (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 (\(Vector Word32, FrameForall)
fr -> ((Vector Word32, FrameForall)
fr, PreFrame3 -> (OverlaySpace, 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 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.
  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 <- LevelId -> Animation -> Maybe Bool -> m PreFrames3
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> Maybe Bool -> m PreFrames3
renderAnimFrames LevelId
arena Animation
anim Maybe Bool
forall a. Maybe a
Nothing
    LevelId -> PreFrames3 -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames3 -> m ()
displayFrames LevelId
arena PreFrames3
frames