module Game.LambdaHack.Client.UI.FrameM
( drawOverlay, promptGetKey, addToMacro, dropEmptyMacroFrames
, lastMacroFrame, stopPlayBack, renderAnimFrames, animate
#ifdef EXPOSE_INTERNAL
, 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
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
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 =
Bool -> Bool
not Bool
sreqQueried
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
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
(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
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)
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
else do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPlayBack
m ()
forall (m :: * -> *). MonadClientUI m => m ()
restoreLeaderFromRun
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
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 }
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
"!"
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
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
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
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
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
animate :: MonadClientUI m => LevelId -> Animation -> m ()
animate :: LevelId -> Animation -> m ()
animate LevelId
arena Animation
anim = do
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