gameServer/HWProtoLobbyState.hs
changeset 6101 5a4ea2c7b9df
parent 6068 e18713ecf1e0
child 6191 190a8e5d9956
equal deleted inserted replaced
5801:531f64292489 6101:5a4ea2c7b9df
    10 import CoreTypes
    10 import CoreTypes
    11 import Actions
    11 import Actions
    12 import Utils
    12 import Utils
    13 import HandlerUtils
    13 import HandlerUtils
    14 import RoomsAndClients
    14 import RoomsAndClients
       
    15 import EngineInteraction
    15 
    16 
    16 
    17 
    17 answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
    18 answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
    18 answerAllTeams cl = concatMap toAnswer
    19 answerAllTeams cl = concatMap toAnswer
    19     where
    20     where
    32     rooms <- allRoomInfos
    33     rooms <- allRoomInfos
    33     let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r))
    34     let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r))
    34     return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
    35     return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
    35     where
    36     where
    36         roomInfo irnc r = [
    37         roomInfo irnc r = [
    37                 showB $ gameinprogress r,
    38                 showB $ isJust $ gameInfo r,
    38                 name r,
    39                 name r,
    39                 showB $ playersIn r,
    40                 showB $ playersIn r,
    40                 showB $ length $ teams r,
    41                 showB $ length $ teams r,
    41                 nick $ irnc `client` masterID r,
    42                 nick $ irnc `client` masterID r,
    42                 Map.findWithDefault "+rnd+" "MAP" (mapParams r),
    43                 Map.findWithDefault "+rnd+" "MAP" (mapParams r),
    73     let ris = allRooms irnc
    74     let ris = allRooms irnc
    74     cl <- thisClient
    75     cl <- thisClient
    75     let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris
    76     let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris
    76     let jRI = fromJust maybeRI
    77     let jRI = fromJust maybeRI
    77     let jRoom = irnc `room` jRI
    78     let jRoom = irnc `room` jRI
       
    79     let sameProto = clientProto cl == roomProto jRoom
    78     let jRoomClients = map (client irnc) $ roomClients irnc jRI
    80     let jRoomClients = map (client irnc) $ roomClients irnc jRI
    79     let nicks = map nick jRoomClients
    81     let nicks = map nick jRoomClients
    80     let chans = map sendChan (cl : jRoomClients)
    82     let chans = map sendChan (cl : jRoomClients)
    81     return $
    83     return $
    82         if isNothing maybeRI then 
    84         if isNothing maybeRI || not sameProto then 
    83             [Warning "No such rooms"]
    85             [Warning "No such rooms"]
    84             else if isRestrictedJoins jRoom then
    86             else if isRestrictedJoins jRoom then
    85             [Warning "Joining restricted"]
    87             [Warning "Joining restricted"]
    86             else if roomPassword /= password jRoom then
    88             else if roomPassword /= password jRoom then
    87             [Warning "Wrong password"]
    89             [Warning "Wrong password"]
   114             | otherwise = map (toAnswer cl) $
   116             | otherwise = map (toAnswer cl) $
   115                  ("FULLMAPCONFIG", Map.elems mpr)
   117                  ("FULLMAPCONFIG", Map.elems mpr)
   116                  : ("SCHEME", pr Map.! "SCHEME")
   118                  : ("SCHEME", pr Map.! "SCHEME")
   117                  : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr)
   119                  : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr)
   118 
   120 
   119         answerTeams cl jRoom = let f = if gameinprogress jRoom then teamsAtStart else teams in answerAllTeams cl $ f jRoom
   121         answerTeams cl jRoom = let f = if isJust $ gameInfo jRoom then teamsAtStart . fromJust . gameInfo else teams in answerAllTeams cl $ f jRoom
   120 
   122 
   121         watchRound cl jRoom = if not $ gameinprogress jRoom then
   123         watchRound cl jRoom = if isNothing $ gameInfo jRoom then
   122                     []
   124                     []
   123                 else
   125                 else
   124                     [AnswerClients [sendChan cl]  ["RUN_GAME"],
   126                     [AnswerClients [sendChan cl]  ["RUN_GAME"],
   125                     AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
   127                     AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs . fromJust . gameInfo $ jRoom)]
   126 
   128 
   127 
   129 
   128 handleCmd_lobby ["JOIN_ROOM", roomName] =
   130 handleCmd_lobby ["JOIN_ROOM", roomName] =
   129     handleCmd_lobby ["JOIN_ROOM", roomName, ""]
   131     handleCmd_lobby ["JOIN_ROOM", roomName, ""]
   130 
   132 
   133     (_, rnc) <- ask
   135     (_, rnc) <- ask
   134     ci <- clientByNick asknick
   136     ci <- clientByNick asknick
   135     cl <- thisClient
   137     cl <- thisClient
   136     let ri = clientRoom rnc $ fromJust ci
   138     let ri = clientRoom rnc $ fromJust ci
   137     let clRoom = room rnc ri
   139     let clRoom = room rnc ri
   138     if isNothing ci || ri == lobbyId || clientProto cl /= roomProto clRoom then
   140     if isNothing ci || ri == lobbyId then
   139         return []
   141         return []
   140         else
   142         else
   141         handleCmd_lobby ["JOIN_ROOM", name clRoom]
   143         handleCmd_lobby ["JOIN_ROOM", name clRoom]
   142 
   144 
   143     ---------------------------
   145     ---------------------------