module Game.LambdaHack.Client.UI.FrameM
( pushFrame, promptGetKey, addToMacro, dropEmptyMacroFrames, lastMacroFrame
, stopPlayBack, animate, fadeOutOrIn
#ifdef EXPOSE_INTERNAL
, 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
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
= ((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
| Bool
isTeletype
= []
| 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
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
pushFrame :: MonadClientUI m => Bool -> m ()
pushFrame :: Bool -> m ()
pushFrame delay :: Bool
delay = 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
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
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
(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
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)
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 { 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
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 }
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
(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
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})
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
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
animate :: MonadClientUI m => LevelId -> Animation -> m ()
animate :: LevelId -> Animation -> m ()
animate arena :: LevelId
arena anim :: 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 <- 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)