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
+  mapM_
+    (\msg -> do
+      let mJsonMsg = A.decode' msg
       maybe
-    (putStrLn $ "received garbled data: " <> B8.unpack (B8.fromStrict msg))
+        (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,7 +231,8 @@ 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
+      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)

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
+            then
+              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