File: LoopM.hs

package info (click to toggle)
haskell-lambdahack 0.11.0.1-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 4,056 kB
  • sloc: haskell: 45,636; makefile: 219
file content (246 lines) | stat: -rw-r--r-- 10,787 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
{-# 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 = do
  side <- getsClient sside
  debugPossiblyPrint $ "AI client" <+> tshow side <+> "initializing."

initUI :: (MonadClient m, MonadClientUI m) => CCUI -> m ()
initUI sccui@CCUI{coscreen} = do
  side <- getsClient sside
  soptions <- getsClient soptions
  debugPossiblyPrint $ "UI client" <+> tshow side <+> "initializing."
  -- Start the frontend.
  schanF <- chanFrontend coscreen soptions
  modifySession $ \sess -> 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 ccui sUIOptions clientOptions startsNewGame = do
  modifyClient $ \cli -> cli {soptions = clientOptions}
  side <- getsClient sside
  hasUI <- clientHasUI
  if not hasUI then initAI else initUI ccui
  let cliendKindText = if not hasUI then "AI" else "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 (cli, msess)-> do
          -- Restore game.
          case msess of
            Just sess | 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 <- getsSession schanF
              sccui <- getsSession sccui
              putSession $ sess {schanF, sccui, sUIOptions}
            _ -> return ()
          if 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@).
            return False
          else do
            -- We preserve the client state from savefile except for the single
            -- option that can be overwritten on commandline.
            let noAnim = fromMaybe False $ snoAnim $ soptions cli
            putClient cli {soptions = clientOptions {snoAnim = Just noAnim}}
            return True
        Nothing -> return False
  debugPossiblyPrint $ cliendKindText <+> "client"
                       <+> tshow side <+> "starting 2/4."
  -- At this point @ClientState@ not overriten dumbly and @State@ valid.
  tabA <- createTabBFS
  tabB <- createTabBFS
  modifyClient $ \cli -> cli {stabs = (tabA, tabB)}
  cmd1 <- receiveResponse
  debugPossiblyPrint $ cliendKindText <+> "client"
                       <+> tshow side <+> "starting 3/4."
  case (restored, startsNewGame, cmd1) of
    (True, False, RespUpdAtomic _ UpdResume{}) ->
      return ()
    (True, True, RespUpdAtomic _ UpdRestart{}) ->
      when hasUI $
        clientPrintUI "Ignoring an old savefile and starting a new game."
    (False, False, RespUpdAtomic _ UpdResume{}) ->
      error $ "Savefile of client " ++ show side ++ " not usable."
              `showFailure` ()
    (False, True, RespUpdAtomic _ UpdRestart{}) ->
      return ()
    (True, False, RespUpdAtomicNoState UpdResume{}) ->
      undefined
    (True, True, RespUpdAtomicNoState UpdRestart{}) ->
      when hasUI $
        clientPrintUI "Ignoring an old savefile and starting a new game."
    (False, False, RespUpdAtomicNoState UpdResume{}) ->
      error $ "Savefile of client " ++ show side ++ " not usable."
              `showFailure` ()
    (False, True, RespUpdAtomicNoState UpdRestart{}) ->
      return ()
    _ -> error $ "unexpected command" `showFailure` (side, restored, 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 = do
  cmd <- receiveResponse
  handleResponse cmd
  quit <- getsClient squit
  unless quit
    loopAI

-- | Alarm after this many seconds without server querying us for a command.
longestDelay :: POSIXTime
longestDelay = secondsToNominalDiffTime 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 timeSinceLastQuery = do
  sreqPending <- getsSession sreqPending
  sreqDelay <- getsSession sreqDelay
  sregainControl <- getsSession sregainControl
  keyPressed <- anyKeyPressed
  let alarm = timeSinceLastQuery > 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
         RespQueryUI -> loopUI 0
         RespQueryUIunderAI ->
           loopUI $ succ longestDelay  -- permit fast AI control regain
         _ -> do
           when (isJust sreqPending) $ do
             msgAdd MsgActionAlert "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.
           loopUI $ timeSinceLastQuery - timeBefore + 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 $ \sess -> 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 $ \sess -> sess {sreqDelay = ReqDelayHandled}
         let msg = if isNothing sreqPending
                   then "Server delayed asking us for a command. Regardless, UI is made accessible. Press ESC twice to listen to server some more."
                   else "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 $ \sess -> sess {sreqPending = mreqNew}
         -- Now relax completely.
         modifySession $ \sess -> 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 $ \sess -> 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