-- | Client monad for interacting with a human through UI.
module Game.LambdaHack.Client.UI.MonadClientUI
  ( -- * Client UI monad
    MonadClientUI( getsSession
                 , modifySession
                 , updateClientLeader
                 , getCacheBfs
                 , getCachePath
                 )
    -- * Assorted primitives
  , clientPrintUI, debugPossiblyPrintUI, getSession, putSession, displayFrames
  , connFrontendFrontKey, setFrontAutoYes, frontendShutdown, printScreen
  , chanFrontend, anyKeyPressed, discardPressedKey, resetPressedKeys
  , revCmdMap, getReportUI, getMiniHintAiming, computeChosenLore
  , getArenaUI, viewedLevelUI, mxhairToPos, xhairToPos, setXHairFromGUI
  , clearAimMode, getFontSetup, scoreToSlideshow, defaultHistory
  , tellAllClipPS, tellGameClipPS, elapsedSessionTimeGT
  , resetSessionStart, resetGameStart, partActorLeader, partPronounLeader
  , tryRestore, rndToActionUI, tryOpenBrowser
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , connFrontend, displayFrame
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Control.Monad.Trans.State.Strict as St
import qualified Data.EnumMap.Strict as EM
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.IO as T
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
import           Data.Time.LocalTime
import qualified Data.Vector.Unboxed as U
import qualified NLP.Miniutter.English as MU
import           System.IO (hFlush, stdout)
import           Web.Browser (openBrowser)

import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Content.Input
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.EffectDescription
import           Game.LambdaHack.Client.UI.Frame
import qualified Game.LambdaHack.Client.UI.Frontend as Frontend
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.Overlay
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.Slideshow
import           Game.LambdaHack.Client.UI.UIOptions
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.ClientOptions
import           Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.HighScore as HighScore
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import qualified Game.LambdaHack.Common.Save as Save
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.FactionKind
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Core.Random

-- Assumes no interleaving with other clients, because each UI client
-- in a different terminal/window/machine.
clientPrintUI :: MonadClientUI m => Text -> m ()
clientPrintUI :: forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
t = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> Text -> IO ()
T.hPutStr Handle
stdout (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"  -- hPutStrLn not atomic enough
  Handle -> IO ()
hFlush Handle
stdout

debugPossiblyPrintUI :: MonadClientUI m => Text -> m ()
debugPossiblyPrintUI :: forall (m :: * -> *). MonadClientUI m => Text -> m ()
debugPossiblyPrintUI Text
t = do
  sdbgMsgCli <- (StateClient -> Bool) -> m Bool
forall a. (StateClient -> a) -> m a
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
sdbgMsgCli (ClientOptions -> Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
  when sdbgMsgCli $ liftIO $ do
    T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough
    hFlush stdout

-- | The monad that gives the client access to UI operations,
-- but not to modifying client state, except for the client-side pointman
-- (as opposed to pointman stores in faction data in main game state),
-- which is more of a UI concept, but is shared with AI to be able
-- to keep it when switching AI on/off and to save on typing.
class MonadClientRead m => MonadClientUI m where
  getsSession :: (SessionUI -> a) -> m a
  modifySession :: (SessionUI -> SessionUI) -> m ()
  updateClientLeader :: ActorId -> m ()
  getCacheBfs :: ActorId -> m (PointArray.Array BfsDistance)
  getCachePath :: ActorId -> Point -> m (Maybe AndPath)

getSession :: MonadClientUI m => m SessionUI
getSession :: forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession = (SessionUI -> SessionUI) -> m SessionUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> SessionUI
forall a. a -> a
id

putSession :: MonadClientUI m => SessionUI -> m ()
putSession :: forall (m :: * -> *). MonadClientUI m => SessionUI -> m ()
putSession SessionUI
s = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession (SessionUI -> SessionUI -> SessionUI
forall a b. a -> b -> a
const SessionUI
s)

-- | Write a UI request to the frontend and read a corresponding reply.
connFrontend :: MonadClientUI m => Frontend.FrontReq a -> m a
connFrontend :: forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq a
req = do
  Frontend.ChanFrontend f <- (SessionUI -> ChanFrontend) -> m ChanFrontend
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChanFrontend
schanF
  liftIO $ f req

displayFrame :: MonadClientUI m => Maybe Frame -> m ()
displayFrame :: forall (m :: * -> *). MonadClientUI m => Maybe Frame -> m ()
displayFrame Maybe Frame
mf = do
  frame <- case Maybe Frame
mf of
    Maybe Frame
Nothing -> FrontReq () -> m (FrontReq ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrontReq () -> m (FrontReq ())) -> FrontReq () -> m (FrontReq ())
forall a b. (a -> b) -> a -> b
$! Int -> FrontReq ()
Frontend.FrontDelay Int
1
    Just Frame
fr -> 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
$ \SessionUI
cli -> SessionUI
cli {snframes = snframes cli + 1}
      FrontReq () -> m (FrontReq ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrontReq () -> m (FrontReq ())) -> FrontReq () -> m (FrontReq ())
forall a b. (a -> b) -> a -> b
$! Frame -> FrontReq ()
Frontend.FrontFrame Frame
fr
  connFrontend frame

-- | Push frames or delays to the frame queue. The frames depict
-- the @lid@ level.
displayFrames :: MonadClientUI m => LevelId -> PreFrames3 -> m ()
displayFrames :: forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames3 -> m ()
displayFrames LevelId
_ [] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- shortcut
displayFrames LevelId
lid PreFrames3
frs = do
  let framesRaw :: [Maybe Frame]
framesRaw = case PreFrames3
frs of
        [Just ((Vector Word32
bfr, FrameForall
ffr), (OverlaySpace
ovProp, OverlaySpace
ovSquare, OverlaySpace
ovMono))] ->
          [Frame -> Maybe Frame
forall a. a -> Maybe a
Just ( ((forall s. ST s (Mutable Vector s Word32)) -> FrameBase
FrameBase ((forall s. ST s (Mutable Vector s Word32)) -> FrameBase)
-> (forall s. ST s (Mutable Vector s Word32)) -> FrameBase
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> ST s (MVector (PrimState (ST s)) Word32)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
U.unsafeThaw Vector Word32
bfr, FrameForall
ffr)
                , (OverlaySpace
ovProp, OverlaySpace
ovSquare, OverlaySpace
ovMono) )]
        PreFrames3
_ ->
          -- Due to the frames coming from the same base frame,
          -- we have to copy it to avoid picture corruption.
          (Maybe PreFrame3 -> Maybe Frame) -> PreFrames3 -> [Maybe Frame]
forall a b. (a -> b) -> [a] -> [b]
map ((PreFrame3 -> Frame) -> Maybe PreFrame3 -> Maybe Frame
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PreFrame3 -> Frame) -> Maybe PreFrame3 -> Maybe Frame)
-> (PreFrame3 -> Frame) -> Maybe PreFrame3 -> Maybe Frame
forall a b. (a -> b) -> a -> b
$ \((Vector Word32
bfr, FrameForall
ffr), (OverlaySpace
ovProp, OverlaySpace
ovSquare, OverlaySpace
ovMono)) ->
                (((forall s. ST s (Mutable Vector s Word32)) -> FrameBase
FrameBase ((forall s. ST s (Mutable Vector s Word32)) -> FrameBase)
-> (forall s. ST s (Mutable Vector s Word32)) -> FrameBase
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> ST s (MVector (PrimState (ST s)) Word32)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
U.thaw Vector Word32
bfr, FrameForall
ffr), (OverlaySpace
ovProp, OverlaySpace
ovSquare, OverlaySpace
ovMono))) PreFrames3
frs
  -- If display level different than the man viewed level,
  -- e.g., when our actor is attacked on a remote level,
  -- then pad with tripple delay to give more time to see the remote frames(s).
  lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  frames <- if lidV == lid
            then do
              modifySession $ \SessionUI
sess -> SessionUI
sess { sdisplayNeeded = False
                                            , sturnDisplayed = True }
              return framesRaw
            else return $ framesRaw ++ [Nothing, Nothing, Nothing]
  mapM_ displayFrame frames

-- | Write 'Frontend.FrontKey' UI request to the frontend, read the reply,
-- set pointer, return key.
connFrontendFrontKey :: MonadClientUI m => [K.KM] -> PreFrame3 -> m K.KM
connFrontendFrontKey :: forall (m :: * -> *). MonadClientUI m => [KM] -> PreFrame3 -> m KM
connFrontendFrontKey [KM]
frontKeyKeys ((Vector Word32
bfr, FrameForall
ffr), (OverlaySpace
ovProp, OverlaySpace
ovSquare, OverlaySpace
ovMono)) = do
  let frontKeyFrame :: Frame
frontKeyFrame =
        (((forall s. ST s (Mutable Vector s Word32)) -> FrameBase
FrameBase ((forall s. ST s (Mutable Vector s Word32)) -> FrameBase)
-> (forall s. ST s (Mutable Vector s Word32)) -> FrameBase
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> ST s (MVector (PrimState (ST s)) Word32)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
U.unsafeThaw Vector Word32
bfr, FrameForall
ffr), (OverlaySpace
ovProp, OverlaySpace
ovSquare, OverlaySpace
ovMono))
  sautoYes <- (SessionUI -> Bool) -> m Bool
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sautoYes
  if sautoYes && (null frontKeyKeys || K.spaceKM `elem` frontKeyKeys) then do
    connFrontend $ Frontend.FrontFrame frontKeyFrame
    return K.spaceKM
  else do
    kmp <- connFrontend $ Frontend.FrontKey frontKeyKeys frontKeyFrame
    modifySession $ \SessionUI
sess -> SessionUI
sess {spointer = K.kmpPointer kmp}
    return $! K.kmpKeyMod kmp

setFrontAutoYes :: MonadClientUI m => Bool -> m ()
setFrontAutoYes :: forall (m :: * -> *). MonadClientUI m => Bool -> m ()
setFrontAutoYes Bool
b = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {sautoYes = b}

frontendShutdown :: MonadClientUI m => m ()
frontendShutdown :: forall (m :: * -> *). MonadClientUI m => m ()
frontendShutdown = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
Frontend.FrontShutdown

printScreen :: MonadClientUI m => m ()
printScreen :: forall (m :: * -> *). MonadClientUI m => m ()
printScreen = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
Frontend.FrontPrintScreen

-- | Initialize the frontend chosen by the player via client options.
chanFrontend :: MonadClientUI m
             => ScreenContent -> ClientOptions -> m Frontend.ChanFrontend
chanFrontend :: forall (m :: * -> *).
MonadClientUI m =>
ScreenContent -> ClientOptions -> m ChanFrontend
chanFrontend ScreenContent
coscreen ClientOptions
soptions =
  IO ChanFrontend -> m ChanFrontend
forall a. IO a -> m a
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO ChanFrontend -> m ChanFrontend)
-> IO ChanFrontend -> m ChanFrontend
forall a b. (a -> b) -> a -> b
$ ScreenContent -> ClientOptions -> IO ChanFrontend
Frontend.chanFrontendIO ScreenContent
coscreen ClientOptions
soptions

