{-# LANGUAGE CPP #-} -- | Ways for the client to use player input via UI to produce server -- requests, based on the client's view (visualized for the player) -- of the game state. module Game.LambdaHack.Client.UI ( -- * Client UI monad MonadClientUI -- * Assorted UI operations , queryUI, pongUI , displayRespUpdAtomicUI, displayRespSfxAtomicUI -- * Startup , srtFrontend, KeyKind, SessionUI -- * Operations exposed for LoopClient , ColorMode(..), displayMore, msgAdd #ifdef EXPOSE_INTERNAL -- * Internal operations , 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 -- | Handle the move of a UI player. 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 -- | Let the human player issue commands until any command takes time. humanCommand :: forall m. MonadClientUI m => m RequestUI humanCommand = do -- For human UI we invalidate whole @sbfsD@ at the start of each -- UI player input that start a player move, which is an overkill, -- but doesn't slow screensavers, because they are UI, -- but not human. 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 -- Display current state and keys if no slideshow or if interrupted. keys <- if b then describeMainKeys else return "" sli <- promptToSlideshow keys return (Nothing, head . snd $! slideshow sli) Right bLast -> -- (Re-)display the last slide while waiting for the next key. 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 -- Messages shown, so update history and reset current report. when (null lastPlay) recordHistory abortOrCmd <- do -- Look up the key. Binding{bcmdMap} <- askBinding case M.lookup km{K.pointer=Nothing} bcmdMap of Just (_, _, cmd) -> do -- Query and clear the last command key. 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 -- The command was failed or successful and if the latter, -- possibly took some time. case abortOrCmd of Right cmdS -> -- Exit the loop and let other actors act. No next key needed -- and no slides could have been generated. return cmdS Left slides -> do -- If no time taken, rinse and repeat. -- Analyse the obtained slides. let (onBlank, sli) = slideshow slides mLast <- case sli of [] -> do stgtMode <- getsClient stgtMode return $ Left $ isJust stgtMode || km == K.escKM [sLast] -> -- Avoid displaying the single slide twice. return $ Right (onBlank, sLast) _ -> do -- Show, one by one, all slides, awaiting confirmation -- for all but the last one (which is displayed twice, BTW). -- Note: the code that generates the slides is responsible -- for inserting the @more@ prompt. go <- getInitConfirms ColorFull [km] slides return $! if go then Right (onBlank, last sli) else Left True loop mLast loop $ Left False -- | Client signals to the server that it's still online, flushes frames -- (if needed) and sends some extra info. 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} -- Ask server to turn off AI for the faction's leader. let atomicCmd = UpdAtomic $ UpdAutoFaction side False pong [atomicCmd] else do -- Respond to the server normally, perhaps pinging the frontend, too. when underAI syncFrames pong []