From b8214ddbec01a73b4ee8d2dd08e1ae53f802240b Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 13 Dec 2023 11:06:45 +0100 Subject: [PATCH] first actual game content communication --- src-server/Main.hs | 3 +- src-server/Server/Communication.hs | 54 ++++++++++++------------- src-server/Server/Game.hs | 65 +++++++++++++++--------------- src-server/Server/Types.hs | 8 +++- src-server/Server/Util.hs | 33 +++++++++++++++ 5 files changed, 102 insertions(+), 61 deletions(-) diff --git a/src-server/Main.hs b/src-server/Main.hs index f565498..5aeccce 100644 --- a/src-server/Main.hs +++ b/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 diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs index 19da889..c9df2cf 100644 --- a/src-server/Server/Communication.hs +++ b/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 diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs index 3587a7f..332b3f0 100644 --- a/src-server/Server/Game.hs +++ b/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 diff --git a/src-server/Server/Types.hs b/src-server/Server/Types.hs index a81dd71..fa79bf0 100644 --- a/src-server/Server/Types.hs +++ b/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) diff --git a/src-server/Server/Util.hs b/src-server/Server/Util.hs index 8442ed9..cfbd31a 100644 --- a/src-server/Server/Util.hs +++ b/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