fix data garbling

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
+  rawMsg <- B.pack <$> peekArray bufferLength ptr
-  let mJsonMsg = A.decode' $ B8.fromStrict msg
+  let msgs = map B8.tail $ init $ B8.split '>' $ B8.fromStrict rawMsg
-  maybe
+  mapM_
-    (putStrLn $ "received garbled data: " <> B8.unpack (B8.fromStrict msg))
+    (\msg -> do
-    (STM.atomically . STM.writeTQueue queue)
+      let mJsonMsg = A.decode' msg
-    mJsonMsg
+      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

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

src-lib/Library/Types/Communication.hs

@@ -33,6 +33,7 @@ instance ToJSON ServerMessage
 data ClientMessagePayload
   = ClientQuit
   | ClientRequestWizard
+  | ClientReady
   deriving (Eq, Show, Generic)
 
 data ClientMessage

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
+    (\(Player playerId wizard@(Wizard {..}) readiness) -> do
-      let V2 wr wc = wizardPos
+      when readiness $ do
-          subCoords = (,) <$> [floor wr - 4 .. floor wr + 4] <*> [floor wc - 4 .. floor wc + 4]
+        let V2 wr wc = wizardPos
-          leftBound = wizardRot + (pi / 4)
+            subCoords = (,) <$> [floor wr - 4 .. floor wr + 4] <*> [floor wc - 4 .. floor wc + 4]
-          rightBound = wizardRot - (pi / 4)
+            leftBound = wizardRot + (pi / 4)
-          leftLine row = cos leftBound * row
+            rightBound = wizardRot - (pi / 4)
-          rightLine row = sin rightBound * row
+            leftLine row = cos leftBound * row
-          correctionLeft = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2
+            rightLine row = sin rightBound * row
-            then floor
+            correctionLeft = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2
-            else ceiling
+              then floor
-          correctionRight = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2
+              else ceiling
-            then ceiling
+            correctionRight = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2
-            else floor
+              then ceiling
-          viewMatrix = M.fromList 9 9 $ map
+              else floor
-            (\(qr, qc) ->
+            viewMatrix = M.fromList 9 9 $ map
-              if qc - floor wc <= correctionLeft (leftLine (wr - fromIntegral qr))
+              (\(qr, qc) ->
-                  && qc - floor wc >= correctionRight (rightLine (wr - fromIntegral qr))
+                if qc - floor wc <= correctionLeft (leftLine (wr - fromIntegral qr))
-              then
+                    && qc - floor wc >= correctionRight (rightLine (wr - fromIntegral qr))
-                M.safeGet qr qc tileMap
+                then
-              else
+                  M.safeGet qr qc tileMap
-                Nothing
+                else
-            )
+                  Nothing
-            subCoords
+              )
-          clientSock = fromJust $ lookup (Just playerId) sockets
+              subCoords
-      -- liftIO $ print $ leftLine . (\x -> x - wr) . fromIntegral .fst <$> subCoords
+            clientSock = fromJust $ lookup (Just playerId) sockets
-      -- liftIO $ print initViewMatrix
+        -- liftIO $ print $ leftLine . (\x -> x - wr) . fromIntegral .fst <$> subCoords
-      liftIO $ sendMessage
+        -- liftIO $ print initViewMatrix
-        (TickUpdate
+        liftIO $ sendMessage
-          { tuWizard   = wizard
+          (TickUpdate
-          , tuMapSlice = MapSlice
+            { tuWizard   = wizard
-            { msViewMap  = viewMatrix
+            , tuMapSlice = MapSlice
-            , msContents = []
+              { msViewMap  = viewMatrix
+              , msContents = []
+              }
             }
-          }
+          )
-        )
+          clientSock
-        clientSock
     )
     players

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 {
+          in
-               playerWizard = wizard
+            if readiness
-                 { wizardEffects = newEffects
+            then
-                 , wizardHealth  = health - effectDamage
+              player
-                 }
+                { playerWizard = wizard
-             }
+                  { wizardEffects = newEffects
+                  , wizardHealth  = health - effectDamage
+                  }
+                }
+            else
+              player
         )
         players
   void $ liftIO $ STM.atomically $ STM.swapTMVar playersVar newPlayers

src-server/Server/Types.hs

@@ -64,6 +64,7 @@ data StateContainer = StateContainer
 data Player = Player
   { playerId     :: UUID
   , playerWizard :: Wizard
+  , playerReady  :: Bool
   }
   deriving (Eq, Show)
 

src-server/Server/Util.hs

@@ -29,7 +29,7 @@ newWizard
 newWizard pos =
   Wizard
     { wizardWands   = []
-    , wizardRot     = 3
+    , wizardRot     = 0
     , wizardPos     = pos
     , wizardMana    = 100
     , wizardHealth  = 100