module Game.LambdaHack.Client.UI.FrameM
( pushFrame, promptGetKey, stopPlayBack, animate, fadeOutOrIn
#ifdef EXPOSE_INTERNAL
, drawOverlay, renderFrames, resetPlayBack
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.Vector.Unboxed as U
import Game.LambdaHack.Client.ClientOptions
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.Animation
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.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.SessionUI
import Game.LambdaHack.Common.ActorState
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 -> Overlay -> LevelId -> m PreFrame
drawOverlay :: ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
drawOverlay dm :: ColorMode
dm onBlank :: Bool
onBlank topTrunc :: Overlay
topTrunc lid :: LevelId
lid = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=coscreen :: 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
PreFrame
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)
PreFrame -> m PreFrame
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 PreFrame
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> LevelId -> m PreFrame
drawHudFrame ColorMode
dm LevelId
lid
PreFrame -> m PreFrame
forall (m :: * -> *) a. Monad m => a -> m a
return (PreFrame -> m PreFrame) -> PreFrame -> m PreFrame
forall a b. (a -> b) -> a -> b
$! ScreenContent -> Bool -> Overlay -> PreFrame -> PreFrame
overlayFrameWithLines ScreenContent
coscreen Bool
onBlank Overlay
topTrunc PreFrame
basicFrame
pushFrame :: MonadClientUI m => m ()
pushFrame :: m ()
pushFrame = 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
Report
report <- m Report
forall (m :: * -> *). MonadClientUI m => m Report
getReportUI
let truncRep :: Overlay
truncRep = [Report -> AttrLine
renderReport Report
report]
PreFrame
frame <- ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
drawOverlay ColorMode
ColorFull Bool
False Overlay
truncRep LevelId
lidV
LevelId -> PreFrames -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames -> m ()
displayFrames LevelId
lidV [PreFrame -> Maybe PreFrame
forall a. a -> Maybe a
Just PreFrame
frame]
promptGetKey :: MonadClientUI m
=> ColorMode -> Overlay -> Bool -> [K.KM] -> m K.KM
promptGetKey :: ColorMode -> Overlay -> Bool -> [KM] -> m KM
promptGetKey dm :: ColorMode
dm ov :: Overlay
ov onBlank :: Bool
onBlank frontKeyKeys :: [KM]
frontKeyKeys = do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
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 msgDisturbs :: Bool
msgDisturbs = (MsgClass -> Bool) -> Report -> Bool
anyInReport MsgClass -> Bool
disturbsResting Report
report
[KM]
lastPlayOld <- (SessionUI -> [KM]) -> m [KM]
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> [KM]
slastPlay
KM
km <- case [KM]
lastPlayOld of
km :: KM
km : kms :: [KM]
kms | Bool -> Bool
not Bool
keyPressed
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)
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
msgDisturbs -> do
PreFrame
frontKeyFrame <- ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
drawOverlay ColorMode
dm Bool
onBlank Overlay
ov LevelId
lidV
LevelId -> PreFrames -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames -> m ()
displayFrames LevelId
lidV [PreFrame -> Maybe PreFrame
forall a. a -> Maybe a
Just PreFrame
frontKeyFrame]
(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 {slastPlay :: [KM]
slastPlay = [KM]
kms}
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgMacro (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
_ : _ -> do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPlayBack
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
let ov2 :: Overlay
ov2 = [Color -> Text -> AttrLine
textFgToAL Color
Color.BrYellow "*interrupted*" | Bool
keyPressed] Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
ov
PreFrame
frontKeyFrame <- ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
drawOverlay ColorMode
dm Bool
onBlank Overlay
ov2 LevelId
lidV
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
[KM] -> PreFrame -> m KM
forall (m :: * -> *). MonadClientUI m => [KM] -> PreFrame -> m KM
connFrontendFrontKey [KM]
frontKeyKeys PreFrame
frontKeyFrame
[] -> 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 {srunning :: Maybe RunParams
srunning = Maybe RunParams
forall a. Maybe a
Nothing}
PreFrame
frontKeyFrame <- ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
drawOverlay ColorMode
dm Bool
onBlank Overlay
ov 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 () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
[KM] -> PreFrame -> m KM
forall (m :: * -> *). MonadClientUI m => [KM] -> PreFrame -> m KM
connFrontendFrontKey [KM]
frontKeyKeys PreFrame
frontKeyFrame
LastRecord seqCurrent :: [KM]
seqCurrent seqPrevious :: [KM]
seqPrevious k :: X
k <- (SessionUI -> LastRecord) -> m LastRecord
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> LastRecord
slastRecord
let slastRecord :: LastRecord
slastRecord = [KM] -> [KM] -> X -> LastRecord
LastRecord (KM
km KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: [KM]
seqCurrent) [KM]
seqPrevious X
k
(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 { LastRecord
slastRecord :: LastRecord
slastRecord :: LastRecord
slastRecord
, sdisplayNeeded :: Bool
sdisplayNeeded = Bool
False }
KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
stopPlayBack :: MonadClientUI m => m ()
stopPlayBack :: m ()
stopPlayBack = MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd0 MsgClass
MsgStopPlayback "!"
resetPlayBack :: MonadClientUI m => m ()
resetPlayBack :: m ()
resetPlayBack = do
[KM]
lastPlayOld <- (SessionUI -> [KM]) -> m [KM]
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> [KM]
slastPlay
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([KM] -> Bool
forall a. [a] -> Bool
null [KM]
lastPlayOld) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 {slastPlay :: [KM]
slastPlay = []}
LastRecord _ _ k :: X
k <- (SessionUI -> LastRecord) -> m LastRecord
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> LastRecord
slastRecord
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (X
k X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 {slastRecord :: LastRecord
slastRecord = [KM] -> [KM] -> X -> LastRecord
LastRecord [] [] 0}
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Macro recording aborted."
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})
renderFrames :: MonadClientUI m => LevelId -> Animation -> m PreFrames
renderFrames :: LevelId -> Animation -> m PreFrames
renderFrames arena :: LevelId
arena anim :: Animation
anim = do
Report
report <- m Report
forall (m :: * -> *). MonadClientUI m => m Report
getReportUI
let truncRep :: Overlay
truncRep = [Report -> AttrLine
renderReport Report
report]
PreFrame
basicFrame <- ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame
drawOverlay ColorMode
ColorFull Bool
False Overlay
truncRep LevelId
arena
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
PreFrames -> m PreFrames
forall (m :: * -> *) a. Monad m => a -> m a
return (PreFrames -> m PreFrames) -> PreFrames -> m PreFrames
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 [PreFrame -> Maybe PreFrame
forall a. a -> Maybe a
Just PreFrame
basicFrame]
else PreFrame -> Animation -> PreFrames
renderAnim PreFrame
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
PreFrames
frames <- LevelId -> Animation -> m PreFrames
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m PreFrames
renderFrames LevelId
arena Animation
anim
LevelId -> PreFrames -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames -> m ()
displayFrames LevelId
arena PreFrames
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. MonadClientRead m => Rnd a -> m a
rndToActionForget (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
PreFrames
animFrs <- LevelId -> Animation -> m PreFrames
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m PreFrames
renderFrames LevelId
arena Animation
animMap
LevelId -> PreFrames -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames -> m ()
displayFrames LevelId
arena (PreFrames -> PreFrames
forall a. [a] -> [a]
tail PreFrames
animFrs)