anyKeyPressed :: MonadClientUI m => m Bool
anyKeyPressed :: forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed = FrontReq Bool -> m Bool
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq Bool
Frontend.FrontPressed

discardPressedKey :: MonadClientUI m => m ()
discardPressedKey :: forall (m :: * -> *). MonadClientUI m => m ()
discardPressedKey = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
Frontend.FrontDiscardKey

resetPressedKeys :: MonadClientUI m => m ()
resetPressedKeys :: forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
Frontend.FrontResetKeys

revCmdMap :: MonadClientUI m => m (HumanCmd.HumanCmd -> K.KM)
revCmdMap :: forall (m :: * -> *). MonadClientUI m => m (HumanCmd -> KM)
revCmdMap = do
  CCUI{coinput=InputContent{brevMap}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  let revCmd HumanCmd
cmd = case HumanCmd -> Map HumanCmd [KM] -> Maybe [KM]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup HumanCmd
cmd Map HumanCmd [KM]
brevMap of
        Maybe [KM]
Nothing -> KM
K.undefinedKM
        Just (KM
k : [KM]
_) -> KM
k
        Just [] -> String -> KM
forall a. HasCallStack => String -> a
error (String -> KM) -> String -> KM
forall a b. (a -> b) -> a -> b
$ String
"" String -> Map HumanCmd [KM] -> String
forall v. Show v => String -> v -> String
`showFailure` Map HumanCmd [KM]
brevMap
  return revCmd

getReportUI :: MonadClientUI m => Bool -> m Report
getReportUI :: forall (m :: * -> *). MonadClientUI m => Bool -> m Report
getReportUI Bool
insideMenu = do
  saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  sUIOptions <- getsSession sUIOptions
  report <- getsSession $ newReport . shistory
  sreqDelay <- getsSession sreqDelay
  miniHintAiming <- getMiniHintAiming
  -- Different from ordinary tutorial hints in that shown more than once.
  let detailAtDefault = (AimMode -> DetailLevel
detailLevel (AimMode -> DetailLevel) -> Maybe AimMode -> Maybe DetailLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AimMode
saimMode) Maybe DetailLevel -> Maybe DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
defaultDetailLevel
      detailMinimal = (AimMode -> DetailLevel
detailLevel (AimMode -> DetailLevel) -> Maybe AimMode -> Maybe DetailLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AimMode
saimMode) Maybe DetailLevel -> Maybe DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
forall a. Bounded a => a
minBound
      prefixColors = UIOptions -> [(String, Color)]
uMessageColors UIOptions
sUIOptions
      promptAim = [(String, Color)] -> MsgClassShow -> Text -> Msg
forall a. MsgShared a => [(String, Color)] -> a -> Text -> Msg
toMsgShared [(String, Color)]
prefixColors MsgClassShow
MsgPromptGeneric
                              (Text
miniHintAiming Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
      promptDelay = [(String, Color)] -> MsgClassShow -> Text -> Msg
forall a. MsgShared a => [(String, Color)] -> a -> Text -> Msg
toMsgShared [(String, Color)]
prefixColors MsgClassShow
MsgPromptAction
                                Text
"<press any key to regain control>"
  return $! if | not insideMenu && detailAtDefault && not detailMinimal ->
                   consReport promptAim report
               | sreqDelay == ReqDelayAlarm && not insideMenu ->
                   consReport promptDelay report
               | otherwise -> report

getMiniHintAiming :: MonadClientUI m => m Text
getMiniHintAiming :: forall (m :: * -> *). MonadClientUI m => m Text
getMiniHintAiming = do
  saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  (inhabitants, embeds) <-
    if isJust saimMode then computeChosenLore else return ([], [])
  sreqDelay <- getsSession sreqDelay
  mleader <- getsClient sleader
  let loreCommandAvailable = Bool -> Bool
not ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
inhabitants Bool -> Bool -> Bool
&& [(ItemId, ItemQuant)] -> Bool
forall a. [a] -> Bool
null [(ItemId, ItemQuant)]
embeds)
                             Bool -> Bool -> Bool
&& Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ActorId
mleader
  -- Here we assume newbies don't override default keys.
  return $! T.unwords $ concat
    [ ["Aiming mode:"]
    , ["'~' for lore," | loreCommandAvailable ]
    , ["'f' to fling," | sreqDelay /= ReqDelayHandled]
    , [if loreCommandAvailable && sreqDelay /= ReqDelayHandled
       then "SPACE or RMB to hush,"  -- shorter, because less space left
       else "SPACE or RMB to cycle detail,"]
    , ["ESC to cancel."] ]

computeChosenLore :: MonadClientUI m
                  => m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
computeChosenLore :: forall (m :: * -> *).
MonadClientUI m =>
m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
computeChosenLore = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  xhairPos <- xhairToPos
  lidV <- viewedLevelUI
  let isOurs (ActorId
_, Actor
b) = Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
  inhabitants0 <- getsState $ filter (not . isOurs)
                              . posToAidAssocs xhairPos lidV
  embeds0 <- getsState $ EM.assocs . getEmbedBag lidV xhairPos
  return (inhabitants0, embeds0)

getArenaUI :: MonadClientUI m => m LevelId
getArenaUI :: forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI = do
  let fallback :: m LevelId
fallback = do
        side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
        fact <- getsState $ (EM.! side) . sfactionD
        case gquit fact of
          Just Status{Int
stDepth :: Int
stDepth :: Status -> Int
stDepth} -> LevelId -> m LevelId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelId -> m LevelId) -> LevelId -> m LevelId
forall a b. (a -> b) -> a -> b
$! Int -> LevelId
forall a. Enum a => Int -> a
toEnum Int
stDepth
          Maybe Status
