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