closing in on communication issue

This commit is contained in:
nek0 2024-03-29 04:14:21 +01:00
parent ce69da9e43
commit 95193f5fd1
3 changed files with 45 additions and 33 deletions

View file

@ -122,20 +122,19 @@ receiveMessage sock queue = do
terminateGameOnSigint terminateGameOnSigint
:: Game () :: Game ()
terminateGameOnSigint = do terminateGameOnSigint = do
-- sock <- asks rcSocket sock <- asks rcSocket
-- clientId <- asks rcClientUUID clientId <- asks rcClientUUID
clientState <- gets scClientState clientState <- gets scClientState
void $ liftIO $ installHandler void $ liftIO $ installHandler
keyboardSignal keyboardSignal
(CatchOnce $ do (CatchOnce $ do
currentState <- STM.atomically $ do STM.atomically $ do
currentState <- STM.readTMVar clientState currentState <- STM.readTMVar clientState
void $ STM.swapTMVar clientState $ currentState { clientStop = True } void $ STM.swapTMVar clientState $ currentState { clientStop = True }
pure currentState -- Vty.shutdown (clientVty currentState)
Vty.shutdown (clientVty currentState) partingMessage clientId sock
-- partingMessage clientId sock
-- Raise SIGINT again so it does not get blocked -- Raise SIGINT again so it does not get blocked
-- raiseSignal keyboardSignal raiseSignal keyboardSignal
) )
Nothing Nothing

View file

@ -56,14 +56,14 @@ main = do
playerWizard <- head <$> STM.atomically (STM.flushTQueue queue) playerWizard <- head <$> STM.atomically (STM.flushTQueue queue)
putStrLn $ "received wizard: " <> show (initWizard playerWizard) putStrLn $ "received wizard: " <> show (initWizard playerWizard)
cfg <- standardIOConfig -- cfg <- standardIOConfig
vty <- mkVty cfg -- vty <- mkVty cfg
-- hideCursor (outputIface vty) -- hideCursor (outputIface vty)
-- shut down graphical interface for now -- shut down graphical interface for now
shutdown vty -- shutdown vty
clientState <- STM.newTMVarIO (ClientState vty False False) clientState <- STM.newTMVarIO (ClientState undefined False False)
let initSlice = MapSlice (M.matrix 9 9 (const Nothing)) [] let initSlice = MapSlice (M.matrix 9 9 (const Nothing)) []
let initRead = ReaderContainer sock clientId queue let initRead = ReaderContainer sock clientId queue
initState = StateContainer (initWizard playerWizard) clientState initSlice initState = StateContainer (initWizard playerWizard) clientState initSlice
@ -76,7 +76,7 @@ main = do
) )
initRead initRead
initState initState
shutdown vty -- shutdown vty
partingMessage clientId sock partingMessage clientId sock
threadDelay 100 threadDelay 100
close sock close sock

View file

@ -97,6 +97,7 @@ dropClient clientList (uuid, clientSocket) = do
clients <- STM.readTMVar clientList clients <- STM.readTMVar clientList
let reducedClients = filter ((/= uuid) . fst) clients let reducedClients = filter ((/= uuid) . fst) clients
void $ STM.swapTMVar clientList reducedClients void $ STM.swapTMVar clientList reducedClients
putStrLn $ "dropping client " <> show uuid
close clientSocket close clientSocket
-- | Process incoming connection requests -- | Process incoming connection requests
@ -147,11 +148,13 @@ handleMessages = do
queue <- gets scMessageQueue queue <- gets scMessageQueue
serverState <- get serverState <- get
readerContainer <- ask readerContainer <- ask
msgs <- liftIO $ STM.atomically $ STM.flushTQueue queue emptyState <- liftIO $ STM.atomically $ STM.isEmptyTQueue queue
void $ liftIO $ do unless emptyState $ do
mapM_ msgs <- liftIO $ STM.atomically $ STM.flushTQueue queue
(handleMessage serverState readerContainer) void $ liftIO $ do
msgs mapM_
(handleMessage serverState readerContainer)
msgs
-- | receive a 'ClientMessage' -- | receive a 'ClientMessage'
receiveMessage receiveMessage
@ -243,18 +246,19 @@ handleMessage stateContainer readerContainer msg = do
player <- STM.atomically $ do player <- STM.atomically $ do
players <- STM.readTMVar (scPlayers stateContainer) players <- STM.readTMVar (scPlayers stateContainer)
pure $ head $ filter (\p -> playerId p == clientId) players pure $ head $ filter (\p -> playerId p == clientId) players
if snd (playerLastPong player) /= uuid -- if snd (playerLastPong player) /= uuid
then -- then do
dropClient clientList (Just clientId, client) -- putStrLn $ "dropping client " <> show clientId
else do -- dropClient clientList (Just clientId, client)
now <- getCurrentTime -- else do
STM.atomically$ do now <- getCurrentTime
players <- STM.readTMVar (scPlayers stateContainer) STM.atomically$ do
let otherPlayers = filter (/= player) players players <- STM.readTMVar (scPlayers stateContainer)
modPlayer = player let otherPlayers = filter (\a -> playerId a /= playerId player) players
{ playerLastPong = (now, uuid) modPlayer = player
} { playerLastPong = (now, uuid)
void $ STM.swapTMVar (scPlayers stateContainer) (modPlayer : otherPlayers) }
void $ STM.swapTMVar (scPlayers stateContainer) (modPlayer : otherPlayers)
_ -> pure () _ -> pure ()
sendPings :: Game () sendPings :: Game ()
@ -267,19 +271,28 @@ sendPings = do
players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers stateContainer) players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers stateContainer)
sockets <- liftIO $ STM.atomically $ STM.readTMVar (scClientSockets stateContainer) sockets <- liftIO $ STM.atomically $ STM.readTMVar (scClientSockets stateContainer)
mapM_ mapM_
(\(Player playerId (Wizard {}) readiness (lastPongTime, _)) -> do (\player@(Player plId (Wizard {}) readiness (lastPongTime, _)) -> do
let timeDiff = realToFrac $ diffUTCTime now lastPongTime let timeDiff = realToFrac $ diffUTCTime now lastPongTime
when (readiness && timeDiff > (fromIntegral framesPerPing * recip (fromIntegral fps))) $ do when (readiness && timeDiff > (fromIntegral framesPerPing * recip (fromIntegral fps))) $ do
let clientSock = lookup (Just playerId) sockets let clientSock = lookup (Just plId) sockets
when (isJust clientSock) $ when (isJust clientSock) $
if timeDiff > realToFrac maxTimeout if timeDiff > realToFrac maxTimeout
then then do
liftIO $ dropClient (scClientSockets stateContainer) (Just playerId, fromJust clientSock) liftIO $ dropClient (scClientSockets stateContainer) (Just plId, fromJust clientSock)
put stateContainer
else do else do
random <- liftIO nextRandom random <- liftIO nextRandom
let newPong = (lastPongTime, random)
liftIO $ sendMessage liftIO $ sendMessage
( Ping random ( Ping random
) )
(fromJust clientSock) (fromJust clientSock)
let newPlayer = player
{ playerLastPong = newPong
}
otherPlayers = filter (\a -> playerId a /= plId) players
liftIO $ void $ STM.atomically $
STM.swapTMVar (scPlayers stateContainer) (newPlayer : otherPlayers)
put stateContainer
) )
players players