gameServer/ServerCore.hs
changeset 3742 8461f0cef2e6
parent 3741 73246d25dfe1
child 3947 709fdb89f76c
equal deleted inserted replaced
3740:2e7dda50fddd 3742:8461f0cef2e6
     5 import Control.Concurrent.Chan
     5 import Control.Concurrent.Chan
     6 import Control.Monad
     6 import Control.Monad
     7 import qualified Data.IntMap as IntMap
     7 import qualified Data.IntMap as IntMap
     8 import System.Log.Logger
     8 import System.Log.Logger
     9 import Control.Monad.Reader
     9 import Control.Monad.Reader
    10 import Control.Monad.State
    10 import Control.Monad.State.Strict
    11 import Data.Set as Set
    11 import Data.Set as Set
    12 import qualified Data.ByteString.Char8 as B
    12 import qualified Data.ByteString.Char8 as B
    13 --------------------------------------
    13 --------------------------------------
    14 import CoreTypes
    14 import CoreTypes
    15 import NetRoutines
    15 import NetRoutines
    17 import Actions
    17 import Actions
    18 import OfficialServer.DBInteraction
    18 import OfficialServer.DBInteraction
    19 import ServerState
    19 import ServerState
    20 
    20 
    21 
    21 
    22 timerLoop :: Int -> Chan CoreMessage -> IO()
    22 timerLoop :: Int -> Chan CoreMessage -> IO ()
    23 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
    23 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
    24 
    24 
    25 
    25 
    26 reactCmd :: [B.ByteString] -> StateT ServerState IO ()
    26 reactCmd :: [B.ByteString] -> StateT ServerState IO ()
    27 reactCmd cmd = do
    27 reactCmd cmd = do
    55                 --do
    55                 --do
    56                 --debugM "Clients" "Message from dead client"
    56                 --debugM "Clients" "Message from dead client"
    57                 --return (serverInfo, rnc)
    57                 --return (serverInfo, rnc)
    58 
    58 
    59         ClientAccountInfo (ci, info) -> do
    59         ClientAccountInfo (ci, info) -> do
    60             --should instead check ci exists and has same nick/hostname
    60             rnc <- gets roomsClients
    61             --removed <- gets removedClients
    61             exists <- liftIO $ clientExists rnc ci
    62             --when (not $ ci `Set.member` removed) $ do
    62             when (exists) $ do
    63             --    modify (\as -> as{clientIndex = Just ci})
    63                 modify (\as -> as{clientIndex = Just ci})
    64             --    processAction (ProcessAccountInfo info)
    64                 processAction (ProcessAccountInfo info)
    65             return ()
    65                 return ()
    66             
    66 
    67         TimerAction tick ->
    67         TimerAction tick ->
    68                 mapM_ processAction $
    68                 mapM_ processAction $
    69                     PingAll : [StatsAction | even tick]
    69                     PingAll : [StatsAction | even tick]
    70 
    70 
    71 
    71