equal
deleted
inserted
replaced
11 import Data.Time |
11 import Data.Time |
12 import Data.Maybe |
12 import Data.Maybe |
13 import Control.Monad.Reader |
13 import Control.Monad.Reader |
14 import Control.Monad.State.Strict |
14 import Control.Monad.State.Strict |
15 import qualified Data.ByteString.Char8 as B |
15 import qualified Data.ByteString.Char8 as B |
|
16 import Control.DeepSeq |
16 ----------------------------- |
17 ----------------------------- |
17 import CoreTypes |
18 import CoreTypes |
18 import Utils |
19 import Utils |
19 import ClientIO |
20 import ClientIO |
20 import ServerState |
21 import ServerState |
50 | PingAll |
51 | PingAll |
51 | StatsAction |
52 | StatsAction |
52 |
53 |
53 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
54 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
54 |
55 |
|
56 instance NFData Action where |
|
57 rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` () |
|
58 rnf a = a `seq` () |
|
59 |
|
60 instance NFData B.ByteString |
|
61 instance NFData (Chan a) |
55 |
62 |
56 othersChans = do |
63 othersChans = do |
57 cl <- client's id |
64 cl <- client's id |
58 ri <- clientRoomA |
65 ri <- clientRoomA |
59 liftM (map sendChan . filter (/= cl)) $ roomClientsS ri |
66 liftM (map sendChan . filter (/= cl)) $ roomClientsS ri |
60 |
67 |
61 processAction :: Action -> StateT ServerState IO () |
68 processAction :: Action -> StateT ServerState IO () |
62 |
69 |
63 |
70 |
64 processAction (AnswerClients chans msg) = do |
71 processAction (AnswerClients chans msg) = do |
65 liftIO $ map (flip seq ()) chans `seq` map (flip seq ()) msg `seq` mapM_ (flip writeChan msg) chans |
72 liftIO $ mapM_ (flip writeChan msg) chans |
66 |
73 |
67 |
74 |
68 processAction SendServerMessage = do |
75 processAction SendServerMessage = do |
69 chan <- client's sendChan |
76 chan <- client's sendChan |
70 protonum <- client's clientProto |
77 protonum <- client's clientProto |
175 -} |
182 -} |
176 |
183 |
177 processAction (MoveToRoom ri) = do |
184 processAction (MoveToRoom ri) = do |
178 (Just ci) <- gets clientIndex |
185 (Just ci) <- gets clientIndex |
179 rnc <- gets roomsClients |
186 rnc <- gets roomsClients |
|
187 |
180 liftIO $ do |
188 liftIO $ do |
181 modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = False, isMaster = False}) ci |
189 modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = False, isMaster = False}) ci |
182 modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri |
190 modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri |
183 |
191 moveClientToRoom rnc ri ci |
184 liftIO $ moveClientToRoom rnc ri ci |
|
185 |
192 |
186 chans <- liftM (map sendChan) $ roomClientsS ri |
193 chans <- liftM (map sendChan) $ roomClientsS ri |
187 clNick <- client's nick |
194 clNick <- client's nick |
188 |
195 |
189 processAction $ AnswerClients chans ["JOINED", clNick] |
196 processAction $ AnswerClients chans ["JOINED", clNick] |