{-# LANGUAGE FlexibleContexts #-}
-- | The main loop of the client, processing human and computer player
-- moves turn by turn.
module Game.LambdaHack.Client.LoopM
  ( MonadClientReadResponse(..)
  , loopCli
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , initAI, initUI, loopAI, longestDelay, loopUI
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import           Data.Time.Clock
import           Data.Time.Clock.POSIX

import Game.LambdaHack.Atomic
import Game.LambdaHack.Client.HandleAtomicM
import Game.LambdaHack.Client.HandleResponseM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.Response
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.State

-- | Client monad in which one can receive responses from the server.
class MonadClient m => MonadClientReadResponse m where
  receiveResponse :: m Response

initAI :: MonadClient m => m ()
initAI :: forall (m :: * -> *). MonadClient m => m ()
initAI = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  debugPossiblyPrint $ "AI client" <+> tshow side <+> "initializing."

initUI :: (MonadClient m, MonadClientUI m) => CCUI -> m ()
initUI :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
CCUI -> m ()
initUI sccui :: CCUI
sccui@CCUI{ScreenContent
coscreen :: ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen} = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  soptions <- getsClient soptions
  debugPossiblyPrint $ "UI client" <+> tshow side <+> "initializing."
  -- Start the frontend.
  schanF <- chanFrontend coscreen soptions
  modifySession $ \SessionUI
sess -> SessionUI
sess {schanF, sccui}

-- | The main game loop for an AI or UI client. It receives responses from
-- the server, changes internal client state accordingly, analyzes
-- ensuing human or AI commands and sends resulting requests to the server.
-- Depending on whether it's an AI or UI client, it sends AI or human player
-- requests.
--
-- The loop is started in client state that is empty except for
-- the @sside@ and @seps@ fields, see 'emptyStateClient'.
loopCli :: ( MonadClientSetup m
           , MonadClientUI m
           , MonadClientAtomic m
           , MonadClientReadResponse m
           , MonadClientWriteRequest m )
        => CCUI -> UIOptions -> ClientOptions -> Bool -> m ()
loopCli :: forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
CCUI -> UIOptions -> ClientOptions -> Bool -> m ()
loopCli CCUI
ccui UIOptions
sUIOptions ClientOptions
clientOptions Bool
startsNewGame = do
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {soptions = clientOptions}
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  hasUI <- clientHasUI
  if not hasUI then initAI else initUI ccui
  let cliendKindText = if Bool -> Bool
not Bool
hasUI then Text
"AI" else Text
"UI"
  debugPossiblyPrint $ cliendKindText <+> "client"
                       <+> tshow side <+> "starting 1/4."
  -- Warning: state and client state are invalid here, e.g., sdungeon
  -- and sper are empty.
  restored <-
    if startsNewGame && not hasUI
    then return False
    else do
      restoredG <- tryRestore
      case restoredG of
        Just (StateClient
cli, Maybe SessionUI
msess)-> do
          -- Restore game.
          case Maybe SessionUI
msess of
            Just SessionUI
sess | Bool
hasUI -> do
              -- Preserve almost everything from the saved session.
              -- Renew the communication channel to the newly spawned frontend
              -- and get the possibly updated UI content and UI options.
              schanF <- (SessionUI -> ChanFrontend) -> m ChanFrontend
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChanFrontend
schanF
              sccui <- getsSession sccui
              putSession $ sess {schanF, sccui, sUIOptions}
            Maybe SessionUI
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          if Bool
startsNewGame then
            -- Don't restore client state, due to new game starting right now,
            -- which means everything will be overwritten soon anyway
            -- via an @UpdRestart@ command (instead of @UpdResume@).
            Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          else do
            -- We preserve the client state from savefile except for the single
            -- option that can be overwritten on commandline.
            let noAnim :: Bool
noAnim = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Maybe Bool
snoAnim (ClientOptions -> Maybe Bool) -> ClientOptions -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ StateClient -> ClientOptions
soptions StateClient
cli
            StateClient -> m ()
forall (m :: * -> *). MonadClient m => StateClient -> m ()
putClient StateClient
cli {soptions = clientOptions {snoAnim = Just noAnim}}
            Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Maybe (StateClient, Maybe SessionUI)
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  debugPossiblyPrint $ cliendKindText <+> "client"
                       <+> tshow side <+> "starting 2/4."
  -- At this point @ClientState@ not overriten dumbly and @State@ valid.
  tabA <- createTabBFS
  tabB <- createTabBFS
  modifyClient $ \StateClient
cli -> StateClient
cli {stabs = (tabA, tabB)}
  cmd1 <- receiveResponse
  debugPossiblyPrint $ cliendKindText <+> "client"
                       <+> tshow side <+> "starting 3/4."
  case (restored, startsNewGame, cmd1) of
    (Bool
True, Bool
False, RespUpdAtomic State
_ UpdResume{}) ->
      () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Bool
True, Bool
True, RespUpdAtomic State
_ UpdRestart{}) ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasUI (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
"Ignoring an old savefile and starting a new game."
    (Bool
False, Bool
False, RespUpdAtomic State
_ UpdResume{}) ->
      String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Savefile of client " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FactionId -> String
forall a. Show a => a -> String
show FactionId
side String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not usable."
              String -> () -> String
forall v. Show v => String -> v -> String
`showFailure` ()
    (Bool
False, Bool
True, RespUpdAtomic State
_ UpdRestart{}) ->
      () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Bool
True, Bool
False, RespUpdAtomicNoState UpdResume{}) ->
      m ()
forall a. HasCallStack => a
undefined
    (Bool
True, Bool
True, RespUpdAtomicNoState UpdRestart{}) ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasUI (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
"Ignoring an old savefile and starting a new game."
    (Bool
False, Bool
False, RespUpdAtomicNoState UpdResume{}) ->
      String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Savefile of client " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FactionId -> String
forall a. Show a => a -> String
show FactionId
side String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not usable."
              String -> () -> String
forall v. Show v => String -> v -> String
`showFailure` ()
    (Bool
False, Bool
True, RespUpdAtomicNoState UpdRestart{}) ->
      () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Bool, Bool, Response)
_ -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"unexpected command" String -> (FactionId, Bool, Response) -> String
forall v. Show v => String -> v -> String
`showFailure` (FactionId
side, Bool
restored, Response
cmd1)
  handleResponse cmd1
  -- State and client state now valid.
  debugPossiblyPrint $ cliendKindText <+> "client"
                       <+> tshow side <+> "starting 4/4."
  if hasUI
  then loopUI 0
  else loopAI
  side2 <- getsClient sside
  debugPossiblyPrint $ cliendKindText <+> "client" <+> tshow side2
                       <+> "(initially" <+> tshow side <> ") stopped."

loopAI :: ( MonadClientSetup m
          , MonadClientUI m
          , MonadClientAtomic m
          , MonadClientReadResponse m
          , MonadClientWriteRequest m )
       => m ()
loopAI :: forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
m ()
loopAI = do
  cmd <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
  handleResponse cmd
  quit <- getsClient squit
  unless quit
    loopAI

-- | Alarm after this many seconds without server querying us for a command.
longestDelay :: POSIXTime
longestDelay :: POSIXTime
longestDelay = Pico -> POSIXTime
secondsToNominalDiffTime Pico
1
                 -- really high to accomodate slow browsers

-- | The argument is the time of last UI query from the server.
-- After @longestDelay@ seconds past this date, the client considers itself
-- ignored and displays a warning and, at a keypress, gives
-- direct control to the player, no longer waiting for the server
-- to prompt it to do so.
loopUI :: ( MonadClientSetup m
          , MonadClientUI m
          , MonadClientAtomic m
          , MonadClientReadResponse m
          , MonadClientWriteRequest m )
       => POSIXTime -> m ()
loopUI :: forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
timeSinceLastQuery = do
  sreqPending <- (SessionUI -> Maybe RequestUI) -> m (Maybe RequestUI)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RequestUI
sreqPending
  sreqDelay <- getsSession sreqDelay
  sregainControl <- getsSession sregainControl
  keyPressed <- anyKeyPressed
  let alarm = POSIXTime
timeSinceLastQuery POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
longestDelay
  if | not alarm  -- no alarm starting right now
       && -- no need to mark AI for control regain ASAP:
          (sreqDelay == ReqDelayNot  -- no old alarm still in effect
           || sregainControl  -- AI control already marked for regain
           || (not keyPressed  -- player does not insist by keypress
               && sreqDelay /= ReqDelayHandled)) -> do  -- or by hack
       timeBefore <- liftIO getPOSIXTime
       cmd <- receiveResponse
       timeAfter <- liftIO getPOSIXTime
       handleResponse cmd
       -- @squit@ can be changed only in @handleResponse@, so this is the only
       -- place where it needs to be checked.
       quit <- getsClient squit
       unless quit $ case cmd of
         Response
RespQueryUI -> POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0
         Response
RespQueryUIunderAI ->
           POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI (POSIXTime -> m ()) -> POSIXTime -> m ()
forall a b. (a -> b) -> a -> b
$ POSIXTime -> POSIXTime
forall a. Enum a => a -> a
succ POSIXTime
longestDelay  -- permit fast AI control regain
         Response
_ -> do
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe RequestUI -> Bool
forall a. Maybe a -> Bool
isJust Maybe RequestUI
sreqPending) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
             MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert Text
