tidbits
This commit is contained in:
parent
ddbdc0a6e5
commit
73adfff54c
8 changed files with 21 additions and 20 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue