make more sync

This commit is contained in:
nek0 2024-02-03 18:01:45 +01:00
parent d2062b2cbe
commit ce69da9e43

View file

@ -19,8 +19,6 @@ import qualified Data.ByteString.Lazy.Char8 as B8
import Data.List
import qualified Data.Matrix as M
import Data.Maybe
import Data.UUID hiding (null)
@ -32,8 +30,6 @@ import qualified Data.Vector.Storable as VS
import Foreign hiding (void)
import Linear
import Network.Socket as Net
import System.Posix.Signals
@ -66,13 +62,14 @@ terminateGameOnSigint
-> Game ()
terminateGameOnSigint path = do
sock <- asks rcMainSocket
clients <- liftIO . STM.atomically . STM.readTMVar =<< gets scClientSockets
clientList <- gets scClientSockets
clients <- liftIO $ STM.atomically $ STM.readTMVar clientList
serverState <- gets scServerState
void $ liftIO $ installHandler
sigINT
(CatchOnce $ do
putStrLn "SIGINT caught, terminating…"
disconnectClients clients
disconnectClients clientList clients
close sock
removeIfExists path
void $ STM.atomically $ STM.swapTMVar serverState (ServerState False True)
@ -82,19 +79,25 @@ terminateGameOnSigint path = do
Nothing
disconnectClients
:: [(Maybe UUID, Socket)]
:: STM.TMVar [(Maybe UUID, Socket)]
-> [(Maybe UUID, Socket)]
-> IO ()
disconnectClients = mapM_
(\(_, clientSocket) -> do
disconnectClients clientList = mapM_
(\client@(_, clientSocket) -> do
sendMessage ServerQuit clientSocket
close clientSocket
dropClient clientList client
)
dropClient
:: (Maybe UUID, Socket)
:: STM.TMVar [(Maybe UUID, Socket)]
-> (Maybe UUID, Socket)
-> IO ()
dropClient =
close . snd
dropClient clientList (uuid, clientSocket) = do
STM.atomically $ do
clients <- STM.readTMVar clientList
let reducedClients = filter ((/= uuid) . fst) clients
void $ STM.swapTMVar clientList reducedClients
close clientSocket
-- | Process incoming connection requests
processRequests :: Game ()
@ -236,12 +239,22 @@ handleMessage stateContainer readerContainer msg = do
void $ STM.swapTMVar (scPlayers stateContainer) $
(head thisPlayers) {playerReady = True} : otherPlayers
Pong uuid -> do
let client = fromJust $ (lookup (Just clientId) clients)
let client = fromJust (lookup (Just clientId) clients)
player <- STM.atomically $ do
players <- STM.readTMVar (scPlayers stateContainer)
pure $ head $ filter (\p -> playerId p == clientId) players
when (snd (playerLastPong player) /= uuid) $
dropClient (Just clientId, client)
if snd (playerLastPong player) /= uuid
then
dropClient clientList (Just clientId, client)
else do
now <- getCurrentTime
STM.atomically$ do
players <- STM.readTMVar (scPlayers stateContainer)
let otherPlayers = filter (/= player) players
modPlayer = player
{ playerLastPong = (now, uuid)
}
void $ STM.swapTMVar (scPlayers stateContainer) (modPlayer : otherPlayers)
_ -> pure ()
sendPings :: Game ()
@ -257,15 +270,16 @@ sendPings = do
(\(Player playerId (Wizard {}) readiness (lastPongTime, _)) -> do
let timeDiff = realToFrac $ diffUTCTime now lastPongTime
when (readiness && timeDiff > (fromIntegral framesPerPing * recip (fromIntegral fps))) $ do
let clientSock = fromJust (lookup (Just playerId) sockets)
if timeDiff > realToFrac maxTimeout
then
liftIO $ dropClient (Just playerId, clientSock)
else do
random <- liftIO nextRandom
liftIO $ sendMessage
( Ping random
)
clientSock
let clientSock = lookup (Just playerId) sockets
when (isJust clientSock) $
if timeDiff > realToFrac maxTimeout
then
liftIO $ dropClient (scClientSockets stateContainer) (Just playerId, fromJust clientSock)
else do
random <- liftIO nextRandom
liftIO $ sendMessage
( Ping random
)
(fromJust clientSock)
)
players