"Warning: server updated game state after current command was issued by the client but before it was received by the server."
           -- This measures only the server's delay.
           POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI (POSIXTime -> m ()) -> POSIXTime -> m ()
forall a b. (a -> b) -> a -> b
$ POSIXTime
timeSinceLastQuery POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
timeBefore POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
timeAfter
     | not sregainControl && (keyPressed
                              || sreqDelay == ReqDelayHandled
                              || isJust sreqPending) -> do
         -- ignore alarm if to be handled by AI control regain code elsewhere
       -- Checking for special case for UI under AI control, because the default
       -- behaviour is in this case too alarming for the player, especially
       -- during the insert coin demo before game is started.
       side <- getsClient sside
       fact <- getsState $ (EM.! side) . sfactionD
       if gunderAI fact then
         -- Mark for immediate control regain from AI.
         modifySession $ \SessionUI
sess -> SessionUI
sess {sregainControl = True}
       else do  -- should work fine even if UI faction has no leader ATM
         -- The keys mashed to make UI accessible are not considered a command.
         resetPressedKeys
         -- Stop displaying the prompt, if any, but keep UI simple.
         modifySession $ \SessionUI
sess -> SessionUI
sess {sreqDelay = ReqDelayHandled}
         let msg = if Maybe RequestUI -> Bool
