gameServer/HWProtoLobbyState.hs
changeset 10814 810ac1d21fd0
parent 10734 8fadc4305df0
child 11032 6aa31d7b1fa5
equal deleted inserted replaced
10812:38dc8445d7a7 10814:810ac1d21fd0
   103                 MoveToRoom jRI
   103                 MoveToRoom jRI
   104                 : ModifyClient (\c -> c{isJoinedMidGame = isJust $ gameInfo jRoom, teamsInGame = fromIntegral $ length clTeams})
   104                 : ModifyClient (\c -> c{isJoinedMidGame = isJust $ gameInfo jRoom, teamsInGame = fromIntegral $ length clTeams})
   105                 : AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl]
   105                 : AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl]
   106                 : [(AnswerClients [sendChan cl] $ "JOINED" : nicks) | not $ null nicks]
   106                 : [(AnswerClients [sendChan cl] $ "JOINED" : nicks) | not $ null nicks]
   107             )
   107             )
   108             -- ++ [ModifyRoom (\r -> let (t', g') = moveTeams clTeams . fromJust $ gameInfo r in r{gameInfo = Just g', teams = t'}) | not $ null clTeams]
   108             ++ [ModifyRoom (\r -> let (t', g') = moveTeams clTeams . 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]
   109             ++ [AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+h", nick $ fromJust owner] | isJust owner]
   110             ++ [sendStateFlags cl jRoomClients | not $ null jRoomClients]
   110             ++ [sendStateFlags cl jRoomClients | not $ null jRoomClients]
   111             ++ answerFullConfig cl jRoom
   111             ++ answerFullConfig cl jRoom
   112             ++ answerTeams cl jRoom
   112             ++ answerTeams cl jRoom
   113             ++ watchRound cl jRoom chans
   113             ++ watchRound cl jRoom chans
   115             ++ map (\t -> AnswerClients chans ["EM", toEngineMsg $ 'G' `B.cons` t]) clTeams
   115             ++ map (\t -> AnswerClients chans ["EM", toEngineMsg $ 'G' `B.cons` t]) clTeams
   116 
   116 
   117         where
   117         where
   118         moveTeams :: [B.ByteString] -> GameInfo -> ([TeamInfo], GameInfo)
   118         moveTeams :: [B.ByteString] -> GameInfo -> ([TeamInfo], GameInfo)
   119         moveTeams cts g = (deleteFirstsBy2 (\a b -> teamname a == b) (teamsAtStart g) (leftTeams g \\ cts)
   119         moveTeams cts g = (deleteFirstsBy2 (\a b -> teamname a == b) (teamsAtStart g) (leftTeams g \\ cts)
   120             , g{leftTeams = leftTeams g \\ cts, teamsInGameNumber = teamsInGameNumber g + length cts})
   120             , g{leftTeams = leftTeams g \\ cts, rejoinedTeams = rejoinedTeams g ++ cts, teamsInGameNumber = teamsInGameNumber g + length cts})
   121         sendStateFlags cl clients = AnswerClients [sendChan cl] . concat . intersperse [""] . filter (not . null) . concat $
   121         sendStateFlags cl clients = AnswerClients [sendChan cl] . concat . intersperse [""] . filter (not . null) . concat $
   122                 [f "+r" ready, f "-r" unready, f "+g" ingame, f "-g" inroomlobby]
   122                 [f "+r" ready, f "-r" unready, f "+g" ingame, f "-g" inroomlobby]
   123             where
   123             where
   124             (ready, unready) = partition isReady clients
   124             (ready, unready) = partition isReady clients
   125             (ingame, inroomlobby) = partition isInGame clients
   125             (ingame, inroomlobby) = partition isInGame clients