-- | 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
  , addPressedControlEsc, revCmdMap, getReportUI, computeChosenLore
  , miniHintAimingBare, miniHintAimingLore
  , getLeaderUI, getArenaUI, viewedLevelUI
  , xhairToPos, setXHairFromGUI, clearAimMode
  , getFontSetup, scoreToSlideshow, defaultHistory
  , tellAllClipPS, tellGameClipPS, elapsedSessionTimeGT
  , resetSessionStart, resetGameStart, partActorLeader, partPronounLeader
  , tryRestore, leaderSkillsClientUI, rndToActionUI, tryOpenBrowser
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , connFrontend, displayFrame, addPressedKey
#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.FilePath
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.PointUI
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           Game.LambdaHack.Common.File
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.ModeKind
import           Game.LambdaHack.Content.RuleKind
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability

-- Assumes no interleaving with other clients, because each UI client
-- in a different terminal/window/machine.
clientPrintUI :: MonadClientUI m => Text -> m ()
clientPrintUI :: Text -> m ()
clientPrintUI t :: Text
t = IO () -> m ()
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
<> "\n"  -- hPutStrLn not atomic enough
  Handle -> IO ()
hFlush Handle
stdout

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

-- | The monad that gives the client access to UI operations,
-- but not to modifying client state.
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 :: m SessionUI
getSession = (SessionUI -> SessionUI) -> m SessionUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> SessionUI
forall a. a -> a
id

putSession :: MonadClientUI m => SessionUI -> m ()
putSession :: SessionUI -> m ()
putSession s :: 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 :: FrontReq a -> m a
connFrontend req :: FrontReq a
req = do
  Frontend.ChanFrontend f :: forall a. FrontReq a -> IO a
f <- (SessionUI -> ChanFrontend) -> m ChanFrontend
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChanFrontend
schanF
  IO a -> m a
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ FrontReq a -> IO a
forall a. FrontReq a -> IO a
f FrontReq a
req

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

-- | Push frames or delays to the frame queue. The frames depict
-- the @lid@ level.
displayFrames :: MonadClientUI m => LevelId -> PreFrames3 -> m ()
displayFrames :: LevelId -> PreFrames3 -> m ()
displayFrames lid :: LevelId
lid frs :: PreFrames3
frs = do
  let framesRaw :: [Maybe Frame]
framesRaw = case PreFrames3
frs of
        [] -> []
        [Just ((bfr :: Vector Word32
bfr, ffr :: FrameForall
ffr), (ovProp :: OverlaySpace
ovProp, ovMono :: 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
ovMono))]
        _ ->
          -- Due to the frames coming from the same base frame,
          -- we have to copy it to avoid picture corruption.
          (Maybe ((Vector Word32, FrameForall), (OverlaySpace, OverlaySpace))
 -> Maybe Frame)
-> PreFrames3 -> [Maybe Frame]
forall a b. (a -> b) -> [a] -> [b]
map ((((Vector Word32, FrameForall), (OverlaySpace, OverlaySpace))
 -> Frame)
-> Maybe
     ((Vector Word32, FrameForall), (OverlaySpace, OverlaySpace))
-> Maybe Frame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((((Vector Word32, FrameForall), (OverlaySpace, OverlaySpace))
  -> Frame)
 -> Maybe
      ((Vector Word32, FrameForall), (OverlaySpace, OverlaySpace))
 -> Maybe Frame)
-> (((Vector Word32, FrameForall), (OverlaySpace, OverlaySpace))
    -> Frame)
-> Maybe
     ((Vector Word32, FrameForall), (OverlaySpace, OverlaySpace))
-> Maybe Frame
forall a b. (a -> b) -> a -> b
$ \((bfr :: Vector Word32
bfr, ffr :: FrameForall
ffr), (ovProp :: OverlaySpace
ovProp, ovMono :: 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
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).
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  [Maybe Frame]
frames <- if LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid
            then 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 { sdisplayNeeded :: Bool
sdisplayNeeded = Bool
False
                                            , sturnDisplayed :: Bool
sturnDisplayed = Bool
True }
              [Maybe Frame] -> m [Maybe Frame]
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe Frame]
framesRaw
            else [Maybe Frame] -> m [Maybe Frame]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Frame] -> m [Maybe Frame])
