module Game.LambdaHack.Client.UI.MonadClientUI
(
MonadClientUI( getsSession
, modifySession
, updateClientLeader
, getCacheBfs
, getCachePath
)
, 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
, 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
clientPrintUI :: MonadClientUI m => Text -> m ()
clientPrintUI :: Text -> m ()
clientPrintUI 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
<> Text
"\n"
Handle -> IO ()
hFlush Handle
stdout
debugPossiblyPrintUI :: MonadClientUI m => Text -> m ()
debugPossiblyPrintUI :: Text -> m ()
debugPossiblyPrintUI 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
<> Text
"\n"
Handle -> IO ()
hFlush Handle
stdout
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 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)
connFrontend :: MonadClientUI m => Frontend.FrontReq a -> m a
connFrontend :: FrontReq a -> m a
connFrontend FrontReq a
req = do
Frontend.ChanFrontend 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 Maybe Frame
mf = do
FrontReq ()
frame <- case Maybe Frame
mf of
Maybe Frame
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 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 :: Int
snframes = SessionUI -> Int
snframes SessionUI
cli Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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
displayFrames :: MonadClientUI m => LevelId -> PreFrames3 -> m ()
displayFrames :: LevelId -> PreFrames3 -> m ()
displayFrames LevelId
_ [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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
_ ->
(Maybe PreFrame3 -> Maybe Frame) -> PreFrames3 -> [Maybe Frame]
forall a b. (a -> b) -> [a] -> [b]
map ((PreFrame3 -> Frame) -> Maybe PreFrame3 -> Maybe Frame
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
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
$ \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
connFrontendFrontKey :: MonadClientUI m => [K.KM] -> PreFrame3 -> m K.KM
connFrontendFrontKey :: [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))
Bool
sautoYes <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sautoYes
if Bool
sautoYes Bool -> Bool -> Bool
&& ([KM] -> Bool
forall a. [a] -> Bool
null [KM]
frontKeyKeys Bool -> Bool -> Bool
|| KM
K.spaceKM KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
frontKeyKeys) then do
FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend (FrontReq () -> m ()) -> FrontReq () -> m ()
forall a b. (a -> b) -> a -> b
$ Frame -> FrontReq ()
Frontend.FrontFrame Frame
frontKeyFrame
KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
K.spaceKM
else do
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
$ \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 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 :: Bool
sautoYes = 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
chanFrontend :: MonadClientUI m
=> ScreenContent -> ClientOptions -> m Frontend.ChanFrontend
chanFrontend :: ScreenContent -> ClientOptions -> m ChanFrontend
chanFrontend ScreenContent
coscreen 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
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 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 [] -> [Char] -> KM
forall a. HasCallStack => [Char] -> a
error ([Char] -> KM) -> [Char] -> KM
forall a b. (a -> b) -> a -> b
$ [Char]
"" [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 Bool
insideMenu = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
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
ReqDelay
sreqDelay <- (SessionUI -> ReqDelay) -> m ReqDelay
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ReqDelay
sreqDelay
Text
miniHintAiming <- m Text
forall (m :: * -> *). MonadClientUI m => m Text
getMiniHintAiming
let 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
prefixColors :: [([Char], Color)]
prefixColors = UIOptions -> [([Char], Color)]
uMessageColors UIOptions
sUIOptions
promptAim :: Msg
promptAim = [([Char], Color)] -> MsgClassShow -> Text -> Msg
forall a. MsgShared a => [([Char], Color)] -> a -> Text -> Msg
toMsgShared [([Char], Color)]
prefixColors MsgClassShow
MsgPromptGeneric
(Text
miniHintAiming Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
promptDelay :: Msg
promptDelay = [([Char], Color)] -> MsgClassShow -> Text -> Msg
forall a. MsgShared a => [([Char], Color)] -> a -> Text -> Msg
toMsgShared [([Char], Color)]
prefixColors MsgClassShow
MsgPromptAction
Text
"<press any key to regain control>"
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 -> 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
| ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
== ReqDelay
ReqDelayAlarm Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
insideMenu ->
Msg -> Report -> Report
consReport Msg
promptDelay Report
report
| Bool
otherwise -> Report
report
getMiniHintAiming :: MonadClientUI m => m Text
getMiniHintAiming :: m Text
getMiniHintAiming = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
([(ActorId, Actor)]
inhabitants, [(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 ([], [])
ReqDelay
sreqDelay <- (SessionUI -> ReqDelay) -> m ReqDelay
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ReqDelay
sreqDelay
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
let loreCommandAvailable :: Bool
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
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Text
"Aiming mode:"]
, [Text
"'~' for lore," | Bool
loreCommandAvailable ]
, [Text
"'f' to fling," | ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
/= ReqDelay
ReqDelayHandled]
, [if Bool
loreCommandAvailable Bool -> Bool -> Bool
&& ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
/= ReqDelay
ReqDelayHandled
then Text
"SPACE or RMB to hush,"
else Text
"SPACE or RMB to cycle detail,"]
, [Text
"ESC to cancel."] ]
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
Point
xhairPos <- m Point
forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
let isOurs :: (ActorId, Actor) -> Bool
isOurs (ActorId
_, 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)
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
Maybe Status
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 ActorId
leader -> do
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
Maybe ActorId
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
mxhairToPos :: MonadClientUI m => m (Maybe Point)
mxhairToPos :: m (Maybe Point)
mxhairToPos = 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
(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
$ Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos Maybe ActorId
mleader LevelId
lidV Maybe Target
sxhair
xhairToPos :: MonadClientUI m => m Point
xhairToPos :: m Point
xhairToPos = do
Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Point
fallback <- case Maybe ActorId
mleader of
Maybe ActorId
Nothing -> Point -> m Point
forall (m :: * -> *) a. Monad m => a -> m a
return Point
originPoint
Just ActorId
leader -> (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
Point -> m Point
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> m Point) -> Point -> m Point
forall a b. (a -> b) -> a -> b
$! Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
fallback Maybe Point
mxhairPos
setXHairFromGUI :: MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI :: Maybe Target -> m ()
setXHairFromGUI 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
$ \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
$ \SessionUI
sess -> SessionUI
sess {sxhair :: Maybe Target
sxhair = Maybe Target
xhair2}
clearAimMode :: MonadClientUI m => m ()
clearAimMode :: m ()
clearAimMode = do
LevelId
lidVOld <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Point
xhairPos <- m Point
forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos
(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 {saimMode :: Maybe AimMode
saimMode = Maybe AimMode
forall a. Maybe a
Nothing}
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
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
Maybe Target
sxhairOld <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
let 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
Maybe Target
_ -> 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
Maybe FontSet
Nothing -> [Char] -> FontSet
forall a. HasCallStack => [Char] -> a
error ([Char] -> FontSet) -> [Char] -> FontSet
forall a b. (a -> b) -> a -> b
$ [Char]
"Fontset not defined in config file"
[Char] -> Text -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Text
chosenFontsetID
Just FontSet
fs -> FontSet
fs
multiFont :: Bool
multiFont = ClientOptions -> [Char]
Frontend.frontendName ClientOptions
soptions [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"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
multiFont then FontSetup
multiFontSetup else FontSetup
singleFontSetup
scoreToSlideshow :: MonadClientUI m => Int -> Status -> m Slideshow
scoreToSlideshow :: Int -> Status -> m Slideshow
scoreToSlideshow Int
total 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
theirVic :: (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int)
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 :: 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 (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 :: 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
(Bool
worthMentioning, (ScoreTable
ntable, 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
curChalSer
([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
(FactionKind -> HiCondPoly
fhiCondPoly (FactionKind -> HiCondPoly) -> FactionKind -> HiCondPoly
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact)
FontSetup
fontSetup <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let sli :: Slideshow
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
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 :: 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 Int
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
$ 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
"."
(Set Msg
_, History
nhistory, Bool
_) =
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
$
Text
"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
<> Text
"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 -> 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 -> 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
<> Text
"."
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
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (POSIXTime
sgstartPOSIX POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTime
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
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"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
<> Text
"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 -> 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 -> 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
<> Text
"."
elapsedSessionTimeGT :: MonadClientRead m => POSIXTime -> Int -> m Bool
elapsedSessionTimeGT :: POSIXTime -> Int -> m Bool
elapsedSessionTimeGT POSIXTime
sstartPOSIX Int
stopAfter = do
POSIXTime
current <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
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
$ \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
$ \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 = Int
0
, sallNframes :: Int
sallNframes = SessionUI -> Int
sallNframes SessionUI
sess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nframes }
partActorLeader :: MonadClientUI m => ActorId -> m MU.Part
partActorLeader :: ActorId -> m Part
partActorLeader 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 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) ->
[Part] -> Part
MU.Phrase [Part
"the fallen", ActorUI -> Part
partActor ActorUI
bUI]
Maybe ActorId
_ -> ActorUI -> Part
partActor ActorUI
bUI
partPronounLeader :: MonadClientUI m => ActorId -> m MU.Part
partPronounLeader :: ActorId -> m Part
partPronounLeader 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 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
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
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
rndToActionUI :: MonadClientUI m => Rnd a -> m a
rndToActionUI :: Rnd a -> m a
rndToActionUI 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, 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
$ \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 [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