module Game.LambdaHack.Client.UI
(
MonadClientUI
, queryUI, pongUI
, displayRespUpdAtomicUI, displayRespSfxAtomicUI
, srtFrontend, KeyKind, SessionUI
, ColorMode(..), displayMore, msgAdd
#ifdef EXPOSE_INTERNAL
, humanCommand
#endif
) where
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
import Data.Maybe
import Game.LambdaHack.Atomic
import qualified Game.LambdaHack.Client.Key as K
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.Content.KeyKind
import Game.LambdaHack.Client.UI.DisplayAtomicClient
import Game.LambdaHack.Client.UI.HandleHumanClient
import Game.LambdaHack.Client.UI.HumanCmd
import Game.LambdaHack.Client.UI.KeyBindings
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.MsgClient
import Game.LambdaHack.Client.UI.StartupFrontendClient
import Game.LambdaHack.Client.UI.WidgetClient
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Request
import Game.LambdaHack.Common.State
import Game.LambdaHack.Content.ModeKind
queryUI :: MonadClientUI m => m RequestUI
queryUI = do
side <- getsClient sside
fact <- getsState $ (EM.! side) . sfactionD
let (leader, mtgt) = fromMaybe (assert `failure` fact) $ gleader fact
req <- humanCommand
leader2 <- getLeaderUI
mtgt2 <- getsClient $ fmap fst . EM.lookup leader2 . stargetD
if (leader2, mtgt2) /= (leader, mtgt)
then return $! ReqUILeader leader2 mtgt2 req
else return $! req
humanCommand :: forall m. MonadClientUI m => m RequestUI
humanCommand = do
modifyClient $ \cli -> cli {sbfsD = EM.empty, slastLost = ES.empty}
let loop :: Either Bool (Maybe Bool, Overlay) -> m RequestUI
loop mover = do
(lastBlank, over) <- case mover of
Left b -> do
keys <- if b then describeMainKeys else return ""
sli <- promptToSlideshow keys
return (Nothing, head . snd $! slideshow sli)
Right bLast ->
return bLast
(seqCurrent, seqPrevious, k) <- getsClient slastRecord
case k of
0 -> do
let slastRecord = ([], seqCurrent, 0)
modifyClient $ \cli -> cli {slastRecord}
_ -> do
let slastRecord = ([], seqCurrent ++ seqPrevious, k 1)
modifyClient $ \cli -> cli {slastRecord}
lastPlay <- getsClient slastPlay
km <- getKeyOverlayCommand lastBlank over
when (null lastPlay) recordHistory
abortOrCmd <- do
Binding{bcmdMap} <- askBinding
case M.lookup km{K.pointer=Nothing} bcmdMap of
Just (_, _, cmd) -> do
modifyClient $ \cli -> cli
{swaitTimes = if swaitTimes cli > 0
then swaitTimes cli
else 0}
escAI <- getsClient sescAI
case escAI of
EscAIStarted -> do
modifyClient $ \cli -> cli {sescAI = EscAIMenu}
cmdHumanSem cmd
EscAIMenu -> do
unless (km `elem` [K.escKM, K.returnKM]) $
modifyClient $ \cli -> cli {sescAI = EscAIExited}
cmdHumanSem cmd
_ -> do
modifyClient $ \cli -> cli {sescAI = EscAINothing}
stgtMode <- getsClient stgtMode
if km == K.escKM && isNothing stgtMode && isRight mover
then cmdHumanSem Clear
else cmdHumanSem cmd
Nothing -> let msgKey = "unknown command <" <> K.showKM km <> ">"
in failWith msgKey
case abortOrCmd of
Right cmdS ->
return cmdS
Left slides -> do
let (onBlank, sli) = slideshow slides
mLast <- case sli of
[] -> do
stgtMode <- getsClient stgtMode
return $ Left $ isJust stgtMode || km == K.escKM
[sLast] ->
return $ Right (onBlank, sLast)
_ -> do
go <- getInitConfirms ColorFull [km] slides
return $! if go then Right (onBlank, last sli) else Left True
loop mLast
loop $ Left False
pongUI :: MonadClientUI m => m RequestUI
pongUI = do
escPressed <- tryTakeMVarSescMVar
side <- getsClient sside
fact <- getsState $ (EM.! side) . sfactionD
let pong ats = return $ ReqUIPong ats
underAI = isAIFact fact
if escPressed && underAI && fleaderMode (gplayer fact) /= LeaderNull then do
modifyClient $ \cli -> cli {sescAI = EscAIStarted}
let atomicCmd = UpdAtomic $ UpdAutoFaction side False
pong [atomicCmd]
else do
when underAI syncFrames
pong []