-> [Maybe Frame] -> m [Maybe Frame]
forall a b. (a -> b) -> a -> b
$ [Maybe Frame]
framesRaw [Maybe Frame] -> [Maybe Frame] -> [Maybe Frame]
forall a. [a] -> [a] -> [a]
++ [Maybe Frame
forall a. Maybe a
Nothing, Maybe Frame
forall a. Maybe a
Nothing, Maybe Frame
forall a. Maybe a
Nothing]
  (Maybe Frame -> m ()) -> [Maybe Frame] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ Maybe Frame -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Frame -> m ()
displayFrame [Maybe Frame]
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 :: [KM]
-> ((Vector Word32, FrameForall), (OverlaySpace, OverlaySpace))
-> m KM
connFrontendFrontKey frontKeyKeys :: [KM]
frontKeyKeys ((bfr :: Vector Word32
bfr, ffr :: FrameForall
ffr), (ovProp :: OverlaySpace
ovProp, ovMono :: 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
ovMono))
  KMP
kmp <- FrontReq KMP -> m KMP
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend (FrontReq KMP -> m KMP) -> FrontReq KMP -> m KMP
forall a b. (a -> b) -> a -> b
$ [KM] -> Frame -> FrontReq KMP
Frontend.FrontKey [KM]
frontKeyKeys Frame
frontKeyFrame
  (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 {spointer :: PointUI
spointer = KMP -> PointUI
K.kmpPointer KMP
kmp}
  KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> m KM) -> KM -> m KM
forall a b. (a -> b) -> a -> b
$! KMP -> KM
K.kmpKeyMod KMP
kmp

setFrontAutoYes :: MonadClientUI m => Bool -> m ()
setFrontAutoYes :: Bool -> m ()
setFrontAutoYes b :: Bool
b = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend (FrontReq () -> m ()) -> FrontReq () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FrontReq ()
Frontend.FrontAutoYes Bool
b

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

printScreen :: MonadClientUI m => m ()
printScreen :: 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 :: ScreenContent -> ClientOptions -> m ChanFrontend
chanFrontend coscreen :: ScreenContent
coscreen soptions :: ClientOptions
soptions =
  IO ChanFrontend -> m ChanFrontend
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 :: 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 :: m ()
discardPressedKey = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
Frontend.FrontDiscardKey

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

addPressedKey :: MonadClientUI m => K.KMP -> m ()
addPressedKey :: KMP -> m ()
addPressedKey = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend (FrontReq () -> m ()) -> (KMP -> FrontReq ()) -> KMP -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KMP -> FrontReq ()
Frontend.FrontAdd

addPressedControlEsc :: MonadClientUI m => m ()
addPressedControlEsc :: m ()
addPressedControlEsc = KMP -> m ()
forall (m :: * -> *). MonadClientUI m => KMP -> m ()
addPressedKey $WKMP :: KM -> PointUI -> KMP
K.KMP { kmpKeyMod :: KM
K.kmpKeyMod = KM
K.controlEscKM
                                           , kmpPointer :: PointUI
K.kmpPointer = Int -> Int -> PointUI
PointUI 0 0 }

