module Game.LambdaHack.Client.UI.MonadClientUI
(
MonadClientUI( getsSession
, modifySession
, updateClientLeader
, getCacheBfs
, getCachePath
)
, clientPrintUI, mapStartY, getSession, putSession, displayFrames
, connFrontendFrontKey, setFrontAutoYes, frontendShutdown, printScreen
, chanFrontend, anyKeyPressed, discardPressedKey, resetPressedKeys
, addPressedControlEsc, revCmdMap
, getReportUI, getLeaderUI, getArenaUI, viewedLevelUI
, leaderTgtToPos, xhairToPos, clearAimMode, scoreToSlideshow, defaultHistory
, tellAllClipPS, tellGameClipPS, elapsedSessionTimeGT
, resetSessionStart, resetGameStart
, partActorLeader, partActorLeaderFun, partPronounLeader
, tryRestore, leaderSkillsClientUI
#ifdef EXPOSE_INTERNAL
, connFrontend, displayFrame, addPressedKey
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.Map.Strict as M
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 Game.LambdaHack.Client.Bfs
import Game.LambdaHack.Client.ClientOptions
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.Frame
import Game.LambdaHack.Client.UI.Frontend
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.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.Faction
import Game.LambdaHack.Common.File
import qualified Game.LambdaHack.Common.HighScore as HighScore
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 qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
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.hPutStrLn Handle
stdout Text
t
Handle -> IO ()
hFlush Handle
stdout
mapStartY :: Y
mapStartY :: Y
mapStartY = 1
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)
connFrontend :: MonadClientUI m => FrontReq a -> m a
connFrontend :: FrontReq a -> m a
connFrontend req :: FrontReq a
req = do
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
$! Y -> FrontReq ()
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 :: Y
snframes = SessionUI -> Y
snframes SessionUI
cli Y -> Y -> Y
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 ()
FrontFrame Frame
fr
FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
frame
displayFrames :: MonadClientUI m => LevelId -> PreFrames -> m ()
displayFrames :: LevelId -> PreFrames -> m ()
displayFrames lid :: LevelId
lid frs :: PreFrames
frs = do
let frames :: [Maybe Frame]
frames = case PreFrames
frs of
[] -> []
[Just (bfr :: Vector Word32
bfr, ffr :: FrameForall
ffr)] -> [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)]
_ ->
(Maybe (Vector Word32, FrameForall) -> Maybe Frame)
-> PreFrames -> [Maybe Frame]
forall a b. (a -> b) -> [a] -> [b]
map (((Vector Word32, FrameForall) -> Frame)
-> Maybe (Vector Word32, FrameForall) -> Maybe Frame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Vector Word32, FrameForall) -> Frame)
-> Maybe (Vector Word32, FrameForall) -> Maybe Frame)
-> ((Vector Word32, FrameForall) -> Frame)
-> Maybe (Vector Word32, FrameForall)
-> Maybe Frame
forall a b. (a -> b) -> a -> b
$ \(bfr :: Vector Word32
bfr, ffr :: FrameForall
ffr) -> ((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)) PreFrames
frs
(Maybe Frame -> m ()) -> [Maybe Frame] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Maybe Frame -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Frame -> m ()
displayFrame [Maybe Frame]
frames
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid) (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 {sdisplayNeeded :: Bool
sdisplayNeeded = Bool
False}
connFrontendFrontKey :: MonadClientUI m => [K.KM] -> PreFrame -> m K.KM
connFrontendFrontKey :: [KM] -> (Vector Word32, FrameForall) -> m KM
connFrontendFrontKey frontKeyKeys :: [KM]
frontKeyKeys (bfr :: Vector Word32
bfr, ffr :: FrameForall
ffr) = 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)
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
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 :: Point
spointer = KMP -> Point
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 ()
FrontAutoYes Bool
b
frontendShutdown :: MonadClientUI m => m ()
frontendShutdown :: m ()
frontendShutdown = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
FrontShutdown
printScreen :: MonadClientUI m => m ()
printScreen :: m ()
printScreen = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
FrontPrintScreen
chanFrontend :: MonadClientUI m
=> ScreenContent -> ClientOptions -> m 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
FrontPressed
discardPressedKey :: MonadClientUI m => m ()
discardPressedKey :: m ()
discardPressedKey = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
FrontDiscardKey
resetPressedKeys :: MonadClientUI m => m ()
resetPressedKeys :: m ()
resetPressedKeys = FrontReq () -> m ()
forall (m :: * -> *) a. MonadClientUI m => FrontReq a -> m a
connFrontend FrontReq ()
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 ()
FrontAdd
addPressedControlEsc :: MonadClientUI m => m ()
addPressedControlEsc :: m ()
addPressedControlEsc = KMP -> m ()
forall (m :: * -> *). MonadClientUI m => KMP -> m ()
addPressedKey $WKMP :: KM -> Point -> KMP
K.KMP { kmpKeyMod :: KM
K.kmpKeyMod = KM
K.controlEscKM
, kmpPointer :: Point
K.kmpPointer = Point
originPoint }
revCmdMap :: MonadClientUI m => m (K.KM -> HumanCmd.HumanCmd -> K.KM)
revCmdMap :: m (KM -> 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 :: KM -> HumanCmd -> KM
revCmd dflt :: KM
dflt 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
dflt
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
(KM -> HumanCmd -> KM) -> m (KM -> HumanCmd -> KM)
forall (m :: * -> *) a. Monad m => a -> m a
return KM -> HumanCmd -> KM
revCmd
getReportUI :: MonadClientUI m => m Report
getReportUI :: m Report
getReportUI = do
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
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
let underAI :: Bool
underAI = Faction -> Bool
isAIFact Faction
fact
mem :: Maybe (EnumMap MsgClass Color)
mem = [(MsgClass, Color)] -> EnumMap MsgClass Color
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(MsgClass, Color)] -> EnumMap MsgClass Color)
-> Maybe [(MsgClass, Color)] -> Maybe (EnumMap MsgClass Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIOptions -> Maybe [(MsgClass, Color)]
uMessageColors UIOptions
sUIOptions
promptAI :: Msg
promptAI = Maybe (EnumMap MsgClass Color) -> MsgClass -> Text -> Msg
toMsg Maybe (EnumMap MsgClass Color)
mem MsgClass
MsgPrompt "[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
underAI then Msg -> Report -> Report
consReport Msg
promptAI Report
report else Report
report
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{Y
stDepth :: Status -> Y
stDepth :: Y
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
$! Y -> LevelId
forall a. Enum a => Y -> a
toEnum Y
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
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
leaderTgtToPos :: MonadClientUI m => m (Maybe Point)
leaderTgtToPos :: m (Maybe Point)
leaderTgtToPos = 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
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
Just aid :: ActorId
aid -> do
Maybe Target
mtgt <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget 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
mtgt
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
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
clearAimMode :: MonadClientUI m => m ()
clearAimMode :: m ()
clearAimMode = do
LevelId
lidVOld <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe 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
$ \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
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
_ -> Maybe Target
sxhairOld
(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 {Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair}
scoreToSlideshow :: MonadClientUI m => Int -> Status -> m Slideshow
scoreToSlideshow :: Y -> Status -> m Slideshow
scoreToSlideshow total :: Y
total status :: Status
status = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Y
rwidth :: ScreenContent -> Y
rwidth :: Y
rwidth, Y
rheight :: ScreenContent -> Y
rheight :: Y
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
Y
dungeonTotal <- (State -> Y) -> m Y
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Y
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 :: Y
cdiff = Y -> Y
difficultyInverse (Challenge -> Y
cdiff Challenge
curChalSer)}
theirVic :: (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Y)
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) Y
-> Maybe (EnumMap (ContentId ItemKind) Y)
forall a. a -> Maybe a
Just (EnumMap (ContentId ItemKind) Y
-> Maybe (EnumMap (ContentId ItemKind) Y))
-> EnumMap (ContentId ItemKind) Y
-> Maybe (EnumMap (ContentId ItemKind) Y)
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Y
gvictims Faction
fa
| Bool
otherwise = Maybe (EnumMap (ContentId ItemKind) Y)
forall a. Maybe a
Nothing
theirVictims :: EnumMap (ContentId ItemKind) Y
theirVictims = (Y -> Y -> Y)
-> [EnumMap (ContentId ItemKind) Y]
-> EnumMap (ContentId ItemKind) Y
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Y -> Y -> Y
forall a. Num a => a -> a -> a
(+) ([EnumMap (ContentId ItemKind) Y]
-> EnumMap (ContentId ItemKind) Y)
-> [EnumMap (ContentId ItemKind) Y]
-> EnumMap (ContentId ItemKind) Y
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Y))
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Y]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Y)
theirVic ([(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Y])
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Y]
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) Y)
ourVic (fi :: FactionId
fi, fa :: Faction
fa) | FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fid Faction
fact FactionId
fi = EnumMap (ContentId ItemKind) Y
-> Maybe (EnumMap (ContentId ItemKind) Y)
forall a. a -> Maybe a
Just (EnumMap (ContentId ItemKind) Y
-> Maybe (EnumMap (ContentId ItemKind) Y))
-> EnumMap (ContentId ItemKind) Y
-> Maybe (EnumMap (ContentId ItemKind) Y)
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Y
gvictims Faction
fa
| Bool
otherwise = Maybe (EnumMap (ContentId ItemKind) Y)
forall a. Maybe a
Nothing
ourVictims :: EnumMap (ContentId ItemKind) Y
ourVictims = (Y -> Y -> Y)
-> [EnumMap (ContentId ItemKind) Y]
-> EnumMap (ContentId ItemKind) Y
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Y -> Y -> Y
forall a. Num a => a -> a -> a
(+) ([EnumMap (ContentId ItemKind) Y]
-> EnumMap (ContentId ItemKind) Y)
-> [EnumMap (ContentId ItemKind) Y]
-> EnumMap (ContentId ItemKind) Y
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Y))
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Y]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Y)
ourVic ([(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Y])
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Y]
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 :: Y
pos)) =
ScoreTable
-> Y
-> Y
-> Time
-> Status
-> POSIXTime
-> Challenge
-> Text
-> EnumMap (ContentId ItemKind) Y
-> EnumMap (ContentId ItemKind) Y
-> HiCondPoly
-> (Bool, (ScoreTable, Y))
HighScore.register ScoreTable
table Y
total Y
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) Y
ourVictims EnumMap (ContentId ItemKind) Y
theirVictims
(Player -> HiCondPoly
fhiCondPoly (Player -> HiCondPoly) -> Player -> HiCondPoly
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact)
sli :: Slideshow
sli = Y -> Y -> ScoreTable -> Y -> Text -> TimeZone -> Slideshow
highSlideshow Y
rwidth (Y
rheight Y -> Y -> Y
forall a. Num a => a -> a -> a
- 1) ScoreTable
ntable Y
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
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
$ Y -> [Char] -> [Char]
forall a. Y -> [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 = Y -> History
emptyHistory (Y -> History) -> Y -> History
forall a b. (a -> b) -> a -> b
$ UIOptions -> Y
uHistoryMax UIOptions
sUIOptions
mem :: Maybe (EnumMap MsgClass Color)
mem = [(MsgClass, Color)] -> EnumMap MsgClass Color
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(MsgClass, Color)] -> EnumMap MsgClass Color)
-> Maybe [(MsgClass, Color)] -> Maybe (EnumMap MsgClass Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIOptions -> Maybe [(MsgClass, Color)]
uMessageColors UIOptions
sUIOptions
msg :: Msg
msg = Maybe (EnumMap MsgClass Color) -> MsgClass -> Text -> Msg
toMsg Maybe (EnumMap MsgClass Color)
mem MsgClass
MsgAdmin
(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
<> "."
History -> IO History
forall (m :: * -> *) a. Monad m => a -> m a
return (History -> IO History) -> History -> IO History
forall a b. (a -> b) -> a -> b
$! (History, Bool) -> History
forall a b. (a, b) -> a
fst ((History, Bool) -> History) -> (History, Bool) -> History
forall a b. (a -> b) -> a -> b
$ History -> Msg -> Y -> Time -> (History, Bool)
addToReport History
emptyHist Msg
msg 0 Time
timeZero
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
Y
allNframes <- (SessionUI -> Y) -> m Y
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Y
sallNframes
Y
gnframes <- (SessionUI -> Y) -> m Y
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Y
snframes
let time :: Time
time = Time -> Time -> Time
absoluteTimeAdd Time
allTime Time
gtime
nframes :: Y
nframes = Y
allNframes Y -> Y -> Y
forall a. Num a => a -> a -> a
+ Y
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 = Y -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Time -> Time -> Y
timeFit Time
time Time
timeClip) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
diff :: Double
fps :: Double
fps = Y -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Y
nframes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
diff :: Double
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
<+> Y -> Text
forall a. Show a => a -> Text
tshow Y
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
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
Y
nframes <- (SessionUI -> Y) -> m Y
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Y
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 = Y -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Time -> Time -> Y
timeFit Time
time Time
timeClip) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
diff :: Double
fps :: Double
fps = Y -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Y
nframes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
diff :: Double
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
<+> Y -> Text
forall a. Show a => a -> Text
tshow Y
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 :: Y -> m Bool
elapsedSessionTimeGT stopAfter :: Y
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
$! Y -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Y
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
Y
nframes <- (SessionUI -> Y) -> m Y
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Y
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
$ \cli :: SessionUI
cli ->
SessionUI
cli { POSIXTime
sgstart :: POSIXTime
sgstart :: POSIXTime
sgstart
, sallTime :: Time
sallTime = Time -> Time -> Time
absoluteTimeAdd (SessionUI -> Time
sallTime SessionUI
cli) Time
time
, snframes :: Y
snframes = 0
, sallNframes :: Y
sallNframes = SessionUI -> Y
sallNframes SessionUI
cli Y -> Y -> Y
forall a. Num a => a -> a -> a
+ Y
nframes }
partActorLeaderCommon :: Maybe ActorId -> ActorUI -> Actor -> ActorId -> MU.Part
partActorLeaderCommon :: Maybe ActorId -> ActorUI -> Actor -> ActorId -> Part
partActorLeaderCommon mleader :: Maybe ActorId
mleader bUI :: ActorUI
bUI b :: Actor
b aid :: ActorId
aid = 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 -> [Part] -> Part
MU.Phrase ["the fallen", ActorUI -> Part
partActor ActorUI
bUI]
_ -> ActorUI -> Part
partActor ActorUI
bUI
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
$! Maybe ActorId -> ActorUI -> Actor -> ActorId -> Part
partActorLeaderCommon Maybe ActorId
mleader ActorUI
bUI Actor
b ActorId
aid
partActorLeaderFun :: MonadClientUI m => m (ActorId -> MU.Part)
partActorLeaderFun :: m (ActorId -> Part)
partActorLeaderFun = do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
SessionUI
sess <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
(ActorId -> Part) -> m (ActorId -> Part)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ActorId -> Part) -> m (ActorId -> Part))
-> (ActorId -> Part) -> m (ActorId -> Part)
forall a b. (a -> b) -> a -> b
$! \aid :: ActorId
aid ->
Maybe ActorId -> ActorUI -> Actor -> ActorId -> Part
partActorLeaderCommon Maybe ActorId
mleader (ActorId -> SessionUI -> ActorUI
getActorUI ActorId
aid SessionUI
sess) (ActorId -> State -> Actor
getActorBody ActorId
aid State
s) ActorId
aid
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
tryRestore :: MonadClientUI m => m (Maybe (StateClient, Maybe SessionUI))
tryRestore :: m (Maybe (StateClient, Maybe SessionUI))
tryRestore = do
cops :: COps
cops@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
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
if Bool
bench 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
<> COps -> FactionId -> [Char]
Save.saveNameCli COps
cops 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
$ COps -> [Char] -> IO (Maybe (StateClient, Maybe SessionUI))
forall a. Binary a => COps -> [Char] -> IO (Maybe a)
Save.restoreGame COps
cops [Char]
fileName
let cfgUIName :: [Char]
cfgUIName = RuleContent -> [Char]
rcfgUIName RuleContent
corule
content :: [Char]
content = RuleContent -> [Char]
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]
content
Maybe (StateClient, Maybe SessionUI)
-> m (Maybe (StateClient, Maybe SessionUI))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (StateClient, Maybe SessionUI)
res
leaderSkillsClientUI :: MonadClientUI m => m Ability.Skills
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