Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
--- a/gameServer/Actions.hs Thu Dec 29 09:40:16 2011 +0100
+++ b/gameServer/Actions.hs Thu Dec 29 23:02:40 2011 +0300
@@ -243,10 +243,16 @@
AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"]
]
+ proto <- client's clientProto
+ newRoom <- io $ room'sM rnc id ri
+ chans <- liftM (map sendChan) $! sameProtoClientsS proto
+ processAction $ AnswerClients chans ("ROOM" : "ADD" : roomInfo (nick newMaster) newRoom)
+
processAction (AddRoom roomName roomPassword) = do
Just clId <- gets clientIndex
rnc <- gets roomsClients
- proto <- io $ client'sM rnc clientProto clId
+ proto <- client's clientProto
+ n <- client's nick
let rm = newRoom{
masterID = clId,
@@ -259,10 +265,10 @@
processAction $ MoveToRoom rId
- chans <- liftM (map sendChan) $! roomClientsS lobbyId
+ chans <- liftM (map sendChan) $! sameProtoClientsS proto
mapM_ processAction [
- AnswerClients chans ["ROOM", "ADD", roomName]
+ AnswerClients chans ("ROOM" : "ADD" : roomInfo n rm)
, ModifyClient (\cl -> cl{isMaster = True})
]
@@ -273,10 +279,11 @@
ri <- io $ clientRoomM rnc clId
roomName <- io $ room'sM rnc name ri
others <- othersChans
- lobbyChans <- liftM (map sendChan) $! roomClientsS lobbyId
+ proto <- client's clientProto
+ chans <- liftM (map sendChan) $! sameProtoClientsS proto
mapM_ processAction [
- AnswerClients lobbyChans ["ROOM", "DEL", roomName],
+ AnswerClients chans ["ROOM", "DEL", roomName],
AnswerClients others ["ROOMABANDONED", roomName]
]
--- a/gameServer/HWProtoInRoomState.hs Thu Dec 29 09:40:16 2011 +0100
+++ b/gameServer/HWProtoInRoomState.hs Thu Dec 29 23:02:40 2011 +0300
@@ -252,6 +252,8 @@
handleCmd_inRoom ["ROOM_NAME", newName] = do
cl <- thisClient
rs <- allRoomInfos
+ rm <- thisRoom
+ chans <- sameProtoChans
return $
if not $ isMaster cl then
@@ -260,7 +262,10 @@
if isJust $ find (\r -> newName == name r) rs then
[Warning "Room with such name already exists"]
else
- [ModifyRoom (\r -> r{name = newName})]
+ [ModifyRoom roomUpdate,
+ AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo (nick cl) (roomUpdate rm))]
+ where
+ roomUpdate r = r{name = newName}
handleCmd_inRoom ["KICK", kickNick] = do
--- a/gameServer/HWProtoLobbyState.hs Thu Dec 29 09:40:16 2011 +0100
+++ b/gameServer/HWProtoLobbyState.hs Thu Dec 29 23:02:40 2011 +0300
@@ -24,6 +24,7 @@
AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]]
+
handleCmd_lobby :: CmdHandler
@@ -31,19 +32,8 @@
(ci, irnc) <- ask
let cl = irnc `client` ci
rooms <- allRoomInfos
- let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r))
+ let roomsInfoList = concatMap (\r -> roomInfo (nick $ irnc `client` masterID r) r) . filter (\r -> (roomProto r == clientProto cl))
return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
- where
- roomInfo irnc r = [
- showB $ isJust $ gameInfo r,
- name r,
- showB $ playersIn r,
- showB $ length $ teams r,
- nick $ irnc `client` masterID r,
- Map.findWithDefault "+rnd+" "MAP" (mapParams r),
- head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
- head (Map.findWithDefault ["Default"] "AMMO" (params r))
- ]
handleCmd_lobby ["CHAT", msg] = do
--- a/gameServer/HandlerUtils.hs Thu Dec 29 09:40:16 2011 +0100
+++ b/gameServer/HandlerUtils.hs Thu Dec 29 23:02:40 2011 +0300
@@ -48,6 +48,12 @@
(ci, rnc) <- ask
return [sendChan (rnc `client` ci)]
+sameProtoChans :: Reader (ClientIndex, IRnC) [ClientChan]
+sameProtoChans = do
+ (ci, rnc) <- ask
+ let p = clientProto (rnc `client` ci)
+ return . map sendChan . filter (\c -> clientProto c == p) . map (client rnc) $ allClients rnc
+
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans
--- a/gameServer/ServerState.hs Thu Dec 29 09:40:16 2011 +0100
+++ b/gameServer/ServerState.hs Thu Dec 29 23:02:40 2011 +0300
@@ -6,11 +6,13 @@
client's,
allClientsS,
roomClientsS,
+ sameProtoClientsS,
io
) where
import Control.Monad.State.Strict
-import Data.Set as Set
+import Data.Set as Set(Set)
+import Data.Word
----------------------
import RoomsAndClients
import CoreTypes
@@ -43,5 +45,10 @@
rnc <- gets roomsClients
io $ roomClientsM rnc ri
+sameProtoClientsS :: Word16 -> StateT ServerState IO [ClientInfo]
+sameProtoClientsS p = liftM f allClientsS
+ where
+ f = filter (\c -> clientProto c == p)
+
io :: IO a -> StateT ServerState IO a
io = liftIO
--- a/gameServer/Utils.hs Thu Dec 29 09:40:16 2011 +0100
+++ b/gameServer/Utils.hs Thu Dec 29 23:02:40 2011 +0300
@@ -17,6 +17,7 @@
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString as BW
+import Data.Maybe
-------------------------------------------------
import CoreTypes
@@ -121,3 +122,16 @@
caseInsensitiveCompare a b = f a == f b
where
f = map Char.toUpper . UTF8.toString
+
+roomInfo n r
+ | isRestrictedJoins r = []
+ | otherwise = [
+ showB $ isJust $ gameInfo r,
+ name r,
+ showB $ playersIn r,
+ showB $ length $ teams r,
+ n,
+ Map.findWithDefault "+rnd+" "MAP" (mapParams r),
+ head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
+ head (Map.findWithDefault ["Default"] "AMMO" (params r))
+ ]