revCmdMap :: MonadClientUI m => m (HumanCmd.HumanCmd -> K.KM)
revCmdMap :: m (HumanCmd -> KM)
revCmdMap = do
  CCUI{coinput :: CCUI -> InputContent
coinput=InputContent{Map HumanCmd [KM]
brevMap :: InputContent -> Map HumanCmd [KM]
brevMap :: Map HumanCmd [KM]
brevMap}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  let revCmd :: HumanCmd -> KM
revCmd cmd :: 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
        Nothing -> KM
K.undefinedKM
        Just (k :: KM
k : _) -> KM
k
        Just [] -> [Char] -> KM
forall a. HasCallStack => [Char] -> a
error ([Char] -> KM) -> [Char] -> KM
forall a b. (a -> b) -> a -> b
$ "" [Char] -> Map HumanCmd [KM] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Map HumanCmd [KM]
brevMap
  (HumanCmd -> KM) -> m (HumanCmd -> KM)
forall (m :: * -> *) a. Monad m => a -> m a
return HumanCmd -> KM
revCmd

getReportUI :: MonadClientUI m => Bool -> m Report
getReportUI :: Bool -> m Report
getReportUI insideMenu :: Bool
insideMenu = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  (inhabitants :: [(ActorId, Actor)]
inhabitants, embeds :: [(ItemId, ItemQuant)]
embeds) <-
    if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode then m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
forall (m :: * -> *).
MonadClientUI m =>
m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
computeChosenLore else ([(ActorId, Actor)], [(ItemId, ItemQuant)])
-> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
  UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
  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
  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
  let newcomerHelp :: Bool
newcomerHelp = Bool
True  -- TODO
      detailAtDefault :: Bool
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 :: Bool
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
      underAI :: Bool
underAI = Faction -> Bool
isAIFact Faction
fact
      prefixColors :: [([Char], Color)]
prefixColors = UIOptions -> [([Char], Color)]
uMessageColors UIOptions
sUIOptions
      -- Here we assume newbies don't override default keys.
      miniHintAiming :: Text
miniHintAiming = if [(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
                       then Text
miniHintAimingBare
                       else Text
miniHintAimingLore
      promptAim :: Msg
promptAim = [([Char], Color)] -> MsgClassShow -> Text -> Msg
forall a. MsgShared a => [([Char], Color)] -> a -> Text -> Msg
toMsgShared [([Char], Color)]
prefixColors MsgClassShow
MsgPromptGeneric
                  (Text -> Msg) -> Text -> Msg
forall a b. (a -> b) -> a -> b
$ Text
miniHintAiming Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
      promptAI :: Msg
promptAI = [([Char], Color)] -> MsgClassShow -> Text -> Msg
forall a. MsgShared a => [([Char], Color)] -> a -> Text -> Msg
toMsgShared [([Char], Color)]
prefixColors MsgClassShow
MsgPromptAction
                             "<press any key for main menu>"
  Report -> m Report
forall (m :: * -> *) a. Monad m => a -> m a
return (Report -> m Report) -> Report -> m Report
forall a b. (a -> b) -> a -> b
$! if | Bool
newcomerHelp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
insideMenu
                 Bool -> Bool -> Bool
&& Bool
detailAtDefault Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
detailMinimal ->
                   Msg -> Report -> Report
consReport Msg
promptAim Report
report
               | Bool
underAI -> Msg -> Report -> Report
consReport Msg
promptAI Report
report
               | Bool
otherwise -> Report
report

computeChosenLore :: MonadClientUI m
                  => m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
computeChosenLore :: m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
computeChosenLore = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
  ActorId
leader0 <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b0 <- (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
leader0
  let xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe (Actor -> Point
bpos Actor
b0) Maybe Point
mxhairPos
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  let isOurs :: (ActorId, Actor) -> Bool
isOurs (_, b :: Actor
b) = Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
  [(ActorId, Actor)]
inhabitants0 <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ActorId, Actor) -> Bool) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Bool
isOurs)
                  ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
xhairPos LevelId
lidV
  [(ItemId, ItemQuant)]
embeds0 <- (State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)])
-> (State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)])
-> (State -> EnumMap ItemId ItemQuant)
-> State
-> [(ItemId, ItemQuant)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LevelId -> Point -> State -> EnumMap ItemId ItemQuant
getEmbedBag LevelId
lidV Point
xhairPos
  ([(ActorId, Actor)], [(ItemId, ItemQuant)])
-> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ActorId, Actor)]
inhabitants0, [(ItemId, ItemQuant)]
embeds0)

miniHintAimingBare :: Text
miniHintAimingBare :: Text
miniHintAimingBare = "Aiming mode: press 'f' to fling, SPACE or RMB to cycle detail, ESC to cancel."

miniHintAimingLore :: Text
miniHintAimingLore :: Text
miniHintAimingLore = "Aiming mode: '~' for lore, 'f' to fling, SPACE or RMB to hush, ESC to cancel."

getLeaderUI :: MonadClientUI m => m ActorId
getLeaderUI :: m ActorId
getLeaderUI = do
  StateClient
cli <- m StateClient
forall (m :: * -> *). MonadClientRead m => m StateClient
getClient
  case StateClient -> Maybe ActorId
