work on server-side sychronisation

This commit is contained in:
nek0 2024-02-02 09:07:11 +01:00
parent 6587f97312
commit 9d140b6206
4 changed files with 17 additions and 10 deletions

View file

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

View file

@ -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

View file

@ -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
)

View file

@ -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