first actual game content communication

src-server/Main.hs

@@ -53,8 +53,9 @@ main = do
       sockList <- STM.newTMVarIO []
       messageQueue <- STM.newTQueueIO
       serverState <- STM.newTMVarIO (ServerState False False)
+      emptyPLayers <- STM.newTMVarIO []
       let initRead  = ReaderContainer (arenaMap arena) setFPS sock
-          initState = StateContainer (arenaSpawners arena) [] serverState now sockList messageQueue
+          initState = StateContainer (arenaSpawners arena) emptyPLayers serverState now sockList messageQueue
       (finalState, finalWrite) <- execRWST
         (do
           terminateGameOnSigint setSocketPath

src-server/Server/Communication.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 module Server.Communication where
 
 import Control.Concurrent
@@ -34,8 +35,6 @@ import Network.Socket as Net
 
 import System.Posix.Signals
 
-import System.Random (randomRIO)
-
 -- internal imports
 
 import Library.Types
@@ -196,36 +195,37 @@ handleMessage stateContainer readerContainer msg = do
         ClientQuit -> do
           putStrLn $ "removing client " <> show clientId
           let newClients = filter (\a -> fst a /= Just clientId) clients
-          void $ liftIO $ STM.atomically $ STM.swapTMVar clientList newClients
+          STM.atomically $ do
+            currentPlayers <- STM.readTMVar (scPlayers stateContainer)
+            let newPlayers = filter (\p -> playerId p /= clientId) currentPlayers
+            void $ STM.swapTMVar (scPlayers stateContainer) newPlayers
+            void $ STM.swapTMVar clientList newClients
         ClientRequestWizard -> do
           putStrLn "initializing new wizard"
           let arena = rcMap readerContainer
           initPos <- rollInitPosition arena
+          let freshWIzard = newWizard initPos
+          STM.atomically $ do
+            currentPlayers <- STM.readTMVar (scPlayers stateContainer)
+            void $ STM.swapTMVar (scPlayers stateContainer) $ Player clientId freshWIzard : currentPlayers
           let clientSock = fromJust $ lookup (Just clientId) clients
           sendMessage (ProvideInitialWizard (newWizard initPos)) clientSock
         _          -> pure ()
 
-newWizard
-  :: Position
-  -> Wizard
-newWizard pos =
-  Wizard
-    { wizardWands   = []
-    , wizardRot     = 0
-    , wizardPos     = pos
-    , wizardMana    = 100
-    , wizardHealth  = 100
-    , wizardEffects = []
-    }
-
-rollInitPosition
-  :: ServerMap
-  -> IO Position
-rollInitPosition arena = do
-  r <- randomRIO (1, M.nrows arena)
-  c <- randomRIO (1, M.ncols arena)
-  if arena M.! (r, c) == Air
-  then
-    pure $ (fromIntegral <$> V2 r c) + V2 0.5 0.5
-  else
-    rollInitPosition arena
+sendUpdates :: Game ()
+sendUpdates = do
+  tileMap <- asks rcMap
+  stateContainer <- get
+  players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers 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]
+          initViewMatrix = M.fromList 9 9 $ map
+            (\(qr, qc) ->
+              M.safeGet qr qc tileMap
+            )
+            subCoords
+      liftIO $ print initViewMatrix
+    )
+    players

src-server/Server/Game.hs

@@ -38,6 +38,7 @@ runGame = do
       handleMessages
       updateSpawners delta
       updateWizards delta
+      sendUpdates
       modify'
         (\s -> s
           { scServerLastTick = now
@@ -71,35 +72,35 @@ updateSpawners dt =
     )
 
 updateWizards :: Float -> Game ()
-updateWizards dt =
-  modify' (\sc@(StateContainer _ wizards _ _ _ _) ->
-    let newWizards = map
-          (\wizard@(Wizard _ _ health _ _ effects) ->
-            let newEffects = foldl
-                  (\acc effect@(Effect _ ttl) ->
-                    if ttl - dt < 0
-                    then acc
-                    else effect
-                      { effectTTL = ttl - dt
-                      } : acc
-                  )
-                  []
-                  effects
-                effectDamage = foldl
-                  (\acc (Effect kind _) ->
-                    if kind `elem` harmingAfflictions
-                    then acc + 1
-                    else acc
-                  )
-                  0
-                  effects
-            in wizard
-              { wizardEffects = newEffects
-              , wizardHealth  = health - effectDamage
-              }
-          )
-          wizards
-    in sc
-      { scPlayers = newWizards
-      }
-    )
+updateWizards dt = do
+  playersVar <- gets scPlayers
+  players <- liftIO $ STM.atomically $ STM.readTMVar playersVar
+  let newPlayers = map
+        (\player@(Player pId wizard@(Wizard _ _ health _ _ effects)) ->
+          let newEffects = foldl
+                (\acc effect@(Effect _ ttl) ->
+                  if ttl - dt < 0
+                  then acc
+                  else effect
+                    { effectTTL = ttl - dt
+                    } : acc
+                )
+                []
+                effects
+              effectDamage = foldl
+                (\acc (Effect kind _) ->
+                  if kind `elem` harmingAfflictions
+                  then acc + 1
+                  else acc
+                )
+                0
+                effects
+          in player {
+               playerWizard = wizard
+                 { wizardEffects = newEffects
+                 , wizardHealth  = health - effectDamage
+                 }
+             }
+        )
+        players
+  void $ liftIO $ STM.atomically $ STM.swapTMVar playersVar newPlayers

src-server/Server/Types.hs

@@ -54,13 +54,19 @@ data ReaderContainer = ReaderContainer
 
 data StateContainer = StateContainer
   { scSpawners       :: [Spawner]
-  , scPlayers        :: [Wizard]
+  , scPlayers        :: STM.TMVar [Player]
   , scServerState    :: STM.TMVar ServerState
   , scServerLastTick :: UTCTime
   , scClientSockets  :: STM.TMVar [(Maybe UUID, Socket)]
   , scMessageQueue   :: STM.TQueue ClientMessage
   }
 
+data Player = Player
+  { playerId     :: UUID
+  , playerWizard :: Wizard
+  }
+  deriving (Eq, Show)
+
 -- | Data object for storing the server's state
 data ServerState = ServerState
   { serverGameOver :: Bool -- ^ global game over state (only one contestant left)

src-server/Server/Util.hs

@@ -2,10 +2,18 @@ module Server.Util where
 
 import Control.Exception
 
+import qualified Data.Matrix as M
+
+import Linear
+
 import System.Directory
 
 import System.IO.Error
 
+import System.Random
+
+import Library.Types
+
 -- | Remove a file if it exists
 removeIfExists
   :: FilePath -- File to remove
@@ -14,3 +22,28 @@ removeIfExists fileName = removeFile fileName `catch` handleExists
   where handleExists e
           | isDoesNotExistError e = return ()
           | otherwise = throwIO e
+
+newWizard
+  :: Position
+  -> Wizard
+newWizard pos =
+  Wizard
+    { wizardWands   = []
+    , wizardRot     = 0
+    , wizardPos     = pos
+    , wizardMana    = 100
+    , wizardHealth  = 100
+    , wizardEffects = []
+    }
+
+rollInitPosition
+  :: ServerMap
+  -> IO Position
+rollInitPosition arena = do
+  r <- randomRIO (1, M.nrows arena)
+  c <- randomRIO (1, M.ncols arena)
+  if arena M.! (r, c) == Air
+  then
+    pure $ (fromIntegral <$> V2 r c) + V2 0.5 0.5
+  else
+    rollInitPosition arena