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
+sendUpdates :: Game ()
-  :: Position
+sendUpdates = do
-  -> Wizard
+  tileMap <- asks rcMap
-newWizard pos =
+  stateContainer <- get
-  Wizard
+  players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers stateContainer)
-    { wizardWands   = []
+  mapM_
-    , wizardRot     = 0
+    (\(player@(Player playerId wizard@(Wizard {..}))) -> do
-    , wizardPos     = pos
+      let V2 wr wc = wizardPos
-    , wizardMana    = 100
+          subCoords = (,) <$> [floor wr - 4 .. floor wr + 4] <*> [floor wc - 4 .. floor wc + 4]
-    , wizardHealth  = 100
+          initViewMatrix = M.fromList 9 9 $ map
-    , wizardEffects = []
+            (\(qr, qc) ->
-    }
+              M.safeGet qr qc tileMap
-
+            )
-rollInitPosition
+            subCoords
-  :: ServerMap
+      liftIO $ print initViewMatrix
-  -> IO Position
+    )
-rollInitPosition arena = do
+    players
-  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

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 =
+updateWizards dt = do
-  modify' (\sc@(StateContainer _ wizards _ _ _ _) ->
+  playersVar <- gets scPlayers
-    let newWizards = map
+  players <- liftIO $ STM.atomically $ STM.readTMVar playersVar
-          (\wizard@(Wizard _ _ health _ _ effects) ->
+  let newPlayers = map
-            let newEffects = foldl
+        (\player@(Player pId wizard@(Wizard _ _ health _ _ effects)) ->
-                  (\acc effect@(Effect _ ttl) ->
+          let newEffects = foldl
-                    if ttl - dt < 0
+                (\acc effect@(Effect _ ttl) ->
-                    then acc
+                  if ttl - dt < 0
-                    else effect
+                  then acc
-                      { effectTTL = ttl - dt
+                  else effect
-                      } : acc
+                    { effectTTL = ttl - dt
-                  )
+                    } : acc
-                  []
+                )
-                  effects
+                []
-                effectDamage = foldl
+                effects
-                  (\acc (Effect kind _) ->
+              effectDamage = foldl
-                    if kind `elem` harmingAfflictions
+                (\acc (Effect kind _) ->
-                    then acc + 1
+                  if kind `elem` harmingAfflictions
-                    else acc
+                  then acc + 1
-                  )
+                  else acc
-                  0
+                )
-                  effects
+                0
-            in wizard
+                effects
-              { wizardEffects = newEffects
+          in player {
-              , wizardHealth  = health - effectDamage
+               playerWizard = wizard
-              }
+                 { wizardEffects = newEffects
-          )
+                 , wizardHealth  = health - effectDamage
-          wizards
+                 }
-    in sc
+             }
-      { scPlayers = newWizards
+        )
-      }
+        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