{-# 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
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

-- | 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 :: m ()
initAI = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "AI client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "initializing."

initUI :: (MonadClient m, MonadClientUI m) => CCUI -> m ()
initUI :: CCUI -> m ()
initUI sccui :: CCUI
sccui@CCUI{ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen :: ScreenContent
coscreen} = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "UI client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "initializing."
  -- Start the frontend.
  ChanFrontend
schanF <- ScreenContent -> ClientOptions -> m ChanFrontend
forall (m :: * -> *).
MonadClientUI m =>
ScreenContent -> ClientOptions -> m ChanFrontend
chanFrontend ScreenContent
coscreen ClientOptions
soptions
  (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 {ChanFrontend
schanF :: ChanFrontend
schanF :: ChanFrontend
schanF, CCUI
sccui :: CCUI
sccui :: CCUI
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 -> m ()
loopCli :: CCUI -> UIOptions -> ClientOptions -> m ()
loopCli ccui :: CCUI
ccui sUIOptions :: UIOptions
sUIOptions clientOptions :: ClientOptions
clientOptions = 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
$ \cli :: StateClient
cli -> StateClient
cli {soptions :: ClientOptions
soptions = ClientOptions
clientOptions}
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Bool
hasUI <- m Bool
forall (m :: * -> *). MonadClientWriteRequest m => m Bool
clientHasUI
  if Bool -> Bool
not Bool
hasUI then m ()
forall (m :: * -> *). MonadClient m => m ()
initAI else CCUI -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
CCUI -> m ()
initUI CCUI
ccui
  let cliendKindText :: Text
cliendKindText = if Bool -> Bool
not Bool
hasUI then "AI" else "UI"
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> "client"
                       Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "started 1/4."
  -- Warning: state and client state are invalid here, e.g., sdungeon
  -- and sper are empty.
  Maybe (StateClient, Maybe SessionUI)
restoredG <- m (Maybe (StateClient, Maybe SessionUI))
forall (m :: * -> *).
MonadClientUI m =>
m (Maybe (StateClient, Maybe SessionUI))
tryRestore
  Bool
restored <- case Maybe (StateClient, Maybe SessionUI)
restoredG of
    Just (cli :: StateClient
cli, msess :: Maybe SessionUI
msess) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
snewGameCli ClientOptions
clientOptions -> do
      -- Restore game.
      ChanFrontend
schanF <- (SessionUI -> ChanFrontend) -> m ChanFrontend
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChanFrontend
schanF
      CCUI
sccui <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
      m () -> (SessionUI -> m ()) -> Maybe SessionUI -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\sess :: SessionUI
sess -> (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 -> SessionUI -> SessionUI
forall a b. a -> b -> a
const
        SessionUI
sess {ChanFrontend
schanF :: ChanFrontend
schanF :: ChanFrontend
schanF, CCUI
sccui :: CCUI
sccui :: CCUI
sccui, UIOptions
sUIOptions :: UIOptions
sUIOptions :: UIOptions
sUIOptions}) Maybe SessionUI
msess
      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
soptions = ClientOptions
clientOptions {snoAnim :: Maybe Bool
snoAnim = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
noAnim}}
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just (_, msessR :: Maybe SessionUI
msessR) -> do
      -- Preserve previous history, if any.
      m () -> (SessionUI -> m ()) -> Maybe SessionUI -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\sessR :: SessionUI
sessR -> (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 {shistory :: History
shistory = SessionUI -> History
shistory SessionUI
sessR}) Maybe SessionUI
msessR
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    _ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> "client"
                       Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "started 2/4."
  -- At this point @ClientState@ not overriten dumbly and @State@ valid.
  PrimArray PointI
tabA <- m (PrimArray PointI)
forall (m :: * -> *). MonadClient m => m (PrimArray PointI)
createTabBFS
  PrimArray PointI
tabB <- m (PrimArray PointI)
forall (m :: * -> *). MonadClient m => m (PrimArray PointI)
createTabBFS
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {stabs :: (PrimArray PointI, PrimArray PointI)
stabs = (PrimArray PointI
tabA, PrimArray PointI
tabB)}
  Response
cmd1 <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> "client"
                       Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "started 3/4."
  case (Bool
restored, Response
cmd1) of
    (True, RespUpdAtomic _ UpdResume{}) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (True, RespUpdAtomic _ 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 "Ignoring an old savefile and starting a new game."
    (False, RespUpdAtomic _ UpdResume{}) ->
      [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "Savefile of client " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FactionId -> [Char]
forall a. Show a => a -> [Char]
show FactionId
side [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " not usable."
              [Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
    (False, RespUpdAtomic _ UpdRestart{}) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (True, RespUpdAtomicNoState UpdResume{}) -> m ()
forall a. HasCallStack => a
undefined
    (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 "Ignoring an old savefile and starting a new game."
    (False, RespUpdAtomicNoState UpdResume{}) ->
      [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "Savefile of client " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FactionId -> [Char]
forall a. Show a => a -> [Char]
show FactionId
side [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " not usable."
              [Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
    (False, RespUpdAtomicNoState UpdRestart{}) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    _ -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "unexpected command" [Char] -> (FactionId, Bool, Response) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (FactionId
side, Bool
restored, Response
cmd1)
  Response -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientWriteRequest m) =>
Response -> m ()
handleResponse Response
cmd1
  -- State and client state now valid.
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> "client"
                       Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "started 4/4."
  m ()
loop
  FactionId
side2 <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> "client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side2
                       Text -> Text -> Text
<+> "(initially" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ") stopped."
 where
  loop :: m ()
loop = do
    Response
cmd <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
    Response -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientWriteRequest m) =>
Response -> m ()
handleResponse Response
cmd
    Bool
quit <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Bool
squit
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quit m ()
loop