This commit is contained in:
Amedeo Molnár 2024-11-29 11:24:07 +01:00
parent ddbdc0a6e5
commit 73adfff54c
8 changed files with 21 additions and 20 deletions

View file

@ -68,7 +68,7 @@ main = do
sock
logLevel
initState = StateContainer (arenaSpawners arena) emptyPLayers serverState now sockList queueList messageQueue
(finalState, finalWrite) <- execRWST
(_finalState, _finalWrite) <- execRWST
(do
terminateGameOnSigint
runGame

View file

@ -63,7 +63,7 @@ terminateGameOnSigint = do
(CatchOnce $ do
logPrintIO curLevel Info "SIGINT caught, terminating…"
disconnectClients curLevel clientList queueList
threadDelay (10 ^ 6)
threadDelay (10 ^ (6 :: Int))
close sock
st <- STM.atomically $ STM.readTMVar serverState
void $ STM.atomically $ STM.swapTMVar serverState $ st
@ -121,13 +121,13 @@ processRequests = do
sockContainer <- STM.newTMVarIO clientSock
receiverThreadId <- liftIO $ do
t <- forkIO $ do
threadDelay $ 10 ^ 6
threadDelay $ 10 ^ (6 :: Int)
forever $ receiveMessage curLevel socketList queueList sockContainer serverQueue
logPrintIO curLevel Verbose "enabled listener thread"
pure t
senderThreadId <- liftIO $ do
t <- forkIO $ do
threadDelay $ 10 ^ 6
threadDelay $ 10 ^ (6 :: Int)
forever $ sendMessageQueue curLevel sockContainer clientQueue
logPrintIO curLevel Verbose "enabled sender thread"
pure t

View file

@ -7,8 +7,6 @@ import qualified Control.Concurrent.STM as STM
import Control.Exception
import Control.Monad.IO.Class
import qualified Data.Aeson as A
import qualified Data.ByteString as B

View file

@ -94,7 +94,7 @@ sendMessageQueue curLevel sockContainer queue = do
sendPings :: Game ()
sendPings = do
now <- liftIO getCurrentTime
maxTimeout <- asks rcClientMaxTimeout
_maxTimeout <- asks rcClientMaxTimeout
framesPerPing <- asks rcFramesPerPing
curLevel <- asks rcLogLevel
fps <- asks rcFPS

View file

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
module Server.Game where
import Control.Concurrent
@ -47,6 +46,6 @@ runGame = do
sendPings
let remainingTime = recip (fromIntegral fps) - delta
when (remainingTime > 0) $
liftIO $ threadDelay $ floor $ remainingTime * 10 ^ 6
liftIO $ threadDelay $ floor (remainingTime * 10 ^ (6 :: Int) :: Float)
)
liftIO $ threadDelay (10 ^ 6)
liftIO $ threadDelay (10 ^ (6 :: Int))

View file

@ -8,6 +8,8 @@ import Control.Monad.Reader
import Control.Monad.State
import Data.List (foldl')
-- internal imports
import Library.Types
@ -40,8 +42,8 @@ updateWizards dt = do
playersVar <- gets scPlayers
players <- liftIO $ STM.atomically $ STM.readTMVar playersVar
let newPlayers = map
(\player@(Player pId wizard@(Wizard _ _ health _ _ effects) readiness lastPong) ->
let newEffects = foldl
(\player@(Player _pId wizard@(Wizard _ _ health _ _ effects) readiness _lastPong) ->
let newEffects = foldl'
(\acc effect@(Effect _ ttl) ->
if ttl - dt < 0
then acc
@ -51,7 +53,7 @@ updateWizards dt = do
)
[]
effects
effectDamage = foldl
effectDamage = foldl'
(\acc (Effect kind _) ->
if kind `elem` harmingAfflictions
then acc + 1

View file

@ -71,13 +71,13 @@ data ReaderContainer = ReaderContainer
deriving (Eq, Show)
data StateContainer = StateContainer
{ scSpawners :: [Spawner]
, scPlayers :: STM.TMVar [Player]
, scServerState :: STM.TMVar ServerState
, scServerLastTick :: UTCTime
, scClientSockets :: STM.TMVar [ClientSocket]
, scClientQueues :: STM.TMVar [ClientQueue]
, scMessageQueue :: STM.TQueue ClientMessage
{ scSpawners :: ![Spawner]
, scPlayers :: !(STM.TMVar [Player])
, scServerState :: !(STM.TMVar ServerState)
, scServerLastTick :: !UTCTime
, scClientSockets :: !(STM.TMVar [ClientSocket])
, scClientQueues :: !(STM.TMVar [ClientQueue])
, scMessageQueue :: !(STM.TQueue ClientMessage)
}
data ClientSocket = ClientSocket

View file

@ -75,6 +75,8 @@ executable wizard-wipeout-server
Server.Map
Server.Types
Server.Util
default-extensions:
StrictData
-- other-extensions:
build-depends: base >=4.17.2.1
, aeson