2 |
2 |
3 import Control.Concurrent.STM |
3 import Control.Concurrent.STM |
4 import Control.Concurrent.Chan |
4 import Control.Concurrent.Chan |
5 import Data.IntMap |
5 import Data.IntMap |
6 import qualified Data.IntSet as IntSet |
6 import qualified Data.IntSet as IntSet |
|
7 import qualified Data.Sequence as Seq |
7 import Monad |
8 import Monad |
8 ----------------------------- |
9 ----------------------------- |
9 import CoreTypes |
10 import CoreTypes |
|
11 import Utils |
10 |
12 |
11 data Action = |
13 data Action = |
12 AnswerThisClient [String] |
14 AnswerThisClient [String] |
13 | AnswerAll [String] |
15 | AnswerAll [String] |
14 | AnswerAllOthers [String] |
16 | AnswerAllOthers [String] |
15 | AnswerThisRoom [String] |
17 | AnswerThisRoom [String] |
16 | AnswerOthersInRoom [String] |
18 | AnswerOthersInRoom [String] |
17 | AnswerLobby [String] |
19 | AnswerLobby [String] |
18 | RoomAddThisClient Int -- roomID |
20 | RoomAddThisClient Int -- roomID |
19 | RoomRemoveThisClient |
21 | RoomRemoveThisClient |
|
22 | RemoveTeam String |
20 | RemoveRoom |
23 | RemoveRoom |
21 | UnreadyRoomClients |
24 | UnreadyRoomClients |
22 | ProtocolError String |
25 | ProtocolError String |
23 | Warning String |
26 | Warning String |
24 | ByeClient String |
27 | ByeClient String |
190 where |
193 where |
191 room = rooms ! rID |
194 room = rooms ! rID |
192 rID = roomID client |
195 rID = roomID client |
193 client = clients ! clID |
196 client = clients ! clID |
194 |
197 |
|
198 |
195 processAction (clID, serverInfo, clients, rooms) (UnreadyRoomClients) = do |
199 processAction (clID, serverInfo, clients, rooms) (UnreadyRoomClients) = do |
196 processAction (clID, serverInfo, clients, rooms) $ AnswerThisRoom ("NOT_READY" : roomPlayers) |
200 processAction (clID, serverInfo, clients, rooms) $ AnswerThisRoom ("NOT_READY" : roomPlayers) |
197 return (clID, |
201 return (clID, |
198 serverInfo, |
202 serverInfo, |
199 Data.IntMap.map (\cl -> if roomID cl == rID then cl{isReady = False} else cl) clients, |
203 Data.IntMap.map (\cl -> if roomID cl == rID then cl{isReady = False} else cl) clients, |
204 client = clients ! clID |
208 client = clients ! clID |
205 roomPlayers = Prelude.map (nick . (clients !)) roomPlayersIDs |
209 roomPlayers = Prelude.map (nick . (clients !)) roomPlayersIDs |
206 roomPlayersIDs = IntSet.elems $ playersIDs room |
210 roomPlayersIDs = IntSet.elems $ playersIDs room |
207 |
211 |
208 |
212 |
|
213 processAction (clID, serverInfo, clients, rooms) (RemoveTeam teamName) = do |
|
214 newRooms <- if not $ gameinprogress room then |
|
215 do |
|
216 processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["REMOVE_TEAM", teamName] |
|
217 return $ |
|
218 adjust (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) rID rooms |
|
219 else |
|
220 do |
|
221 processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["GAMEMSG", rmTeamMsg] |
|
222 return $ |
|
223 adjust (\r -> r{ |
|
224 teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r, |
|
225 leftTeams = teamName : leftTeams r, |
|
226 roundMsgs = roundMsgs r Seq.|> rmTeamMsg |
|
227 }) rID rooms |
|
228 return (clID, serverInfo, clients, newRooms) |
|
229 where |
|
230 room = rooms ! rID |
|
231 rID = roomID client |
|
232 client = clients ! clID |
|
233 rmTeamMsg = toEngineMsg $ 'F' : teamName |
|
234 |
|
235 |
209 processAction (clID, serverInfo, clients, rooms) (Dump) = do |
236 processAction (clID, serverInfo, clients, rooms) (Dump) = do |
210 writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms] |
237 writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms] |
211 return (clID, serverInfo, clients, rooms) |
238 return (clID, serverInfo, clients, rooms) |
212 |
239 |