first actual game content communication

This commit is contained in:
nek0 2023-12-13 11:06:45 +01:00
parent 989d40b7e4
commit b8214ddbec
5 changed files with 102 additions and 61 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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