From 9d140b6206744df58d4261b31221456e0175188d Mon Sep 17 00:00:00 2001
From: nek0 <nek0@nek0.eu>
Date: Fri, 2 Feb 2024 09:07:11 +0100
Subject: [PATCH] work on server-side sychronisation

---
 configuration.yaml                 |  2 ++
 src-server/Main.hs                 |  7 ++++++-
 src-server/Server/Communication.hs | 14 +++++++-------
 src-server/Server/Game.hs          |  4 ++--
 4 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/configuration.yaml b/configuration.yaml
index 658de8a..f0614a9 100644
--- a/configuration.yaml
+++ b/configuration.yaml
@@ -3,3 +3,5 @@ setMapRows            : 40
 setMapColumns         : 40
 setSpawnerProbability : 0.01
 setFPS                : 60
+setClientMaxTimeout   : 5
+setFramesPerPing      : 5
diff --git a/src-server/Main.hs b/src-server/Main.hs
index e00cdc2..cdeb50c 100644
--- a/src-server/Main.hs
+++ b/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
diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs
index 633517a..9ee7c86 100644
--- a/src-server/Server/Communication.hs
+++ b/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
             )
diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs
index 0f0b794..aa78ff0 100644
--- a/src-server/Server/Game.hs
+++ b/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