From 3e72e87e56cca44ed6d1b1f6d78905fa5410ae56 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 23 Dec 2023 11:38:57 +0100 Subject: [PATCH] fix data garbling --- src-client/Client/Communication.hs | 17 +++-- src-client/Client/Game.hs | 2 + src-lib/Library/Types/Communication.hs | 1 + src-server/Server/Communication.hs | 91 +++++++++++++++----------- src-server/Server/Game.hs | 21 +++--- src-server/Server/Types.hs | 1 + src-server/Server/Util.hs | 2 +- 7 files changed, 80 insertions(+), 55 deletions(-) diff --git a/src-client/Client/Communication.hs b/src-client/Client/Communication.hs index 5b4fafd..0baca8e 100644 --- a/src-client/Client/Communication.hs +++ b/src-client/Client/Communication.hs @@ -93,12 +93,17 @@ receiveMessage sock queue = do let maxBufferLength = 4096 ptr <- mallocArray maxBufferLength bufferLength <- recvBuf sock ptr maxBufferLength - msg <- B.pack <$> peekArray bufferLength ptr - let mJsonMsg = A.decode' $ B8.fromStrict msg - maybe - (putStrLn $ "received garbled data: " <> B8.unpack (B8.fromStrict msg)) - (STM.atomically . STM.writeTQueue queue) - mJsonMsg + rawMsg <- B.pack <$> peekArray bufferLength ptr + let msgs = map B8.tail $ init $ B8.split '>' $ B8.fromStrict rawMsg + mapM_ + (\msg -> do + let mJsonMsg = A.decode' msg + maybe + (putStrLn $ "received garbled data: " <> B8.unpack msg) + (STM.atomically . STM.writeTQueue queue) + mJsonMsg + ) + msgs -- | Function that installs a handler on SIGINT to terminate game terminateGameOnSigint diff --git a/src-client/Client/Game.hs b/src-client/Client/Game.hs index bb892d6..5c27713 100644 --- a/src-client/Client/Game.hs +++ b/src-client/Client/Game.hs @@ -21,7 +21,9 @@ runGame :: Game () runGame = do sock <- asks rcSocket queue <- asks rcQueue + clientId <- asks rcClientUUID recvThread <- liftIO $ forkIO $ forever $ receiveMessage sock queue + liftIO $ sendMessage (ClientMessage clientId ClientReady) sock whileM_ (not . clientStop <$> (liftIO . STM.atomically . STM.readTMVar =<< gets scClientState)) (do diff --git a/src-lib/Library/Types/Communication.hs b/src-lib/Library/Types/Communication.hs index c1fbe26..a158706 100644 --- a/src-lib/Library/Types/Communication.hs +++ b/src-lib/Library/Types/Communication.hs @@ -33,6 +33,7 @@ instance ToJSON ServerMessage data ClientMessagePayload = ClientQuit | ClientRequestWizard + | ClientReady deriving (Eq, Show, Generic) data ClientMessage diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs index 6791e04..f01c41d 100644 --- a/src-server/Server/Communication.hs +++ b/src-server/Server/Communication.hs @@ -23,7 +23,7 @@ import qualified Data.Matrix as M import Data.Maybe -import Data.UUID +import Data.UUID hiding (null) import Data.UUID.V4 import qualified Data.Vector.Storable as VS @@ -108,7 +108,7 @@ sendMessage -> IO () sendMessage msg sock = do let msgJson = A.encode msg - msgVector = VS.fromList $ B.unpack $ B.toStrict msgJson + msgVector = VS.fromList $ B.unpack $ B.toStrict $ ('<' `B8.cons` (msgJson `B8.snoc` '>')) -- putStrLn $ "sending: " <> B8.unpack msgJson VS.unsafeWith msgVector @@ -206,12 +206,22 @@ handleMessage stateContainer readerContainer msg = do putStrLn "initializing new wizard" let arena = rcMap readerContainer initPos <- rollInitPosition arena - let freshWIzard = newWizard initPos + let freshWizard = newWizard initPos STM.atomically $ do currentPlayers <- STM.readTMVar (scPlayers stateContainer) - void $ STM.swapTMVar (scPlayers stateContainer) $ Player clientId freshWIzard : currentPlayers + void $ STM.swapTMVar (scPlayers stateContainer) $ + Player clientId freshWizard False : currentPlayers let clientSock = fromJust $ lookup (Just clientId) clients - sendMessage (ProvideInitialWizard (newWizard initPos)) clientSock + sendMessage (ProvideInitialWizard freshWizard) clientSock + ClientReady -> do + putStrLn $ "client " <> show clientId <> " is ready!" + STM.atomically $ do + currentPlayers <- STM.readTMVar (scPlayers stateContainer) + let (thisPlayers, otherPlayers) = + partition (\p -> playerId p == clientId) currentPlayers + unless (null thisPlayers) $ + void $ STM.swapTMVar (scPlayers stateContainer) $ + (head thisPlayers) {playerReady = True} : otherPlayers _ -> pure () sendUpdates :: Game () @@ -221,41 +231,42 @@ sendUpdates = do players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers stateContainer) sockets <- liftIO $ STM.atomically $ STM.readTMVar (scClientSockets stateContainer) mapM_ - (\(player@(Player playerId wizard@(Wizard {..}))) -> do - let V2 wr wc = wizardPos - subCoords = (,) <$> [floor wr - 4 .. floor wr + 4] <*> [floor wc - 4 .. floor wc + 4] - leftBound = wizardRot + (pi / 4) - rightBound = wizardRot - (pi / 4) - leftLine row = cos leftBound * row - rightLine row = sin rightBound * row - correctionLeft = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2 - then floor - else ceiling - correctionRight = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2 - then ceiling - else floor - viewMatrix = M.fromList 9 9 $ map - (\(qr, qc) -> - if qc - floor wc <= correctionLeft (leftLine (wr - fromIntegral qr)) - && qc - floor wc >= correctionRight (rightLine (wr - fromIntegral qr)) - then - M.safeGet qr qc tileMap - else - Nothing - ) - subCoords - clientSock = fromJust $ lookup (Just playerId) sockets - -- liftIO $ print $ leftLine . (\x -> x - wr) . fromIntegral .fst <$> subCoords - -- liftIO $ print initViewMatrix - liftIO $ sendMessage - (TickUpdate - { tuWizard = wizard - , tuMapSlice = MapSlice - { msViewMap = viewMatrix - , msContents = [] + (\(Player playerId wizard@(Wizard {..}) readiness) -> do + when readiness $ do + let V2 wr wc = wizardPos + subCoords = (,) <$> [floor wr - 4 .. floor wr + 4] <*> [floor wc - 4 .. floor wc + 4] + leftBound = wizardRot + (pi / 4) + rightBound = wizardRot - (pi / 4) + leftLine row = cos leftBound * row + rightLine row = sin rightBound * row + correctionLeft = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2 + then floor + else ceiling + correctionRight = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2 + then ceiling + else floor + viewMatrix = M.fromList 9 9 $ map + (\(qr, qc) -> + if qc - floor wc <= correctionLeft (leftLine (wr - fromIntegral qr)) + && qc - floor wc >= correctionRight (rightLine (wr - fromIntegral qr)) + then + M.safeGet qr qc tileMap + else + Nothing + ) + subCoords + clientSock = fromJust $ lookup (Just playerId) sockets + -- liftIO $ print $ leftLine . (\x -> x - wr) . fromIntegral .fst <$> subCoords + -- liftIO $ print initViewMatrix + liftIO $ sendMessage + (TickUpdate + { tuWizard = wizard + , tuMapSlice = MapSlice + { msViewMap = viewMatrix + , msContents = [] + } } - } - ) - clientSock + ) + clientSock ) players diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs index 6a6e6d0..0f0b794 100644 --- a/src-server/Server/Game.hs +++ b/src-server/Server/Game.hs @@ -48,7 +48,7 @@ runGame = do } ) fps <- asks rcFPS - -- sendUpdates + sendUpdates 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)) -> + (\player@(Player pId wizard@(Wizard _ _ health _ _ effects) readiness) -> let newEffects = foldl (\acc effect@(Effect _ ttl) -> if ttl - dt < 0 @@ -100,12 +100,17 @@ updateWizards dt = do ) 0 effects - in player { - playerWizard = wizard - { wizardEffects = newEffects - , wizardHealth = health - effectDamage - } - } + in + if readiness + then + player + { playerWizard = wizard + { wizardEffects = newEffects + , wizardHealth = health - effectDamage + } + } + else + player ) players void $ liftIO $ STM.atomically $ STM.swapTMVar playersVar newPlayers diff --git a/src-server/Server/Types.hs b/src-server/Server/Types.hs index fa79bf0..11ebfc9 100644 --- a/src-server/Server/Types.hs +++ b/src-server/Server/Types.hs @@ -64,6 +64,7 @@ data StateContainer = StateContainer data Player = Player { playerId :: UUID , playerWizard :: Wizard + , playerReady :: Bool } deriving (Eq, Show) diff --git a/src-server/Server/Util.hs b/src-server/Server/Util.hs index 8ebae20..cfbd31a 100644 --- a/src-server/Server/Util.hs +++ b/src-server/Server/Util.hs @@ -29,7 +29,7 @@ newWizard newWizard pos = Wizard { wizardWands = [] - , wizardRot = 3 + , wizardRot = 0 , wizardPos = pos , wizardMana = 100 , wizardHealth = 100