Nothing -> Faction -> m LevelId
forall (m :: * -> *). MonadStateRead m => Faction -> m LevelId
getEntryArena Faction
fact
  mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  case mleader of
    Just ActorId
leader -> do
      -- The leader may just be teleporting (e.g., due to displace
      -- over terrain not in FOV) so not existent momentarily.
      mem <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId Actor -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member ActorId
leader (EnumMap ActorId Actor -> Bool)
-> (State -> EnumMap ActorId Actor) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ActorId Actor
sactorD
      if mem
      then getsState $ blid . getActorBody leader
      else fallback
    Maybe ActorId
Nothing -> m LevelId
fallback

viewedLevelUI :: MonadClientUI m => m LevelId
viewedLevelUI :: forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI = do
  arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  saimMode <- getsSession saimMode
  return $! maybe arena aimLevelId saimMode

mxhairToPos :: MonadClientUI m => m (Maybe Point)
mxhairToPos :: forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos = do
  lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  mleader <- getsClient sleader
  sxhair <- getsSession sxhair
  getsState $ aidTgtToPos mleader lidV sxhair

xhairToPos :: MonadClientUI m => m Point
xhairToPos :: forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos = do
  mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
  mleader <- getsClient sleader
  fallback <- case mleader of
    Maybe ActorId
