module Game.LambdaHack.Client.UI
(
queryUI
, MonadClientUI(..), SessionUI(..)
, displayRespUpdAtomicUI, displayRespSfxAtomicUI
, KeyKind
, UIOptions, applyUIOptions, uCmdline, mkUIOptions
, ChanFrontend, chanFrontend, msgAdd, tryRestore, stdBinding
#ifdef EXPOSE_INTERNAL
, 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
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
modifyClient $ \cli ->
cli {soptions = (soptions cli) { sstopAfterSeconds = Nothing
, sstopAfterFrames = Nothing }}
return (ReqUIAutomate, Nothing)
else do
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)
else return (ReqUINop, Nothing)
Just stopF -> do
allNframes <- getsSession sallNframes
gnframes <- getsSession snframes
if allNframes + gnframes >= stopF then do
tellAllClipPS
return (exitCmd, Nothing)
else return (ReqUINop, Nothing)
else do
let mleader = gleader fact
!_A = assert (isJust mleader) ()
req <- humanCommand
leader2 <- getLeaderUI
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)
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
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
return $! init ov
else do
void $ getConfirms ColorFull [K.spaceKM, K.escKM] slidesRaw
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 []
when (null lastPlay) recordHistory
abortOrCmd <- do
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)
case abortOrCmd of
Right cmdS ->
return cmdS
Left Nothing -> loop
Left (Just err) -> do
stopPlayBack
promptAdd1 $ showFailError err
loop
loop