--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/HWProtoLobbyState.hs Wed Feb 18 15:04:40 2009 +0000
@@ -0,0 +1,105 @@
+module HWProtoLobbyState where
+
+import qualified Data.Map as Map
+import qualified Data.IntMap as IntMap
+import qualified Data.IntSet as IntSet
+import Maybe
+import Data.List
+--------------------------------------
+import CoreTypes
+import Actions
+import Answers
+import Utils
+
+answerAllTeams teams = concatMap toAnswer teams
+ where
+ toAnswer team =
+ [AnswerThisClient $ teamToNet team,
+ AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team],
+ AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]]
+
+handleCmd_lobby :: CmdHandler
+
+handleCmd_lobby clID clients rooms ["LIST"] =
+ [AnswerThisClient ("ROOMS" : roomsInfoList)]
+ where
+ roomsInfoList = concatMap roomInfo $ sameProtoRooms
+ sameProtoRooms = filter (\r -> (roomProto r == protocol) && (not $ isRestrictedJoins r)) roomsList
+ roomsList = IntMap.elems rooms
+ protocol = clientProto client
+ client = clients IntMap.! clID
+ roomInfo room = [
+ name room,
+ (show $ playersIn room) ++ "(" ++ (show $ length $ teams room) ++ ")",
+ show $ gameinprogress room
+ ]
+
+handleCmd_lobby clID clients _ ["CHAT_STRING", msg] =
+ [AnswerOthersInRoom ["CHAT_STRING", clientNick, msg]]
+ where
+ clientNick = nick $ clients IntMap.! clID
+
+handleCmd_lobby clID clients rooms ["CREATE", newRoom, roomPassword] =
+ if haveSameRoom then
+ [Warning "Room exists"]
+ else
+ [RoomRemoveThisClient, -- leave lobby
+ AddRoom newRoom roomPassword,
+ AnswerThisClient ["NOT_READY", clientNick]
+ ]
+ where
+ clientNick = nick $ clients IntMap.! clID
+ haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms
+
+handleCmd_lobby clID clients rooms ["CREATE", newRoom] =
+ handleCmd_lobby clID clients rooms ["CREATE", newRoom, ""]
+
+handleCmd_lobby clID clients rooms ["JOIN", roomName, roomPassword] =
+ if noSuchRoom then
+ [Warning "No such room"]
+ else if isRestrictedJoins jRoom then
+ [Warning "Joining restricted"]
+ else if roomPassword /= password jRoom then
+ [Warning "Wrong password"]
+ else
+ [RoomRemoveThisClient, -- leave lobby
+ RoomAddThisClient rID] -- join room
+ ++ answerNicks
+ ++ answerReady
+ ++ [AnswerThisRoom ["NOT_READY", nick client]]
+ ++ answerFullConfig jRoom
+ ++ answerTeams
+-- ++ watchRound)
+ where
+ noSuchRoom = isNothing mbRoom
+ mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms
+ jRoom = fromJust mbRoom
+ rID = roomUID jRoom
+ client = clients IntMap.! clID
+ roomClientsIDs = IntSet.elems $ playersIDs jRoom
+ answerNicks = if playersIn jRoom /= 0 then
+ [AnswerThisClient $ ["JOINED"] ++ (map (\clID -> nick $ clients IntMap.! clID) $ roomClientsIDs)]
+ else
+ []
+ answerReady =
+ map (\c -> AnswerThisClient [if isReady c then "READY" else "NOT_READY", nick c]) $
+ map (\clID -> clients IntMap.! clID) roomClientsIDs
+
+ toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
+ answerFullConfig room = map toAnswer (Map.toList $ params room)
+{-
+ watchRound = if (roomProto clRoom < 20) || (not $ gameinprogress clRoom) then
+ []
+ else
+ (answerClientOnly ["RUN_GAME"]) ++
+ answerClientOnly ("GAMEMSG" : toEngineMsg "e$spectate 1" : (toList $ roundMsgs clRoom)) -}
+ answerTeams = if gameinprogress jRoom then
+ answerAllTeams (teamsAtStart jRoom)
+ else
+ answerAllTeams (teams jRoom)
+
+
+handleCmd_lobby client clients rooms ["JOIN", roomName] =
+ handleCmd_lobby client clients rooms ["JOIN", roomName, ""]
+
+handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"]