gameServer/HWProtoLobbyState.hs
changeset 11056 62cc7f67105f
parent 11055 c1c3f86af19e
child 11463 fe46826de291
equal deleted inserted replaced
11055:c1c3f86af19e 11056:62cc7f67105f
    80     let owner = find isMaster jRoomClients
    80     let owner = find isMaster jRoomClients
    81     let chans = map sendChan (cl : jRoomClients)
    81     let chans = map sendChan (cl : jRoomClients)
    82     let isBanned = host cl `elem` roomBansList jRoom
    82     let isBanned = host cl `elem` roomBansList jRoom
    83     let clTeams =
    83     let clTeams =
    84             if (clientProto cl >= 48) && (isJust $ gameInfo jRoom) then
    84             if (clientProto cl >= 48) && (isJust $ gameInfo jRoom) then
    85                 map teamname . filter (\t -> teamowner t == nick cl) . teamsAtStart . fromJust $ gameInfo jRoom 
    85                 filter (\t -> teamowner t == nick cl) . teamsAtStart . fromJust $ gameInfo jRoom 
    86                 else
    86                 else
    87                 []
    87                 []
       
    88     let clTeamsNames = map teamname clTeams
    88     return $
    89     return $
    89         if isNothing maybeRI then
    90         if isNothing maybeRI then
    90             [Warning $ loc "No such room"]
    91             [Warning $ loc "No such room"]
    91             else if (not sameProto) && (not $ isAdministrator cl) then
    92             else if (not sameProto) && (not $ isAdministrator cl) then
    92             [Warning $ loc "Room version incompatible to your hedgewars version"]
    93             [Warning $ loc "Room version incompatible to your hedgewars version"]
    99             else if roomPassword /= password jRoom then
   100             else if roomPassword /= password jRoom then
   100             [NoticeMessage WrongPassword]
   101             [NoticeMessage WrongPassword]
   101             else
   102             else
   102             (
   103             (
   103                 MoveToRoom jRI
   104                 MoveToRoom jRI
   104                 : ModifyClient (\c -> c{isJoinedMidGame = isJust $ gameInfo jRoom, teamsInGame = fromIntegral $ length clTeams})
   105                 : ModifyClient (\c -> c{isJoinedMidGame = isJust $ gameInfo jRoom
       
   106                                         , teamsInGame = fromIntegral $ length clTeams
       
   107                                         , clientClan = teamcolor `fmap` listToMaybe clTeams})
   105                 : AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl]
   108                 : AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl]
   106                 : [(AnswerClients [sendChan cl] $ "JOINED" : nicks) | not $ null nicks]
   109                 : [(AnswerClients [sendChan cl] $ "JOINED" : nicks) | not $ null nicks]
   107             )
   110             )
   108             ++ [ModifyRoom (\r -> let (t', g') = moveTeams clTeams . fromJust $ gameInfo r in r{gameInfo = Just g', teams = t'}) | not $ null clTeams]
   111             ++ [ModifyRoom (\r -> let (t', g') = moveTeams clTeamsNames . fromJust $ gameInfo r in r{gameInfo = Just g', teams = t'}) | not $ null clTeams]
   109             ++ [AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+h", nick $ fromJust owner] | isJust owner]
   112             ++ [AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+h", nick $ fromJust owner] | isJust owner]
   110             ++ [sendStateFlags cl jRoomClients | not $ null jRoomClients]
   113             ++ [sendStateFlags cl jRoomClients | not $ null jRoomClients]
   111             ++ answerFullConfig cl jRoom
   114             ++ answerFullConfig cl jRoom
   112             ++ answerTeams cl jRoom
   115             ++ answerTeams cl jRoom
   113             ++ watchRound cl jRoom chans
   116             ++ watchRound cl jRoom chans
   114             ++ [AnswerClients [sendChan cl] ["CHAT", "[greeting]", greeting jRoom] | greeting jRoom /= ""]
   117             ++ [AnswerClients [sendChan cl] ["CHAT", "[greeting]", greeting jRoom] | greeting jRoom /= ""]
   115             ++ map (\t -> AnswerClients chans ["EM", toEngineMsg $ 'G' `B.cons` t]) clTeams
   118             ++ map (\t -> AnswerClients chans ["EM", toEngineMsg $ 'G' `B.cons` t]) clTeamsNames
   116             ++ [AnswerClients [sendChan cl] ["EM", toEngineMsg "I"] | isPaused `fmap` gameInfo jRoom == Just True]
   119             ++ [AnswerClients [sendChan cl] ["EM", toEngineMsg "I"] | isPaused `fmap` gameInfo jRoom == Just True]
   117 
   120 
   118         where
   121         where
   119         moveTeams :: [B.ByteString] -> GameInfo -> ([TeamInfo], GameInfo)
   122         moveTeams :: [B.ByteString] -> GameInfo -> ([TeamInfo], GameInfo)
   120         moveTeams cts g = (deleteFirstsBy2 (\a b -> teamname a == b) (teamsAtStart g) (leftTeams g \\ cts)
   123         moveTeams cts g = (deleteFirstsBy2 (\a b -> teamname a == b) (teamsAtStart g) (leftTeams g \\ cts)