Nothing -> Point -> m Point
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Point
originPoint
    Just ActorId
leader -> (State -> Point) -> m Point
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Point) -> m Point) -> (State -> Point) -> m Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
  return $! fromMaybe fallback mxhairPos

setXHairFromGUI :: MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI :: forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
xhair2 = do
  xhair0 <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
  modifySession $ \SessionUI
sess -> SessionUI
sess {sxhairGoTo = Nothing}
  when (xhair0 /= xhair2) $ modifySession $ \SessionUI
sess -> SessionUI
sess {sxhair = xhair2}

-- If aim mode is exited, usually the player had the opportunity to deal
-- with xhair on a foe spotted on another level, so now move xhair
-- back to the leader level.
clearAimMode :: MonadClientUI m => m ()
clearAimMode :: forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode = do
  lidVOld <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI  -- not in aiming mode at this point
  xhairPos <- xhairToPos  -- computed while still in aiming mode
  modifySession $ \SessionUI
sess -> SessionUI
sess {saimMode = Nothing}
  lidV <- viewedLevelUI  -- not in aiming mode at this point
  when (lidVOld /= lidV) $ do
    sxhairOld <- getsSession sxhair
    let sxhair = case Maybe Target
sxhairOld of
          Just TPoint{} -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown LevelId