forall a. Maybe a -> Bool
isNothing Maybe RequestUI
sreqPending
                   then Text
"Server delayed asking us for a command. Regardless, UI is made accessible. Press ESC twice to listen to server some more."
                   else Text
"Server delayed receiving a command from us. The command is cancelled. Issue a new one."
         msgAdd MsgActionAlert msg
         mreqNew <- queryUI
         msgAdd MsgPromptGeneric "Your client is listening to the server again."
         pushReportFrame
         -- TODO: once this is really used, verify that if a request
         -- overwritten, nothing breaks due to some things in our ClientState
         -- and SessionUI (but fortunately not in State nor ServerState)
         -- already set as if it was performed.
         modifySession $ \SessionUI
sess -> SessionUI
sess {sreqPending = mreqNew}
         -- Now relax completely.
         modifySession $ \SessionUI
sess -> SessionUI
sess {sreqDelay = ReqDelayNot}
       -- We may yet not know if server is ready, but perhaps server
       -- tried hard to contact us while we took control and now it sleeps
       -- for a bit, so let's give it the benefit of the doubt
       -- and a slight pause before we alarm the player again.
       loopUI 0
     | otherwise -> do
       -- We know server is not ready.
       modifySession $ \SessionUI
sess -> SessionUI
sess {sreqDelay = ReqDelayAlarm}
       -- We take a slight pause during which we display encouragement
       -- to press a key and we receive game state changes.
       -- The pause is cut short by any keypress, so it does not
       -- make UI reaction any less snappy (animations do, but that's fine).
       loopUI 0