-- | 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 ( -- * Querying the human player queryUI -- * UI monad and session type , MonadClientUI(..), SessionUI(..) -- * Updating UI state wrt game state changes , displayRespUpdAtomicUI, displayRespSfxAtomicUI -- * Startup and initialization , KeyKind , UIOptions, applyUIOptions, uCmdline, mkUIOptions -- * Operations exposed for "Game.LambdaHack.Client.LoopM" , ChanFrontend, chanFrontend, msgAdd, tryRestore, stdBinding #ifdef EXPOSE_INTERNAL -- * Internal operations , humanCommand #endif ) where import Prelude () import Game.LambdaHack.Common.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Map.Strict as M import qualified Data.Text as T import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.Content.KeyKind import Game.LambdaHack.Client.UI.DisplayAtomicM import Game.LambdaHack.Client.UI.FrameM import Game.LambdaHack.Client.UI.Frontend import Game.LambdaHack.Client.UI.HandleHelperM import Game.LambdaHack.Client.UI.HandleHumanM import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.KeyBindings 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.Client.UI.Slideshow import Game.LambdaHack.Client.UI.SlideshowM import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import Game.LambdaHack.Content.ModeKind -- | Handle the move of a human player. queryUI :: MonadClientUI m => m RequestUI queryUI = do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD if isAIFact fact then do recordHistory keyPressed <- anyKeyPressed if keyPressed && fleaderMode (gplayer fact) /= LeaderNull then do discardPressedKey addPressedEsc -- Regaining control of faction cancels --stopAfter*. modifyClient $ \cli -> cli {soptions = (soptions cli) { sstopAfterSeconds = Nothing , sstopAfterFrames = Nothing }} return (ReqUIAutomate, Nothing) -- stop AI else do -- As long as UI faction is under AI control, check, once per move, -- for benchmark game stop. stopAfterFrames <- getsClient $ sstopAfterFrames . soptions bench <- getsClient $ sbenchmark . soptions let exitCmd = if bench then ReqUIGameDropAndExit else ReqUIGameSaveAndExit case stopAfterFrames of Nothing -> do stopAfterSeconds <- getsClient $ sstopAfterSeconds . soptions case stopAfterSeconds of Nothing -> return (ReqUINop, Nothing) Just stopS -> do exit <- elapsedSessionTimeGT stopS if exit then do tellAllClipPS return (exitCmd, Nothing) -- ask server to exit else return (ReqUINop, Nothing) Just stopF -> do allNframes <- getsSession sallNframes gnframes <- getsSession snframes if allNframes + gnframes >= stopF then do tellAllClipPS return (exitCmd, Nothing) -- ask server to exit else return (ReqUINop, Nothing) else do let mleader = gleader fact !_A = assert (isJust mleader) () req <- humanCommand leader2 <- getLeaderUI -- Don't send the leader switch to the server with these commands, -- to avoid leader death at resume if his HP <= 0. That would violate -- the principle that save and reload doesn't change game state. let saveCmd cmd = case cmd of ReqUIGameDropAndExit -> True ReqUIGameSaveAndExit -> True ReqUIGameSave -> True _ -> False return (req, if mleader /= Just leader2 && not (saveCmd req) then Just leader2 else Nothing) -- | Let the human player issue commands until any command takes time. humanCommand :: forall m. MonadClientUI m => m ReqUI humanCommand = do modifySession $ \sess -> sess { slastLost = ES.empty , shintMode = HintAbsent } let loop :: m ReqUI loop = do report <- getsSession $ newReport . shistory hintMode <- getsSession shintMode -- Hints are not considered non-empty reports. modifySession $ \sess -> sess {sreportNull = nullReport report || hintMode == HintShown} case hintMode of HintAbsent -> return () HintShown -> modifySession $ \sess -> sess {shintMode = HintWiped} HintWiped -> modifySession $ \sess -> sess {shintMode = HintAbsent} slidesRaw <- reportToSlideshowKeep [] over <- case unsnoc slidesRaw of Nothing -> return [] Just (allButLast, (ov, _)) -> if allButLast == emptySlideshow then -- Display the only generated slide while waiting for next key. -- Strip the "--end-" prompt from it. return $! init ov else do -- Show, one by one, all slides, awaiting confirmation for each. void $ getConfirms ColorFull [K.spaceKM, K.escKM] slidesRaw -- Display base frame at the end. return [] LastRecord seqCurrent seqPrevious k <- getsSession slastRecord let slastRecord | k == 0 = LastRecord [] seqCurrent 0 | otherwise = LastRecord [] (seqCurrent ++ seqPrevious) (k - 1) modifySession $ \sess -> sess {slastRecord} lastPlay <- getsSession slastPlay leader <- getLeaderUI b <- getsState $ getActorBody leader when (bhp b <= 0) $ displayMore ColorBW "If you move, the exertion will kill you. Consider asking for first aid instead." km <- promptGetKey ColorFull over False [] -- Messages shown, so update history and reset current report. when (null lastPlay) recordHistory abortOrCmd <- do -- Look up the key. Binding{bcmdMap} <- getsSession sbinding case km `M.lookup` bcmdMap of Just (_, _, cmd) -> do modifySession $ \sess -> sess {swaitTimes = if swaitTimes sess > 0 then - swaitTimes sess else 0} cmdHumanSem cmd _ -> let msgKey = "unknown command <" <> K.showKM km <> ">" in weaveJust <$> failWith (T.pack 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 report could have been generated. return cmdS Left Nothing -> loop Left (Just err) -> do stopPlayBack promptAdd1 $ showFailError err loop loop