sleader StateClient
cli of
    Nothing -> [Char] -> m ActorId
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ActorId) -> [Char] -> m ActorId
forall a b. (a -> b) -> a -> b
$ "leader expected but not found" [Char] -> StateClient -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` StateClient
cli
    Just leader :: ActorId
leader -> ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
leader

getArenaUI :: MonadClientUI m => m LevelId
getArenaUI :: m LevelId
getArenaUI = do
  let fallback :: m LevelId
fallback = 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
        case Faction -> Maybe Status
gquit Faction
fact of
          Just Status{Int
stDepth :: Status -> Int
stDepth :: Int
stDepth} -> LevelId -> m LevelId
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
          Nothing -> Faction -> m LevelId
forall (m :: * -> *). MonadStateRead m => Faction -> m LevelId
getEntryArena Faction
fact
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  case Maybe ActorId
mleader of
    Just leader :: ActorId
leader -> do
      -- The leader may just be teleporting (e.g., due to displace
      -- over terrain not in FOV) so not existent momentarily.
      Bool
mem <- (State -> Bool) -> m Bool
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 Bool
mem
      then (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid (Actor -> LevelId) -> (State -> Actor) -> State -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
      else m LevelId
fallback
    Nothing -> m LevelId
fallback

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

xhairToPos :: MonadClientUI m => m (Maybe Point)
xhairToPos :: m (Maybe Point)
xhairToPos = do
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  Maybe Target
sxhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
  case Maybe ActorId
mleader of
    Nothing -> Maybe Point -> m (Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing  -- e.g., when game start and no leader yet
    Just aid :: ActorId
aid -> (State -> Maybe Point) -> m (Maybe Point)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos ActorId
aid LevelId
lidV Maybe Target
sxhair
                  -- e.g., xhair on another level

setXHairFromGUI :: MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI :: Maybe Target -> m ()
setXHairFromGUI xhair2 :: Maybe Target
xhair2 = do
  Maybe Target
xhair0 <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
  (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 {sxhairGoTo :: Maybe Target
sxhairGoTo = Maybe Target
forall a. Maybe a
Nothing}
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Target
xhair0 Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
xhair2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> 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
$ \sess :: SessionUI
sess -> SessionUI
sess {sxhair :: Maybe Target
sxhair = Maybe Target
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 :: m ()
clearAimMode = do
  LevelId
lidVOld <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI  -- not in aiming mode at this point
  Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos  -- computed while still in aiming mode
  (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 {saimMode :: Maybe AimMode
saimMode = Maybe AimMode
forall a. Maybe a
Nothing}
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI  -- not in aiming mode at this point
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LevelId
lidVOld LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
lidV) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
    Point
lpos <- (State -> Point) -> m Point
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
    Maybe Target
sxhairOld <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
    let xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
lpos Maybe Point
mxhairPos
        sxhair :: Maybe Target
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
sxhairOld
    Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair

getFontSetup :: MonadClientUI m => m FontSetup
getFontSetup :: m FontSetup
getFontSetup = do
  soptions :: ClientOptions
soptions@ClientOptions{Maybe Text
schosenFontset :: ClientOptions -> Maybe Text
schosenFontset :: Maybe Text
schosenFontset, [(Text, FontSet)]
sfontsets :: ClientOptions -> [(Text, FontSet)]
sfontsets :: [(Text, FontSet)]
sfontsets} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  let chosenFontsetID :: Text
chosenFontsetID = Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
schosenFontset
      chosenFontset :: FontSet
chosenFontset = case Text -> [(Text, FontSet)] -> Maybe FontSet
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
chosenFontsetID [(Text, FontSet)]
sfontsets of
        Nothing -> [Char] -> FontSet
forall a. HasCallStack => [Char] -> a
error ([Char] -> FontSet) -> [Char] -> FontSet
forall a b. (a -> b) -> a -> b
$ "Fontset not defined in config file"
                           [Char] -> Text -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Text
chosenFontsetID
        Just fs :: FontSet
fs -> FontSet
fs
      multiFont :: Bool
multiFont = ClientOptions -> [Char]
Frontend.frontendName ClientOptions
soptions [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "sdl"
                  Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null (FontSet -> Text
fontPropRegular FontSet
chosenFontset))
  FontSetup -> m FontSetup
forall (m :: * -> *) a. Monad m => a -> m a
return (FontSetup -> m FontSetup) -> FontSetup -> m FontSetup
forall a b. (a -> b) -> a -> b
$! if | Bool -> Bool
not Bool
multiFont -> FontSetup
singleFontSetup
               | FontSet -> Text
fontPropRegular FontSet
chosenFontset Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FontSet -> Text
fontMono FontSet
chosenFontset
                 Bool -> Bool -> Bool
&& FontSet -> Text
fontPropBold FontSet
chosenFontset Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FontSet -> Text
fontMono FontSet
chosenFontset ->
                 FontSetup
monoFontSetup
               | Bool
otherwise -> FontSetup
multiFontSetup

scoreToSlideshow :: MonadClientUI m => Int -> Status -> m Slideshow
scoreToSlideshow :: Int -> Status -> m Slideshow
scoreToSlideshow total :: Int
total status :: Status
status = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth, Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  FactionId
fid <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ScoreDict
scoreDict <- (State -> ScoreDict) -> m ScoreDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ScoreDict
shigh
  ContentId ModeKind
gameModeId <- (State -> ContentId ModeKind) -> m (ContentId ModeKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ContentId ModeKind
sgameModeId
  ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
  Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
  Int
dungeonTotal <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Int
sgold
  POSIXTime
date <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  TimeZone
tz <- IO TimeZone -> m TimeZone
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO TimeZone -> m TimeZone) -> IO TimeZone -> m TimeZone
forall a b. (a -> b) -> a -> b
$ UTCTime -> IO TimeZone
getTimeZone (UTCTime -> IO TimeZone) -> UTCTime -> IO TimeZone
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
date
  Challenge
curChalSer <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
scurChal
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  let fact :: Faction
fact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
      table :: ScoreTable
table = ContentId ModeKind -> ScoreDict -> ScoreTable
HighScore.getTable ContentId ModeKind
gameModeId ScoreDict
scoreDict
      gameModeName :: Text
gameModeName = ModeKind -> Text
mname ModeKind
gameMode
      chal :: Challenge
chal | Player -> Bool
fhasUI (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact = Challenge
curChalSer
           | Bool
otherwise = Challenge
curChalSer
                           {cdiff :: Int
cdiff = Int -> Int
difficultyInverse (Challenge -> Int
cdiff Challenge
curChalSer)}
      theirVic :: (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int)
theirVic (fi :: FactionId
fi, fa :: 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 :: EnumMap (ContentId ItemKind) Int
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, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int)
ourVic (fi :: FactionId
fi, fa :: 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 :: EnumMap (ContentId ItemKind) Int
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 :: Bool
worthMentioning, (ntable :: ScoreTable
ntable, pos :: Int
pos)) =
        ScoreTable
-> Int
-> Int
-> Time
-> Status
-> POSIXTime
-> Challenge
-> Text
-> EnumMap (ContentId ItemKind) Int
-> EnumMap (ContentId ItemKind) Int
-> HiCondPoly
-> (Bool, (ScoreTable, Int))
HighScore.register ScoreTable
table Int
total Int
dungeonTotal Time
time Status
status POSIXTime
date Challenge
chal
                           ([Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact)
                           EnumMap (ContentId ItemKind) Int
ourVictims EnumMap (ContentId ItemKind) Int
theirVictims
                           (Player -> HiCondPoly
fhiCondPoly (Player -> HiCondPoly) -> Player -> HiCondPoly
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact)
  FontSetup
fontSetup <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let sli :: Slideshow
sli = FontSetup
-> Int -> Int -> ScoreTable -> Int -> Text -> TimeZone -> Slideshow
highSlideshow FontSetup
fontSetup Int
rwidth (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) ScoreTable
ntable Int
pos
                          Text
gameModeName TimeZone
tz
  Slideshow -> m Slideshow
forall (m :: * -> *) a. Monad m => a -> m a
return (Slideshow -> m Slideshow) -> Slideshow -> m Slideshow
forall a b. (a -> b) -> a -> b
$! if Bool
worthMentioning
            then Slideshow
sli
            else Slideshow
emptySlideshow

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

tellAllClipPS :: MonadClientUI m => m ()
tellAllClipPS :: m ()
tellAllClipPS = do
  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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
bench (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    POSIXTime
sstartPOSIX <- (SessionUI -> POSIXTime) -> m POSIXTime
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> POSIXTime
sstart
    POSIXTime
curPOSIX <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
    Time
allTime <- (SessionUI -> Time) -> m Time
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Time
sallTime
    Time
gtime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
    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
    let time :: Time
time = Time -> Time -> Time
absoluteTimeAdd Time
allTime Time
gtime
        nframes :: Int
nframes = Int
allNframes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gnframes
        diff :: Double
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 :: Double
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 :: Double
fps = Int -> Double
intToDouble Int
nframes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
diff
    Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      "Session time:" Text -> Text -> Text
<+> Double -> Text
forall a. Show a => a -> Text
tshow Double
diff Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "s; frames:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
nframes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
      Text -> Text -> Text
<+> "Average clips per second:" Text -> Text -> Text
<+> Double -> Text
forall a. Show a => a -> Text
tshow Double
cps Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
      Text -> Text -> Text
<+> "Average FPS:" Text -> Text -> Text
<+> Double -> Text
forall a. Show a => a -> Text
tshow Double
fps Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."

tellGameClipPS :: MonadClientUI m => m ()
tellGameClipPS :: m ()
tellGameClipPS = do
  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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
bench (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    POSIXTime
sgstartPOSIX <- (SessionUI -> POSIXTime) -> m POSIXTime
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> POSIXTime
sgstart
    POSIXTime
curPOSIX <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
    -- If loaded game, don't report anything.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (POSIXTime
sgstartPOSIX POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
      Int
nframes <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
snframes
      let diff :: Double
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 :: Double
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 :: Double
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:...".
      Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        "Game time:" Text -> Text -> Text
<+> Double -> Text
forall a. Show a => a -> Text
tshow Double
diff Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "s; frames:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
nframes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
        Text -> Text -> Text
<+> "Average clips per second:" Text -> Text -> Text
<+> Double -> Text
forall a. Show a => a -> Text
tshow Double
cps Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
        Text -> Text -> Text
<+> "Average FPS:" Text -> Text -> Text
<+> Double -> Text
forall a. Show a => a -> Text
tshow Double
fps Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."

elapsedSessionTimeGT :: MonadClientUI m => Int -> m Bool
elapsedSessionTimeGT :: Int -> m Bool
elapsedSessionTimeGT stopAfter :: Int
stopAfter = do
  POSIXTime
current <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  POSIXTime
sstartPOSIX <- (SessionUI -> POSIXTime) -> m POSIXTime
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> POSIXTime
sstart
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! (Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegralWrap :: Int -> NominalDiffTime) Int
stopAfter
            POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
sstartPOSIX
            POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
<= POSIXTime
current

resetSessionStart :: MonadClientUI m => m ()
resetSessionStart :: m ()
resetSessionStart = do
  POSIXTime
sstart <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  (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 {POSIXTime
sstart :: POSIXTime
sstart :: POSIXTime
sstart}
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetGameStart

resetGameStart :: MonadClientUI m => m ()
resetGameStart :: m ()
resetGameStart = do
  POSIXTime
sgstart <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
  Int
nframes <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
snframes
  (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 { POSIXTime
sgstart :: POSIXTime
sgstart :: POSIXTime
sgstart
        , sallTime :: Time
sallTime = Time -> Time -> Time
absoluteTimeAdd (SessionUI -> Time
sallTime SessionUI
sess) Time
time
        , snframes :: Int
snframes = 0
        , sallNframes :: Int
sallNframes = SessionUI -> Int
sallNframes SessionUI
sess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: ActorId -> m Part
partActorLeader aid :: ActorId
aid = do
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
aid
  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
aid
  Part -> m Part
forall (m :: * -> *) a. Monad m => a -> m a
return (Part -> m Part) -> Part -> m Part
forall a b. (a -> b) -> a -> b
$! case Maybe ActorId
mleader of
    Just leader :: ActorId
leader | ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader -> "you"
    _ | Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b) ->  -- avoid "the fallen falling" projectiles
      [Part] -> Part
MU.Phrase ["the fallen", ActorUI -> Part
partActor ActorUI
bUI]
    _ -> 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 :: ActorId -> m Part
partPronounLeader aid :: ActorId
aid = do
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
aid
  Part -> m Part
forall (m :: * -> *) a. Monad m => a -> m a
return (Part -> m Part) -> Part -> m Part
forall a b. (a -> b) -> a -> b
$! case Maybe ActorId
mleader of
    Just leader :: ActorId
leader | ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader -> "you"
    _ -> 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 :: m (Maybe (StateClient, Maybe SessionUI))
tryRestore = do
  COps{RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ClientOptions
clientOptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  if ClientOptions -> Bool
sbenchmark ClientOptions
clientOptions then Maybe (StateClient, Maybe SessionUI)
-> m (Maybe (StateClient, Maybe SessionUI))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (StateClient, Maybe SessionUI)
forall a. Maybe a
Nothing
  else do
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    [Char]
prefix <- (StateClient -> [Char]) -> m [Char]
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> [Char]) -> m [Char])
-> (StateClient -> [Char]) -> m [Char]
forall a b. (a -> b) -> a -> b
$ ClientOptions -> [Char]
ssavePrefixCli (ClientOptions -> [Char])
-> (StateClient -> ClientOptions) -> StateClient -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
    let fileName :: [Char]
fileName = [Char]
prefix [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> RuleContent -> FactionId -> [Char]
Save.saveNameCli RuleContent
corule FactionId
side
    Maybe (StateClient, Maybe SessionUI)
res <- IO (Maybe (StateClient, Maybe SessionUI))
-> m (Maybe (StateClient, Maybe SessionUI))
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO (Maybe (StateClient, Maybe SessionUI))
 -> m (Maybe (StateClient, Maybe SessionUI)))
-> IO (Maybe (StateClient, Maybe SessionUI))
-> m (Maybe (StateClient, Maybe SessionUI))
forall a b. (a -> b) -> a -> b
$ RuleContent
-> ClientOptions
-> [Char]
-> IO (Maybe (StateClient, Maybe SessionUI))
forall a.
Binary a =>
RuleContent -> ClientOptions -> [Char] -> IO (Maybe a)
Save.restoreGame RuleContent
corule ClientOptions
clientOptions [Char]
fileName
    let cfgUIName :: [Char]
cfgUIName = RuleContent -> [Char]
rcfgUIName RuleContent
corule
        (configString :: [Char]
configString, _) = RuleContent -> ([Char], Config)
rcfgUIDefault RuleContent
corule
    [Char]
dataDir <- IO [Char] -> m [Char]
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO [Char]
appDataDir
    IO () -> m ()
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
tryWriteFile ([Char]
dataDir [Char] -> [Char] -> [Char]
</> [Char]
cfgUIName) [Char]
configString
    Maybe (StateClient, Maybe SessionUI)
-> m (Maybe (StateClient, Maybe SessionUI))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (StateClient, Maybe SessionUI)
res

-- For a leader, the skills are both current and max skills.
leaderSkillsClientUI :: MonadClientUI m => m Ability.Skills
{-# INLINE leaderSkillsClientUI #-}
leaderSkillsClientUI :: m Skills
leaderSkillsClientUI = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader

-- | Invoke pseudo-random computation with the generator kept in the session.
rndToActionUI :: MonadClientUI m => Rnd a -> m a
rndToActionUI :: Rnd a -> m a
rndToActionUI r :: Rnd a
r = do
  SMGen
gen1 <- (SessionUI -> SMGen) -> m SMGen
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> SMGen
srandomUI
  let (a :: a
a, gen2 :: SMGen
gen2) = Rnd a -> SMGen -> (a, SMGen)
forall s a. State s a -> s -> (a, s)
St.runState Rnd a
r SMGen
gen1
  (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 {srandomUI :: SMGen
srandomUI = SMGen
gen2}
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

tryOpenBrowser :: MonadClientUI m => String -> m Bool
tryOpenBrowser :: [Char] -> m Bool
tryOpenBrowser address :: [Char]
address = IO Bool -> m Bool
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
$ [Char] -> IO Bool
openBrowser [Char]
address