lidV Point
xhairPos
            -- the point is possibly unknown on this level; unimportant anyway
          Maybe Target
_ -> Maybe Target
sxhairOld
    setXHairFromGUI sxhair

-- We can't support setup @FontSetup SquareFont MonoFont MonoFont@
-- at this time, because the mono layer needs to overwrite the prop layer
-- and so has to be distinct even if the underlying font is mono for both.
getFontSetup :: MonadClientUI m => m FontSetup
getFontSetup :: forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup = do
  soptions@ClientOptions{schosenFontset, sfontsets} <- (StateClient -> ClientOptions) -> m ClientOptions
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  let chosenFontsetID = Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
schosenFontset
      chosenFontset = case Text -> [(Text, FontSet)] -> Maybe FontSet
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
chosenFontsetID [(Text, FontSet)]
sfontsets of
        Maybe FontSet
Nothing -> String -> FontSet
forall a. HasCallStack => String -> a
error (String -> FontSet) -> String -> FontSet
forall a b. (a -> b) -> a -> b
$ String
"Fontset not defined in config file"
                           String -> Text -> String
forall v. Show v => String -> v -> String
`showFailure` Text
chosenFontsetID
        Just FontSet
fs -> FontSet
fs
      multiFont = ClientOptions -> String
Frontend.frontendName ClientOptions
soptions String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sdl"
                  Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null (FontSet -> Text
fontPropRegular FontSet
chosenFontset))
  return $! if multiFont then multiFontSetup else singleFontSetup

