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
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 (ReqUIGameExit, Nothing)
else return (ReqUINop, Nothing)
Just stopF -> do
allNframes <- getsSession sallNframes
gnframes <- getsSession snframes
if allNframes + gnframes >= stopF then do
tellAllClipPS
return (ReqUIGameExit, Nothing)
else return (ReqUINop, Nothing)
else do
let mleader = gleader fact
!_A = assert (isJust mleader) ()
req <- humanCommand
leader2 <- getLeaderUI
return (req, if mleader /= Just leader2 then Just leader2 else Nothing)
humanCommand :: forall m. MonadClientUI m => m ReqUI
humanCommand = do
modifySession $ \sess -> sess { slastLost = ES.empty
, skeysHintMode = KeysHintAbsent }
let loop :: m ReqUI
loop = do
report <- getsSession sreport
if nullReport report then do
keysHintMode <- getsSession skeysHintMode
case keysHintMode of
KeysHintPresent -> promptMainKeys
KeysHintBlocked ->
modifySession $ \sess -> sess {skeysHintMode = KeysHintAbsent}
_ -> return ()
else modifySession $ \sess -> sess {skeysHintMode = KeysHintBlocked}
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
promptAdd $ showFailError err
loop
loop