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 -------------------------------------- |
11 -------------------------------------- |
11 import CoreTypes |
12 import CoreTypes |
12 import NetRoutines |
13 import NetRoutines |
13 import HWProtoCore |
14 import HWProtoCore |
14 import Actions |
15 import Actions |
18 |
19 |
19 timerLoop :: Int -> Chan CoreMessage -> IO() |
20 timerLoop :: Int -> Chan CoreMessage -> IO() |
20 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan |
21 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan |
21 |
22 |
22 |
23 |
23 reactCmd :: ServerInfo -> ClientIndex -> [String] -> MRnC -> IO () |
24 reactCmd :: [String] -> StateT ActionsState IO () |
24 reactCmd sInfo ci cmd rnc = do |
25 reactCmd cmd = do |
25 actions <- withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc)) |
26 (Just ci) <- gets clientIndex |
26 forM_ actions (processAction (ci, sInfo, rnc)) |
27 rnc <- gets roomsClients |
|
28 actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc)) |
|
29 forM_ actions processAction |
27 |
30 |
28 mainLoop :: ServerInfo -> MRnC -> IO () |
31 mainLoop :: StateT ActionsState IO () |
29 mainLoop serverInfo rnc = forever $ do |
32 mainLoop = forever $ do |
30 r <- readChan $ coreChan serverInfo |
33 si <- gets serverInfo |
|
34 r <- liftIO $ readChan $ coreChan si |
31 |
35 |
32 case r of |
36 case r of |
33 Accept ci -> do |
37 Accept ci -> do |
34 processAction |
38 processAction (AddClient ci) |
35 (undefined, serverInfo, rnc) (AddClient ci) |
|
36 return () |
39 return () |
37 |
40 |
38 ClientMessage (clID, cmd) -> do |
41 ClientMessage (ci, cmd) -> do |
39 debugM "Clients" $ (show clID) ++ ": " ++ (show cmd) |
42 liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd) |
|
43 modify (\as -> as{clientIndex = Just ci}) |
40 --if clID `IntMap.member` clients then |
44 --if clID `IntMap.member` clients then |
41 reactCmd serverInfo clID cmd rnc |
45 reactCmd cmd |
42 return () |
46 return () |
43 --else |
47 --else |
44 --do |
48 --do |
45 --debugM "Clients" "Message from dead client" |
49 --debugM "Clients" "Message from dead client" |
46 --return (serverInfo, rnc) |
50 --return (serverInfo, rnc) |
47 |
51 |
48 ClientAccountInfo (clID, info) -> do |
52 ClientAccountInfo (clID, info) -> do |
49 --if clID `IntMap.member` clients then |
53 --if clID `IntMap.member` clients then |
50 processAction |
54 processAction (ProcessAccountInfo info) |
51 (clID, serverInfo, rnc) |
|
52 (ProcessAccountInfo info) |
|
53 return () |
55 return () |
54 --else |
56 --else |
55 --do |
57 --do |
56 --debugM "Clients" "Got info for dead client" |
58 --debugM "Clients" "Got info for dead client" |
57 --return (serverInfo, rnc) |
59 --return (serverInfo, rnc) |