scoreToSlideshow :: MonadClientUI m => Int -> Status -> m Slideshow
scoreToSlideshow :: forall (m :: * -> *).
MonadClientUI m =>
Int -> Status -> m Slideshow
scoreToSlideshow Int
total Status
status = do
  CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  fid <- getsClient sside
  scoreDict <- getsState shigh
  gameModeId <- getsState sgameModeId
  gameMode <- getGameMode
  time <- getsState stime
  dungeonTotal <- getsState sgold
  date <- liftIO getPOSIXTime
  tz <- liftIO $ getTimeZone $ posixSecondsToUTCTime date
  curChalSer <- getsClient scurChal
  factionD <- getsState sfactionD
  let fact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
      table = ContentId ModeKind -> ScoreDict -> ScoreTable
HighScore.getTable ContentId ModeKind
gameModeId ScoreDict
scoreDict
      gameModeName = ModeKind -> Text
mname ModeKind
gameMode
      theirVic (FactionId
fi, Faction
fa) | FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
fid Faction
fact FactionId
fi
                          Bool -> Bool -> Bool
&& Bool -> Bool
not (Faction -> Bool
isHorrorFact Faction
fa) = EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int)
forall a. a -> Maybe a
Just (EnumMap (ContentId ItemKind) Int
 -> Maybe (EnumMap (ContentId ItemKind) Int))
-> EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int)
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fa
                        | Bool
otherwise = Maybe (EnumMap (ContentId ItemKind) Int)
forall a. Maybe a
Nothing
      theirVictims = (Int -> Int -> Int)
-> [EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([EnumMap (ContentId ItemKind) Int]
 -> EnumMap (ContentId ItemKind) Int)
-> [EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int))
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int)
theirVic ([(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int])
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD
      ourVic (FactionId
fi, Faction
fa) | FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fid Faction
fact FactionId
fi = EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int)
forall a. a -> Maybe a
Just (EnumMap (ContentId ItemKind) Int
 -> Maybe (EnumMap (ContentId ItemKind) Int))
-> EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int)
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fa
                      | Bool
otherwise = Maybe (EnumMap (ContentId ItemKind) Int)
forall a. Maybe a
Nothing
      ourVictims = (Int -> Int -> Int)
