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
:: Game ()
terminateGameOnSigint = do
-- sock <- asks rcSocket
-- clientId <- asks rcClientUUID
sock <- asks rcSocket
clientId <- asks rcClientUUID
clientState <- gets scClientState
void $ liftIO $ installHandler
keyboardSignal
(CatchOnce $ do
currentState <- STM.atomically $ do
STM.atomically $ do
currentState <- STM.readTMVar clientState
void $ STM.swapTMVar clientState $ currentState { clientStop = True }
pure currentState
Vty.shutdown (clientVty currentState)
-- partingMessage clientId sock
-- Vty.shutdown (clientVty currentState)
partingMessage clientId sock
-- Raise SIGINT again so it does not get blocked
-- raiseSignal keyboardSignal
raiseSignal keyboardSignal
)
Nothing

View file

@ -56,14 +56,14 @@ main = do
playerWizard <- head <$> STM.atomically (STM.flushTQueue queue)
putStrLn $ "received wizard: " <> show (initWizard playerWizard)
cfg <- standardIOConfig
vty <- mkVty cfg
-- cfg <- standardIOConfig
-- vty <- mkVty cfg
-- hideCursor (outputIface vty)
-- 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 initRead = ReaderContainer sock clientId queue
initState = StateContainer (initWizard playerWizard) clientState initSlice
@ -76,7 +76,7 @@ main = do
)
initRead
initState
shutdown vty
-- shutdown vty
partingMessage clientId sock
threadDelay 100
close sock

View file

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