work on server-side sychronisation

configuration.yaml

@@ -3,3 +3,5 @@ setMapRows            : 40
 setMapColumns         : 40
 setSpawnerProbability : 0.01
 setFPS                : 60
+setClientMaxTimeout   : 5
+setFramesPerPing      : 5

src-server/Main.hs

@@ -54,7 +54,12 @@ main = do
       messageQueue <- STM.newTQueueIO
       serverState <- STM.newTMVarIO (ServerState False False)
       emptyPLayers <- STM.newTMVarIO []
-      let initRead  = ReaderContainer (arenaMap arena) setFPS sock
+      let initRead  = ReaderContainer
+            (arenaMap arena)
+            setFPS
+            setFramesPerPing
+            setClientMaxTimeout
+            sock
           initState = StateContainer (arenaSpawners arena) emptyPLayers serverState now sockList messageQueue
       (finalState, finalWrite) <- execRWST
         (do

src-server/Server/Communication.hs

@@ -82,7 +82,7 @@ terminateGameOnSigint path = do
     Nothing
 
 disconnectClients
-  :: [Client]
+  :: [(Maybe UUID, Socket)]
   -> IO ()
 disconnectClients = mapM_
   (\(_, clientSocket) -> do
@@ -211,11 +211,12 @@ handleMessage stateContainer readerContainer msg = do
           putStrLn "initializing new wizard"
           let arena = rcMap readerContainer
           initPos <- rollInitPosition arena
+          now <- liftIO getCurrentTime
           let freshWizard = newWizard initPos
           STM.atomically $ do
             currentPlayers <- STM.readTMVar (scPlayers stateContainer)
             void $ STM.swapTMVar (scPlayers stateContainer) $
-              Player clientId freshWizard False : currentPlayers
+              Player clientId freshWizard False now : currentPlayers
           let clientSock = fromJust $ lookup (Just clientId) clients
           sendMessage (ProvideInitialWizard freshWizard) clientSock
         ClientReady -> do
@@ -232,7 +233,6 @@ handleMessage stateContainer readerContainer msg = do
 sendPings :: Game ()
 sendPings = do
   now <- liftIO getCurrentTime
-  tileMap <- asks rcMap
   maxTimeout <- asks rcClientMaxTimeout
   framesPerPing <- asks rcFramesPerPing
   fps <- asks rcFPS
@@ -242,13 +242,13 @@ sendPings = do
   mapM_
     (\(Player playerId (Wizard {}) readiness lastPong) -> do
       let timeDiff = realToFrac $ diffUTCTime now lastPong
-      when (readiness && timeDiff > (framesPerPing * recip fps)) $ do
+      when (readiness && timeDiff > (fromIntegral framesPerPing * recip (fromIntegral fps))) $ do
         let clientSock = fromJust (lookup (Just playerId) sockets)
-        if timeDiff > maxTimeout
+        if timeDiff > realToFrac maxTimeout
         then
-          liftIO $ disconnectClients [clientSock]
+          liftIO $ disconnectClients [(Just playerId, clientSock)]
         else do
-          random <- liftIO $ nextRandom
+          random <- liftIO nextRandom
           liftIO $ sendMessage
             ( Ping random
             )

src-server/Server/Game.hs

@@ -48,7 +48,7 @@ runGame = do
           }
         )
       fps <- asks rcFPS
-      sendUpdates
+      sendPings
       let remainingTime = recip (fromIntegral fps) - delta
       when (remainingTime > 0) $
         liftIO $ threadDelay $ floor $ remainingTime * 10 ^ 6
@@ -81,7 +81,7 @@ updateWizards dt = do
   playersVar <- gets scPlayers
   players <- liftIO $ STM.atomically $ STM.readTMVar playersVar
   let newPlayers = map
-        (\player@(Player pId wizard@(Wizard _ _ health _ _ effects) readiness) ->
+        (\player@(Player pId wizard@(Wizard _ _ health _ _ effects) readiness lastPong) ->
           let newEffects = foldl
                 (\acc effect@(Effect _ ttl) ->
                   if ttl - dt < 0