Dedicated server
" else "Private server
" clientsIn = "" ++ (show $ length nicks) ++ " clients in: " ++ clientslist ++ "
" clientslist = if not $ null nicks then foldr1 (\a b -> a ++ ", " ++ b) nicks else "" nicks = filter (not . null) $ map nick clients - -answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])] -answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])] -answerBadParam = [(clientOnly, ["ERROR", "Bad parameter"])] -answerErrorMsg msg = [(clientOnly, ["ERROR", msg])] -answerQuit msg = [(clientOnly, ["BYE", msg])] -answerAbandoned = [(othersInRoom, ["BYE", "Room abandoned"])] -answerQuitInform nick = [(othersInRoom, ["LEFT", nick])] -answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])] -answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])] -answerNick nick = [(clientOnly, ["NICK", nick])] -answerProtocolKnown = [(clientOnly, ["ERROR", "Protocol number already known"])] -answerBadInput = [(clientOnly, ["ERROR", "Bad input"])] -answerProto protoNum = [(clientOnly, ["PROTO", show protoNum])] -answerRoomsList list = [(clientOnly, ["ROOMS"] ++ list)] -answerRoomExists = [(clientOnly, ["WARNING", "There's already a room with that name"])] -answerJoined nick = [(sameRoom, ["JOINED", nick])] -answerNoRoom = [(clientOnly, ["WARNING", "There's no room with that name"])] -answerWrongPassword = [(clientOnly, ["WARNING", "Wrong password"])] -answerChatString nick msg = [(othersInRoom, ["CHAT_STRING", nick, msg])] -answerConfigParam paramName paramStrs = [(othersInRoom, "CONFIG_PARAM" : paramName : paramStrs)] -answerFullConfig room = map toAnswer (Map.toList $ params room) ++ [(clientOnly, ["MAP", gamemap room])] - where - toAnswer (paramName, paramStrs) = - (clientOnly, "CONFIG_PARAM" : paramName : paramStrs) -answerCantAdd reason = [(clientOnly, ["WARNING", "Cannot add team: " ++ reason])] -answerTeamAccepted team = [(clientOnly, ["TEAM_ACCEPTED", teamname team])] -answerAddTeam team = [(othersInRoom, teamToNet team)] -answerHHNum teamName hhNumber = [(othersInRoom, ["HH_NUM", teamName, show hhNumber])] -answerRemoveTeam teamName = [(othersInRoom, ["REMOVE_TEAM", teamName])] -answerNotOwner = [(clientOnly, ["ERROR", "You do not own this team"])] -answerTeamColor teamName newColor = [(othersInRoom, ["TEAM_COLOR", teamName, newColor])] -answerAllTeams room = concatMap toAnswer (teams room) - where - toAnswer team = - [(clientOnly, teamToNet team), - (clientOnly, ["TEAM_COLOR", teamname team, teamcolor team]), - (clientOnly, ["HH_NUM", teamname team, show $ hhnum team])] -answerMap mapName = [(othersInRoom, ["MAP", mapName])] -answerRunGame = [(sameRoom, ["RUN_GAME"])] -answerCannotCreateRoom = [(clientOnly, ["WARNING", "Cannot create more rooms"])] -answerIsReady nick = [(sameRoom, ["READY", nick])] -answerNotReady nick = [(sameRoom, ["NOT_READY", nick])] -answerTooFewClans = [(clientOnly, ["ERROR", "Too few clans in game"])] -answerRestricted = [(clientOnly, ["WARNING", "Room joining restricted"])] -answerPing = [(allClients, ["PING"])] -answerConnected = [(clientOnly, ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"])] +answerPing = makeAnswer allClients ["PING"] + -- Main state-independent cmd handler handleCmd :: CmdHandler @@ -80,7 +92,7 @@ (noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform $ nick client) ++ answerRemoveClientTeams) where clRoom = roomByName (room client) rooms - answerRemoveClientTeams = map (\tn -> (othersInRoom, ["REMOVE_TEAM", teamname tn])) clientTeams + answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams (clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom msg = if not $ null xs then head xs else "" @@ -169,8 +181,8 @@ (modifyClient client{room = roomName}, modifyRoom clRoom{playersIn = 1 + playersIn clRoom}, answerNicks ++ answerReady ++ (answerJoined $ nick client) ++ (answerNotReady $ nick client) ++ answerFullConfig clRoom ++ answerAllTeams clRoom) where noSuchRoom = isNothing $ find (\room -> roomName == name room && roomProto room == protocol client) rooms - answerNicks = [(clientOnly, ["JOINED"] ++ (map nick $ sameRoomClients))] - answerReady = map (\c -> (clientOnly, [if isReady c then "READY" else "NOT_READY", nick c])) sameRoomClients + answerNicks = answerClientOnly $ ["JOINED"] ++ (map nick $ sameRoomClients) + answerReady = concatMap (\c -> answerClientOnly [if isReady c then "READY" else "NOT_READY", nick c]) sameRoomClients sameRoomClients = filter (\ci -> room ci == roomName) clients clRoom = roomByName roomName rooms @@ -316,10 +328,10 @@ where clRoom = roomByName (room client) rooms sameRoomClients = filter (\ci -> room ci == name clRoom) clients - answerAllNotReady = map (\cl -> (sameRoom, ["NOT_READY", nick cl])) sameRoomClients + answerAllNotReady = concatMap (\cl -> answerSameRoom ["NOT_READY", nick cl]) sameRoomClients handleCmd_inRoom client _ _ ["GAMEMSG", msg] = - (noChangeClients, noChangeRooms, [(othersInRoom, ["GAMEMSG", msg])]) + (noChangeClients, noChangeRooms, answerOthersRoom ["GAMEMSG", msg]) handleCmd_inRoom client clients rooms ["KICK", kickNick] = if isMaster client then diff -r 4eb4fc12cc30 -r 0b1f44751509 netserver/Miscutils.hs --- a/netserver/Miscutils.hs Sun Nov 09 12:35:54 2008 +0000 +++ b/netserver/Miscutils.hs Mon Nov 10 15:50:46 2008 +0000 @@ -60,10 +60,17 @@ } createRoom = (RoomInfo "" "" 0 [] "+rnd+" False 1 0 False False Map.empty) +data ServerInfo = + ServerInfo + { + message :: String + } + type ClientsTransform = [ClientInfo] -> [ClientInfo] type RoomsTransform = [RoomInfo] -> [RoomInfo] type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [Handle] -type CmdHandler = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientsTransform, RoomsTransform, [(HandlesSelector, [String])]) +type Answer = (HandlesSelector, [String]) +type CmdHandler = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientsTransform, RoomsTransform, [Answer]) roomByName :: String -> [RoomInfo] -> RoomInfo