-> [EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([EnumMap (ContentId ItemKind) Int]
 -> EnumMap (ContentId ItemKind) Int)
-> [EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int))
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int)
ourVic ([(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int])
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD
      (worthMentioning, (ntable, pos)) =
        HighScore.register table total dungeonTotal time status date curChalSer
                           (T.unwords $ tail $ T.words $ gname fact)
                           ourVictims theirVictims
                           (fhiCondPoly $ gkind fact)
  fontSetup <- getFontSetup
  let sli = FontSetup
-> Bool
-> Int
-> Int
-> ScoreTable
-> Int
-> Text
-> TimeZone
-> Slideshow
highSlideshow FontSetup
fontSetup Bool
False Int
rwidth (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ScoreTable
ntable Int
pos
                          Text
gameModeName TimeZone
tz
  return $! if worthMentioning
            then sli
            else emptySlideshow

defaultHistory :: MonadClientUI m => m History
defaultHistory :: forall (m :: * -> *). MonadClientUI m => m History
defaultHistory = do
  sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
  curTutorial <- getsSession scurTutorial
  overrideTut <- getsSession soverrideTut
  let displayHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
curTutorial Maybe Bool
overrideTut
  liftIO $ do
    utcTime <- getCurrentTime
    timezone <- getTimeZone utcTime
    let curDate = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
19 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ LocalTime -> String
forall a. Show a => a -> String
show (LocalTime -> String) -> LocalTime -> String
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
timezone UTCTime
utcTime
        emptyHist = Int -> History
emptyHistory (Int -> History) -> Int -> History
forall a b. (a -> b) -> a -> b
$ UIOptions -> Int
uHistoryMax UIOptions
sUIOptions
        msg = [(String, Color)] -> MsgClassShowAndSave -> Text -> Msg
forall a. MsgShared a => [(String, Color)] -> a -> Text -> Msg
toMsgShared (UIOptions -> [(String, Color)]
uMessageColors UIOptions
sUIOptions) MsgClassShowAndSave
MsgBookKeeping
              (Text -> Msg) -> Text -> Msg
forall a b. (a -> b) -> a -> b
$ Text
"History log started on " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
curDate Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
        -- Tuturial hints from initial message can be repeated.
        (_, nhistory, _) =
          addToReport S.empty displayHints False emptyHist msg timeZero
    return nhistory

tellAllClipPS :: MonadClientUI m => m ()
tellAllClipPS :: forall (m :: * -> *). MonadClientUI m => m ()
tellAllClipPS = do
  bench <- (StateClient -> Bool) -> m Bool
forall a. (StateClient -> a) -> m a
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
  when bench $ do
    sstartPOSIX <- getsSession sstart
    curPOSIX <- liftIO getPOSIXTime
    allTime <- getsSession sallTime
    gtime <- getsState stime
    allNframes <- getsSession sallNframes
    gnframes <- getsSession snframes
    let time = Time -> Time -> Time
absoluteTimeAdd Time
allTime Time
gtime
        nframes = Int
allNframes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gnframes
        diff = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational (POSIXTime -> Rational) -> POSIXTime -> Rational
forall a b. (a -> b) -> a -> b
$ POSIXTime
curPOSIX POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
sstartPOSIX
        cps = Int -> Double
intToDouble (Time -> Time -> Int
timeFit Time
time Time
timeClip) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
diff
        fps = Int -> Double
intToDouble Int
nframes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
diff
    clientPrintUI $
      "Session time:" <+> tshow diff <> "s; frames:" <+> tshow nframes <> "."
      <+> "Average clips per second:" <+> tshow cps <> "."
      <+> "Average FPS:" <+> tshow fps <> "."

tellGameClipPS :: MonadClientUI m => m ()
tellGameClipPS :: forall (m :: * -> *). MonadClientUI m => m ()
tellGameClipPS = do
  bench <- (StateClient -> Bool) -> m Bool
forall a. (StateClient -> a) -> m a
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
  when bench $ do
    sgstartPOSIX <- getsSession sgstart
    curPOSIX <- liftIO getPOSIXTime
    -- If loaded game, don't report anything.
    unless (sgstartPOSIX == 0) $ do
      time <- getsState stime
      nframes <- getsSession snframes
      let diff = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational (POSIXTime -> Rational) -> POSIXTime -> Rational
forall a b. (a -> b) -> a -> b
$ POSIXTime
curPOSIX POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
sgstartPOSIX
          cps = Int -> Double
intToDouble (Time -> Time -> Int
timeFit Time
time Time
timeClip) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
diff
          fps = Int -> Double
intToDouble Int
nframes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
diff
      -- This means: "Game portion after last reload time:...".
      clientPrintUI $
        "Game time:" <+> tshow diff <> "s; frames:" <+> tshow nframes <> "."
        <+> "Average clips per second:" <+> tshow cps <> "."
        <+> "Average FPS:" <+> tshow fps <> "."

-- TODO: for speed and resolution use
-- https://hackage.haskell.org/package/chronos
-- or the number_of_nanonseconds functionality
-- in Data.Time.Clock.System, once it arrives there
elapsedSessionTimeGT :: MonadClientRead m => POSIXTime -> Int -> m Bool
elapsedSessionTimeGT :: forall (m :: * -> *).
MonadClientRead m =>
POSIXTime -> Int -> m Bool
elapsedSessionTimeGT POSIXTime
sstartPOSIX Int
stopAfter = do
  current <- IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  return $! (fromIntegralWrap :: Int -> NominalDiffTime) stopAfter
            + sstartPOSIX
            <= current

resetSessionStart :: MonadClientUI m => m ()
resetSessionStart :: forall (m :: * -> *). MonadClientUI m => m ()
resetSessionStart = do
  sstart <- IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  modifySession $ \SessionUI
sess -> SessionUI
sess {sstart}
  resetGameStart

resetGameStart :: MonadClientUI m => m ()
resetGameStart :: forall (m :: * -> *). MonadClientUI m => m ()
resetGameStart = do
  sgstart <- IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  time <- getsState stime
  nframes <- getsSession snframes
  modifySession $ \SessionUI
sess ->
    SessionUI
sess { sgstart
        , sallTime = absoluteTimeAdd (sallTime sess) time
        , snframes = 0
        , sallNframes = sallNframes sess + nframes }

-- | The part of speech describing the actor or the "you" pronoun if he is
-- the leader of the observer's faction.
partActorLeader :: MonadClientUI m => ActorId -> m MU.Part
partActorLeader :: forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid = do
  mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  bUI <- getsSession $ getActorUI aid
  b <- getsState $ getActorBody aid
  return $! case mleader of
    Just ActorId
leader | ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader -> Part
"you"
    Maybe ActorId
_ | Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b) ->  -- avoid "the fallen falling" projectiles
      [Part] -> Part
MU.Phrase [Part
"the fallen", ActorUI -> Part
partActor ActorUI
bUI]
    Maybe ActorId
_ -> ActorUI -> Part
partActor ActorUI
bUI

-- | The part of speech with the actor's pronoun or "you" if a leader
-- of the client's faction.
partPronounLeader :: MonadClientUI m => ActorId -> m MU.Part
partPronounLeader :: forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
aid = do
  mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  bUI <- getsSession $ getActorUI aid
  return $! case mleader of
    Just ActorId
leader | ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader -> Part
"you"
    Maybe ActorId
_ -> ActorUI -> Part
partPronoun ActorUI
bUI

-- | Try to read saved client game state from the file system.
tryRestore :: MonadClientUI m => m (Maybe (StateClient, Maybe SessionUI))
tryRestore :: forall (m :: * -> *).
MonadClientUI m =>
m (Maybe (StateClient, Maybe SessionUI))
tryRestore = do
  COps{corule} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  clientOptions <- getsClient soptions
  if sbenchmark clientOptions then return Nothing
  else do
    side <- getsClient sside
    prefix <- getsClient $ ssavePrefixCli . soptions
    let fileName = String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RuleContent -> FactionId -> String
Save.saveNameCli RuleContent
corule FactionId
side
    liftIO $ Save.restoreGame corule clientOptions fileName

-- | Invoke pseudo-random computation with the generator kept in the session.
rndToActionUI :: MonadClientUI m => Rnd a -> m a
rndToActionUI :: forall (m :: * -> *) a. MonadClientUI m => Rnd a -> m a
rndToActionUI Rnd a
r = do
  gen1 <- (SessionUI -> SMGen) -> m SMGen
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> SMGen
srandomUI
  let (a, gen2) = St.runState r gen1
  modifySession $ \SessionUI
sess -> SessionUI
sess {srandomUI = gen2}
  return a

tryOpenBrowser :: MonadClientUI m => String -> m Bool
tryOpenBrowser :: forall (m :: * -> *). MonadClientUI m => String -> m Bool
tryOpenBrowser String
address = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
openBrowser String
address