module Game.LambdaHack.Client.UI
(
queryUI
, MonadClientUI(..), SessionUI(..)
, displayRespUpdAtomicUI, displayRespSfxAtomicUI
, CCUI(..)
, UIOptions, applyUIOptions, uCmdline, mkUIOptions
, ChanFrontend, chanFrontend, promptAdd, tryRestore
#ifdef EXPOSE_INTERNAL
, humanCommand
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.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.Input
import Game.LambdaHack.Client.UI.ContentClientUI
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.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.Client.UI.UIOptionsParse
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.Common.Types
import Game.LambdaHack.Content.ModeKind
queryUI :: (MonadClient m, MonadClientUI m) => m RequestUI
queryUI :: m RequestUI
queryUI = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
if Faction -> Bool
isAIFact Faction
fact then do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
if Bool
keyPressed Bool -> Bool -> Bool
&& Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
/= LeaderMode
LeaderNull then do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
discardPressedKey
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli ->
StateClient
cli {soptions :: ClientOptions
soptions = (StateClient -> ClientOptions
soptions StateClient
cli) { sstopAfterSeconds :: Maybe Int
sstopAfterSeconds = Maybe Int
forall a. Maybe a
Nothing
, sstopAfterFrames :: Maybe Int
sstopAfterFrames = Maybe Int
forall a. Maybe a
Nothing }}
RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
ReqUIAutomate, Maybe ActorId
forall a. Maybe a
Nothing)
else do
Maybe Int
stopAfterFrames <- (StateClient -> Maybe Int) -> m (Maybe Int)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Int) -> m (Maybe Int))
-> (StateClient -> Maybe Int) -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Maybe Int
sstopAfterFrames (ClientOptions -> Maybe Int)
-> (StateClient -> ClientOptions) -> StateClient -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
Bool
bench <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Bool) -> m Bool)
-> (StateClient -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
sbenchmark (ClientOptions -> Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
let exitCmd :: ReqUI
exitCmd = if Bool
bench then ReqUI
ReqUIGameDropAndExit else ReqUI
ReqUIGameSaveAndExit
case Maybe Int
stopAfterFrames of
Nothing -> do
Maybe Int
stopAfterSeconds <- (StateClient -> Maybe Int) -> m (Maybe Int)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Int) -> m (Maybe Int))
-> (StateClient -> Maybe Int) -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Maybe Int
sstopAfterSeconds (ClientOptions -> Maybe Int)
-> (StateClient -> ClientOptions) -> StateClient -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
case Maybe Int
stopAfterSeconds of
Nothing -> RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
ReqUINop, Maybe ActorId
forall a. Maybe a
Nothing)
Just stopS :: Int
stopS -> do
Bool
exit <- Int -> m Bool
forall (m :: * -> *). MonadClientUI m => Int -> m Bool
elapsedSessionTimeGT Int
stopS
if Bool
exit then do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
tellAllClipPS
RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
exitCmd, Maybe ActorId
forall a. Maybe a
Nothing)
else RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
ReqUINop, Maybe ActorId
forall a. Maybe a
Nothing)
Just stopF :: Int
stopF -> do
Int
allNframes <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
sallNframes
Int
gnframes <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
snframes
if Int
allNframes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gnframes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
stopF then do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
tellAllClipPS
RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
exitCmd, Maybe ActorId
forall a. Maybe a
Nothing)
else RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
ReqUINop, Maybe ActorId
forall a. Maybe a
Nothing)
else do
let mleader :: Maybe ActorId
mleader = Faction -> Maybe ActorId
gleader Faction
fact
!_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ActorId
mleader) ()
ReqUI
req <- m ReqUI
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ReqUI
humanCommand
ActorId
leader2 <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
let saveCmd :: ReqUI -> Bool
saveCmd cmd :: ReqUI
cmd = case ReqUI
cmd of
ReqUIGameDropAndExit -> Bool
True
ReqUIGameSaveAndExit -> Bool
True
ReqUIGameSave -> Bool
True
_ -> Bool
False
RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
req, if Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
leader2 Bool -> Bool -> Bool
&& Bool -> Bool
not (ReqUI -> Bool
saveCmd ReqUI
req)
then ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
leader2
else Maybe ActorId
forall a. Maybe a
Nothing)
humanCommand :: forall m. (MonadClient m, MonadClientUI m) => m ReqUI
humanCommand :: m ReqUI
humanCommand = do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess { slastLost :: EnumSet ActorId
slastLost = EnumSet ActorId
forall k. EnumSet k
ES.empty
, shintMode :: HintMode
shintMode = HintMode
HintAbsent }
let loop :: Maybe ActorId -> m ReqUI
loop :: Maybe ActorId -> m ReqUI
loop mOldLeader :: Maybe ActorId
mOldLeader = do
Report
report <- (SessionUI -> Report) -> m Report
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Report) -> m Report)
-> (SessionUI -> Report) -> m Report
forall a b. (a -> b) -> a -> b
$ History -> Report
newReport (History -> Report)
-> (SessionUI -> History) -> SessionUI -> Report
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> History
shistory
HintMode
hintMode <- (SessionUI -> HintMode) -> m HintMode
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> HintMode
shintMode
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess
{sreportNull :: Bool
sreportNull = Report -> Bool
nullReport Report
report Bool -> Bool -> Bool
|| HintMode
hintMode HintMode -> HintMode -> Bool
forall a. Eq a => a -> a -> Bool
== HintMode
HintShown}
case HintMode
hintMode of
HintAbsent -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
HintShown -> (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {shintMode :: HintMode
shintMode = HintMode
HintWiped}
HintWiped -> (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {shintMode :: HintMode
shintMode = HintMode
HintAbsent}
Slideshow
slidesRaw <- [KM] -> m Slideshow
forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
reportToSlideshowKeep []
[AttrLine]
over <- case Slideshow -> Maybe (Slideshow, OKX)
unsnoc Slideshow
slidesRaw of
Nothing -> [AttrLine] -> m [AttrLine]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (allButLast :: Slideshow
allButLast, (ov :: [AttrLine]
ov, _)) ->
if Slideshow
allButLast Slideshow -> Slideshow -> Bool
forall a. Eq a => a -> a -> Bool
== Slideshow
emptySlideshow
then
[AttrLine] -> m [AttrLine]
forall (m :: * -> *) a. Monad m => a -> m a
return ([AttrLine] -> m [AttrLine]) -> [AttrLine] -> m [AttrLine]
forall a b. (a -> b) -> a -> b
$! [AttrLine] -> [AttrLine]
forall a. [a] -> [a]
init [AttrLine]
ov
else do
m KM -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m KM -> m ()) -> m KM -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM
K.spaceKM, KM
K.escKM] Slideshow
slidesRaw
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sreportNull :: Bool
sreportNull = Bool
True}
[AttrLine] -> m [AttrLine]
forall (m :: * -> *) a. Monad m => a -> m a
return []
LastRecord seqCurrent :: [KM]
seqCurrent seqPrevious :: [KM]
seqPrevious k :: Int
k <- (SessionUI -> LastRecord) -> m LastRecord
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> LastRecord
slastRecord
let slastRecord :: LastRecord
slastRecord
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = [KM] -> [KM] -> Int -> LastRecord
LastRecord [] [KM]
seqCurrent 0
| Bool
otherwise = [KM] -> [KM] -> Int -> LastRecord
LastRecord [] ([KM]
seqCurrent [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
seqPrevious) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {LastRecord
slastRecord :: LastRecord
slastRecord :: LastRecord
slastRecord}
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
&& ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
leader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mOldLeader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorBW
"If you move, the exertion will kill you. Consider asking for first aid instead."
KM
km <- ColorMode -> [AttrLine] -> Bool -> [KM] -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [AttrLine] -> Bool -> [KM] -> m KM
promptGetKey ColorMode
ColorFull [AttrLine]
over Bool
False []
Either MError ReqUI
abortOrCmd <- do
CCUI{coinput :: CCUI -> InputContent
coinput=InputContent{Map KM CmdTriple
bcmdMap :: InputContent -> Map KM CmdTriple
bcmdMap :: Map KM CmdTriple
bcmdMap}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
case KM
km KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map KM CmdTriple
bcmdMap of
Just (_, _, cmd :: HumanCmd
cmd) -> do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess
{swaitTimes :: Int
swaitTimes = if SessionUI -> Int
swaitTimes SessionUI
sess Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
then - SessionUI -> Int
swaitTimes SessionUI
sess
else 0}
HumanCmd -> m (Either MError ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
HumanCmd -> m (Either MError ReqUI)
cmdHumanSem HumanCmd
cmd
_ -> let msgKey :: String
msgKey = "unknown command <" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> KM -> String
K.showKM KM
km String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ">"
in FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith (String -> Text
T.pack String
msgKey)
case Either MError ReqUI
abortOrCmd of
Right cmdS :: ReqUI
cmdS ->
ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
cmdS
Left Nothing -> Maybe ActorId -> m ReqUI
loop (Maybe ActorId -> m ReqUI) -> Maybe ActorId -> m ReqUI
forall a b. (a -> b) -> a -> b
$ ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
leader
Left (Just err :: FailError
err) -> do
let l0 :: [Text]
l0 = ["*never mind*", "*aiming started*"]
t :: Text
t = FailError -> Text
showFailError FailError
err
if Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
l0 then MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd0 MsgClass
MsgAlert Text
t
else MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgAlert Text
t
Maybe ActorId -> m ReqUI
loop (Maybe ActorId -> m ReqUI) -> Maybe ActorId -> m ReqUI
forall a b. (a -> b) -> a -> b
$ ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
leader
Maybe ActorId -> m ReqUI
loop Maybe ActorId
forall a. Maybe a
Nothing