wait for AI thread to finish before freeing ressources (to avoid segfaults on game exit)
module ServerCore where
import Network
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Monad
import qualified Data.IntMap as IntMap
import System.Log.Logger
import Control.Monad.Reader
--------------------------------------
import CoreTypes
import NetRoutines
import HWProtoCore
import Actions
import OfficialServer.DBInteraction
import RoomsAndClients
timerLoop :: Int -> Chan CoreMessage -> IO()
timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
reactCmd :: ServerInfo -> ClientIndex -> [String] -> MRnC -> IO ()
reactCmd sInfo ci cmd rnc = do
actions <- withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
forM_ actions (processAction (ci, sInfo, rnc))
mainLoop :: ServerInfo -> MRnC -> IO ()
mainLoop serverInfo rnc = forever $ do
r <- readChan $ coreChan serverInfo
case r of
Accept ci -> do
processAction
(undefined, serverInfo, rnc) (AddClient ci)
return ()
ClientMessage (clID, cmd) -> do
debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
--if clID `IntMap.member` clients then
reactCmd serverInfo clID cmd rnc
return ()
--else
--do
--debugM "Clients" "Message from dead client"
--return (serverInfo, rnc)
ClientAccountInfo (clID, info) -> do
--if clID `IntMap.member` clients then
processAction
(clID, serverInfo, rnc)
(ProcessAccountInfo info)
return ()
--else
--do
--debugM "Clients" "Got info for dead client"
--return (serverInfo, rnc)
TimerAction tick ->
return ()
--liftM snd $
-- foldM processAction (0, serverInfo, rnc) $
-- PingAll : [StatsAction | even tick]
startServer :: ServerInfo -> Socket -> IO ()
startServer serverInfo serverSocket = do
putStrLn $ "Listening on port " ++ show (listenPort serverInfo)
forkIO $
acceptLoop
serverSocket
(coreChan serverInfo)
return ()
forkIO $ timerLoop 0 $ coreChan serverInfo
startDBConnection serverInfo
rnc <- newRoomsAndClients newRoom
forkIO $ mainLoop serverInfo rnc
forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"