gameServer/Actions.hs
changeset 2403 6c5d504af2ba
parent 2352 7eaf82cf0890
child 2408 41ebdb5f1e6e
equal deleted inserted replaced
2402:edd12b259e7c 2403:6c5d504af2ba
    17 	AnswerThisClient [String]
    17 	AnswerThisClient [String]
    18 	| AnswerAll [String]
    18 	| AnswerAll [String]
    19 	| AnswerAllOthers [String]
    19 	| AnswerAllOthers [String]
    20 	| AnswerThisRoom [String]
    20 	| AnswerThisRoom [String]
    21 	| AnswerOthersInRoom [String]
    21 	| AnswerOthersInRoom [String]
       
    22 	| AnswerSameClan [String]
    22 	| AnswerLobby [String]
    23 	| AnswerLobby [String]
    23 	| SendServerMessage
    24 	| SendServerMessage
    24 	| RoomAddThisClient Int -- roomID
    25 	| RoomAddThisClient Int -- roomID
    25 	| RoomRemoveThisClient String
    26 	| RoomRemoveThisClient String
    26 	| RemoveTeam String
    27 	| RemoveTeam String
    33 	| KickClient Int -- clID
    34 	| KickClient Int -- clID
    34 	| KickRoomClient Int -- clID
    35 	| KickRoomClient Int -- clID
    35 	| BanClient String -- nick
    36 	| BanClient String -- nick
    36 	| RemoveClientTeams Int -- clID
    37 	| RemoveClientTeams Int -- clID
    37 	| ModifyClient (ClientInfo -> ClientInfo)
    38 	| ModifyClient (ClientInfo -> ClientInfo)
       
    39 	| ModifyClient2 Int (ClientInfo -> ClientInfo)
    38 	| ModifyRoom (RoomInfo -> RoomInfo)
    40 	| ModifyRoom (RoomInfo -> RoomInfo)
    39 	| ModifyServerInfo (ServerInfo -> ServerInfo)
    41 	| ModifyServerInfo (ServerInfo -> ServerInfo)
    40 	| AddRoom String String
    42 	| AddRoom String String
    41 	| CheckRegistered
    43 	| CheckRegistered
    42 	| ClearAccountsCache
    44 	| ClearAccountsCache
    62 	mapM_ (\cl -> writeChan (sendChan cl) msg) (elems clients)
    64 	mapM_ (\cl -> writeChan (sendChan cl) msg) (elems clients)
    63 	return (clID, serverInfo, clients, rooms)
    65 	return (clID, serverInfo, clients, rooms)
    64 
    66 
    65 
    67 
    66 processAction (clID, serverInfo, clients, rooms) (AnswerAllOthers msg) = do
    68 processAction (clID, serverInfo, clients, rooms) (AnswerAllOthers msg) = do
    67 	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) $
    69 	mapM_ (\id' -> writeChan (sendChan $ clients ! id') msg) $
    68 		Prelude.filter (\id' -> (id' /= clID) && logonPassed (clients ! id')) (keys clients)
    70 		Prelude.filter (\id' -> (id' /= clID) && logonPassed (clients ! id')) (keys clients)
    69 	return (clID, serverInfo, clients, rooms)
    71 	return (clID, serverInfo, clients, rooms)
    70 
    72 
    71 
    73 
    72 processAction (clID, serverInfo, clients, rooms) (AnswerThisRoom msg) = do
    74 processAction (clID, serverInfo, clients, rooms) (AnswerThisRoom msg) = do
    73 	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) roomClients
    75 	mapM_ (\id' -> writeChan (sendChan $ clients ! id') msg) roomClients
    74 	return (clID, serverInfo, clients, rooms)
    76 	return (clID, serverInfo, clients, rooms)
    75 	where
    77 	where
    76 		roomClients = IntSet.elems $ playersIDs room
    78 		roomClients = IntSet.elems $ playersIDs room
    77 		room = rooms ! rID
    79 		room = rooms ! rID
    78 		rID = roomID client
    80 		rID = roomID client
    79 		client = clients ! clID
    81 		client = clients ! clID
    80 
    82 
    81 
    83 
    82 processAction (clID, serverInfo, clients, rooms) (AnswerOthersInRoom msg) = do
    84 processAction (clID, serverInfo, clients, rooms) (AnswerOthersInRoom msg) = do
    83 	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) $ Prelude.filter (/= clID) roomClients
    85 	mapM_ (\id' -> writeChan (sendChan $ clients ! id') msg) $ Prelude.filter (/= clID) roomClients
    84 	return (clID, serverInfo, clients, rooms)
    86 	return (clID, serverInfo, clients, rooms)
    85 	where
    87 	where
    86 		roomClients = IntSet.elems $ playersIDs room
    88 		roomClients = IntSet.elems $ playersIDs room
    87 		room = rooms ! rID
    89 		room = rooms ! rID
    88 		rID = roomID client
    90 		rID = roomID client
    89 		client = clients ! clID
    91 		client = clients ! clID
    90 
    92 
    91 
    93 
    92 processAction (clID, serverInfo, clients, rooms) (AnswerLobby msg) = do
    94 processAction (clID, serverInfo, clients, rooms) (AnswerLobby msg) = do
    93 	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) roomClients
    95 	mapM_ (\id' -> writeChan (sendChan $ clients ! id') msg) roomClients
    94 	return (clID, serverInfo, clients, rooms)
    96 	return (clID, serverInfo, clients, rooms)
    95 	where
    97 	where
    96 		roomClients = IntSet.elems $ playersIDs room
    98 		roomClients = IntSet.elems $ playersIDs room
    97 		room = rooms ! 0
    99 		room = rooms ! 0
       
   100 
       
   101 
       
   102 processAction (clID, serverInfo, clients, rooms) (AnswerSameClan msg) = do
       
   103 	mapM_ (\cl -> writeChan (sendChan cl) msg) sameClanClients
       
   104 	return (clID, serverInfo, clients, rooms)
       
   105 	where
       
   106 		otherRoomClients = Prelude.map ((!) clients) $ IntSet.elems $ clID `IntSet.delete` (playersIDs room)
       
   107 		sameClanClients = Prelude.filter (\cl -> teamsInGame cl > 0 && clientClan cl == thisClan) otherRoomClients
       
   108 		thisClan = clientClan client
       
   109 		room = rooms ! rID
       
   110 		rID = roomID client
       
   111 		client = clients ! clID
    98 
   112 
    99 
   113 
   100 processAction (clID, serverInfo, clients, rooms) SendServerMessage = do
   114 processAction (clID, serverInfo, clients, rooms) SendServerMessage = do
   101 	writeChan (sendChan $ clients ! clID) ["SERVER_MESSAGE", message serverInfo]
   115 	writeChan (sendChan $ clients ! clID) ["SERVER_MESSAGE", message serverInfo]
   102 	return (clID, serverInfo, clients, rooms)
   116 	return (clID, serverInfo, clients, rooms)
   159 				[]
   173 				[]
   160 
   174 
   161 
   175 
   162 processAction (clID, serverInfo, clients, rooms) (ModifyClient func) =
   176 processAction (clID, serverInfo, clients, rooms) (ModifyClient func) =
   163 	return (clID, serverInfo, adjust func clID clients, rooms)
   177 	return (clID, serverInfo, adjust func clID clients, rooms)
       
   178 
       
   179 
       
   180 processAction (clID, serverInfo, clients, rooms) (ModifyClient2 cl2ID func) =
       
   181 	return (clID, serverInfo, adjust func cl2ID clients, rooms)
   164 
   182 
   165 
   183 
   166 processAction (clID, serverInfo, clients, rooms) (ModifyRoom func) =
   184 processAction (clID, serverInfo, clients, rooms) (ModifyRoom func) =
   167 	return (clID, serverInfo, clients, adjust func rID rooms)
   185 	return (clID, serverInfo, clients, adjust func rID rooms)
   168 	where
   186 	where