gameServer/HWProtoLobbyState.hs
branchwebgl
changeset 9950 2759212a27de
parent 9787 0da6ba2f1f93
child 10092 a92a4ba39a79
equal deleted inserted replaced
9521:8054d9d775fd 9950:2759212a27de
    19 
    19 
    20 handleCmd_lobby ["LIST"] = do
    20 handleCmd_lobby ["LIST"] = do
    21     (ci, irnc) <- ask
    21     (ci, irnc) <- ask
    22     let cl = irnc `client` ci
    22     let cl = irnc `client` ci
    23     rooms <- allRoomInfos
    23     rooms <- allRoomInfos
    24     let roomsInfoList = concatMap (\r -> roomInfo (nick $ irnc `client` masterID r) r) . filter (\r -> (roomProto r == clientProto cl))
    24     let roomsInfoList = concatMap (\r -> roomInfo (clientProto cl) (maybeNick . liftM (client irnc) $ masterID r) r) . filter (\r -> (roomProto r == clientProto cl))
    25     return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
    25     return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
    26 
       
    27 
    26 
    28 handleCmd_lobby ["CHAT", msg] = do
    27 handleCmd_lobby ["CHAT", msg] = do
    29     n <- clientNick
    28     n <- clientNick
    30     s <- roomOthersChans
    29     s <- roomOthersChans
    31     return [AnswerClients s ["CHAT", n, msg]]
    30     return [AnswerClients s ["CHAT", n, msg]]
    58     let jRI = fromJust maybeRI
    57     let jRI = fromJust maybeRI
    59     let jRoom = irnc `room` jRI
    58     let jRoom = irnc `room` jRI
    60     let sameProto = clientProto cl == roomProto jRoom
    59     let sameProto = clientProto cl == roomProto jRoom
    61     let jRoomClients = map (client irnc) $ roomClients irnc jRI
    60     let jRoomClients = map (client irnc) $ roomClients irnc jRI
    62     let nicks = map nick jRoomClients
    61     let nicks = map nick jRoomClients
    63     let ownerNick = nick . fromJust $ find isMaster jRoomClients
    62     let owner = find isMaster jRoomClients
    64     let chans = map sendChan (cl : jRoomClients)
    63     let chans = map sendChan (cl : jRoomClients)
    65     let isBanned = host cl `elem` roomBansList jRoom
    64     let isBanned = host cl `elem` roomBansList jRoom
    66     return $
    65     return $
    67         if isNothing maybeRI || not sameProto then
    66         if isNothing maybeRI then
    68             [Warning $ loc "No such room"]
    67             [Warning $ loc "No such room"]
       
    68             else if not sameProto then
       
    69             [Warning $ loc "Room version incompatible to your hedgewars version"]
    69             else if isRestrictedJoins jRoom then
    70             else if isRestrictedJoins jRoom then
    70             [Warning $ loc "Joining restricted"]
    71             [Warning $ loc "Joining restricted"]
    71             else if isRegisteredOnly jRoom && (B.null . webPassword $ cl) then
    72             else if isRegisteredOnly jRoom && (B.null . webPassword $ cl) && not (isAdministrator cl) then
    72             [Warning $ loc "Registered users only"]
    73             [Warning $ loc "Registered users only"]
    73             else if isBanned then
    74             else if isBanned then
    74             [Warning $ loc "You are banned in this room"]
    75             [Warning $ loc "You are banned in this room"]
    75             else if roomPassword /= password jRoom then
    76             else if roomPassword /= password jRoom then
    76             [NoticeMessage WrongPassword]
    77             [NoticeMessage WrongPassword]
    77             else
    78             else
    78             [
    79             (
    79                 MoveToRoom jRI
    80                 MoveToRoom jRI
    80                 , ModifyClient (\c -> c{isJoinedMidGame = isJust $ gameInfo jRoom})
    81                 : ModifyClient (\c -> c{isJoinedMidGame = isJust $ gameInfo jRoom})
    81                 , AnswerClients [sendChan cl] $ "JOINED" : nicks
    82                 : AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl]
    82                 , AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl]
    83                 : [(AnswerClients [sendChan cl] $ "JOINED" : nicks) | not $ null nicks]
    83                 , AnswerClients [sendChan cl] $ ["CLIENT_FLAGS", "+h", ownerNick]
    84             )
    84             ]
    85             ++ [AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+h", nick $ fromJust owner] | isJust owner]
    85             ++ (if clientProto cl < 38 then map (readynessMessage cl) jRoomClients else [sendStateFlags cl jRoomClients])
    86             ++ [sendStateFlags cl jRoomClients | not $ null jRoomClients]
    86             ++ answerFullConfig cl jRoom
    87             ++ answerFullConfig cl jRoom
    87             ++ answerTeams cl jRoom
    88             ++ answerTeams cl jRoom
    88             ++ watchRound cl jRoom chans
    89             ++ watchRound cl jRoom chans
       
    90             ++ [AnswerClients [sendChan cl] ["CHAT", "[greeting]", greeting jRoom] | greeting jRoom /= ""]
    89 
    91 
    90         where
    92         where
    91         readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c]
       
    92         sendStateFlags cl clients = AnswerClients [sendChan cl] . concat . intersperse [""] . filter (not . null) . concat $
    93         sendStateFlags cl clients = AnswerClients [sendChan cl] . concat . intersperse [""] . filter (not . null) . concat $
    93                 [f "+r" ready, f "-r" unready, f "+g" ingame, f "-g" inroomlobby]
    94                 [f "+r" ready, f "-r" unready, f "+g" ingame, f "-g" inroomlobby]
    94             where
    95             where
    95             (ready, unready) = partition isReady clients
    96             (ready, unready) = partition isReady clients
    96             (ingame, inroomlobby) = partition isInGame clients
    97             (ingame, inroomlobby) = partition isInGame clients