--- a/gameServer/CMakeLists.txt Wed Jun 23 21:18:48 2010 +0200
+++ b/gameServer/CMakeLists.txt Wed Jun 23 21:39:14 2010 +0200
@@ -14,13 +14,14 @@
HWProtoInRoomState.hs
HWProtoLobbyState.hs
HWProtoNEState.hs
+ HandlerUtils.hs
NetRoutines.hs
Opts.hs
+ RoomsAndClients.hs
ServerCore.hs
- Utils.hs
- RoomsAndClients.hs
ServerState.hs
Store.hs
+ Utils.hs
hedgewars-server.hs
)
--- a/gameServer/HWProtoInRoomState.hs Wed Jun 23 21:18:48 2010 +0200
+++ b/gameServer/HWProtoInRoomState.hs Wed Jun 23 21:39:14 2010 +0200
@@ -24,21 +24,22 @@
handleCmd_inRoom ["PART"] = return [MoveToLobby "part"]
handleCmd_inRoom ["PART", msg] = return [MoveToLobby $ "part: " `B.append` msg]
-{-
-handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs)
- | null paramStrs = [ProtocolError "Empty config entry"]
- | isMaster client =
- [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}),
- AnswerOthersInRoom ("CFG" : paramName : paramStrs)]
- | otherwise = [ProtocolError "Not room master"]
- where
- client = clients IntMap.! clID
+handleCmd_inRoom ("CFG" : paramName : paramStrs)
+ | null paramStrs = return [ProtocolError "Empty config entry"]
+ | otherwise = do
+ chans <- roomOthersChans
+ cl <- thisClient
+ if isMaster cl then
+ return [
+ ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}),
+ AnswerClients chans ("CFG" : paramName : paramStrs)]
+ else
+ return [ProtocolError "Not room master"]
-handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
- | length hhsInfo == 15 && clientProto client < 30 = handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : " " : flag : difStr : hhsInfo)
- | length hhsInfo /= 16 = [ProtocolError "Corrupted hedgehogs info"]
- | length (teams room) == 6 = [Warning "too many teams"]
+handleCmd_inRoom ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
+ | length hhsInfo /= 16 = return [ProtocolError "Corrupted hedgehogs info"]
+{- | length (teams room) == 6 = [Warning "too many teams"]
| canAddNumber <= 0 = [Warning "too many hedgehogs"]
| isJust findTeam = [Warning "There's already a team with same name in the list"]
| gameinprogress room = [Warning "round in progress"]
@@ -60,7 +61,8 @@
hhsList [] = []
hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
newTeamHHNum = min 4 canAddNumber
-
+-}
+{-
handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName]
| noSuchTeam = [Warning "REMOVE_TEAM: no such team"]
| nick client /= teamowner team = [ProtocolError "Not team owner!"]
@@ -105,16 +107,18 @@
findTeam = find (\t -> teamName == teamname t) $ teams room
client = clients IntMap.! clID
room = rooms IntMap.! (roomID client)
-
+-}
-handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] =
- [ModifyClient (\c -> c{isReady = not $ isReady client}),
- ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}),
- AnswerThisRoom [if isReady client then "NOT_READY" else "READY", nick client]]
- where
- client = clients IntMap.! clID
+handleCmd_inRoom ["TOGGLE_READY"] = do
+ cl <- thisClient
+ chans <- roomClientsChans
+ return [
+ ModifyClient (\c -> c{isReady = not $ isReady cl}),
+ ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}),
+ AnswerClients chans [if isReady cl then "NOT_READY" else "READY", nick cl]
+ ]
-
+{-
handleCmd_inRoom clID clients rooms ["START_GAME"] =
if isMaster client && (playersIn room == readyPlayers room) && (not . gameinprogress) room then
if enoughClans then
--- a/gameServer/HWProtoLobbyState.hs Wed Jun 23 21:18:48 2010 +0200
+++ b/gameServer/HWProtoLobbyState.hs Wed Jun 23 21:39:14 2010 +0200
@@ -78,7 +78,7 @@
handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do
(ci, irnc) <- ask
let ris = allRooms irnc
- let cl = irnc `client` ci
+ cl <- thisClient
let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris
let jRI = fromJust maybeRI
let jRoom = irnc `room` jRI
--- a/gameServer/HWProtoNEState.hs Wed Jun 23 21:18:48 2010 +0200
+++ b/gameServer/HWProtoNEState.hs Wed Jun 23 21:39:14 2010 +0200
@@ -20,8 +20,8 @@
let cl = irnc `client` ci
if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"]
else
- if haveSameNick irnc then return [AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], ByeClient ""]
- else
+ if haveSameNick irnc (nick cl) then return [AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], ByeClient ""]
+ else
if illegalName newNick then return [ByeClient "Illegal nickname"]
else
return $
@@ -29,8 +29,7 @@
AnswerClients [sendChan cl] ["NICK", newNick] :
[CheckRegistered | clientProto cl /= 0]
where
- haveSameNick irnc = False --isJust $ find (\cl -> newNick == nick cl) $ IntMap.elems clients
-
+ haveSameNick irnc clNick = isJust $ find (\cl -> newNick == clNick) $ map (client irnc) $ allClients irnc
handleCmd_NotEntered ["PROTO", protoNum] = do
(ci, irnc) <- ask
--- a/gameServer/HandlerUtils.hs Wed Jun 23 21:18:48 2010 +0200
+++ b/gameServer/HandlerUtils.hs Wed Jun 23 21:39:14 2010 +0200
@@ -19,6 +19,12 @@
roomOthersChans = do
(ci, rnc) <- ask
let ri = clientRoom rnc ci
+ return $ map (sendChan . client rnc) $ filter (/= ci) (roomClients rnc ri)
+
+roomClientsChans :: Reader (ClientIndex, IRnC) [ClientChan]
+roomClientsChans = do
+ (ci, rnc) <- ask
+ let ri = clientRoom rnc ci
return $ map (sendChan . client rnc) (roomClients rnc ri)
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan]