gameServer/HWProtoInRoomState.hs
branchwebgl
changeset 9127 e350500c4edb
parent 8833 c13ebed437cb
parent 9035 e84d42a4311c
child 9521 8054d9d775fd
equal deleted inserted replaced
8860:bde641cf53c8 9127:e350500c4edb
    57             if clientProto cl < 42 then
    57             if clientProto cl < 42 then
    58                 return color
    58                 return color
    59                 else
    59                 else
    60                 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom
    60                 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom
    61         let roomTeams = teams rm
    61         let roomTeams = teams rm
    62         let hhNum = let p = if not $ null roomTeams then hhnum $ head roomTeams else 4 in newTeamHHNum roomTeams p
    62         let hhNum = let p = if not $ null roomTeams then minimum [hhnum $ head roomTeams, canAddNumber roomTeams] else 4 in newTeamHHNum roomTeams p
    63         let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif hhNum (hhsList hhsInfo)
    63         let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif hhNum (hhsList hhsInfo)
    64         return $
    64         return $
    65             if not . null . drop (maxTeams rm - 1) $ roomTeams then
    65             if not . null . drop (maxTeams rm - 1) $ roomTeams then
    66                 [Warning $ loc "too many teams"]
    66                 [Warning $ loc "too many teams"]
    67             else if canAddNumber roomTeams <= 0 then
    67             else if canAddNumber roomTeams <= 0 then
    77                 SendUpdateOnThisRoom,
    77                 SendUpdateOnThisRoom,
    78                 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}),
    78                 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}),
    79                 AnswerClients clChan ["TEAM_ACCEPTED", tName],
    79                 AnswerClients clChan ["TEAM_ACCEPTED", tName],
    80                 AnswerClients othChans $ teamToNet $ newTeam,
    80                 AnswerClients othChans $ teamToNet $ newTeam,
    81                 AnswerClients roomChans ["TEAM_COLOR", tName, teamColor],
    81                 AnswerClients roomChans ["TEAM_COLOR", tName, teamColor],
    82                 ModifyClient $ \c -> c{actionsPending = actionsPending cl
    82                 AnswerClients roomChans ["HH_NUM", tName, showB $ hhnum newTeam]
    83                     ++ [AnswerClients clChan ["HH_NUM", tName, showB $ hhnum newTeam]]
       
    84                     },
       
    85                 AnswerClients [sendChan cl] ["PING"]
       
    86                 ]
    83                 ]
    87         where
    84         where
    88         canAddNumber rt = (48::Int) - (sum $ map hhnum rt)
    85         canAddNumber rt = (48::Int) - (sum $ map hhnum rt)
    89         findTeam = find (\t -> tName == teamname t) . teams
    86         findTeam = find (\t -> tName == teamname t) . teams
    90         dif = readInt_ difStr
    87         dif = readInt_ difStr
   170 
   167 
   171 
   168 
   172 handleCmd_inRoom ["TOGGLE_READY"] = do
   169 handleCmd_inRoom ["TOGGLE_READY"] = do
   173     cl <- thisClient
   170     cl <- thisClient
   174     chans <- roomClientsChans
   171     chans <- roomClientsChans
   175     if isMaster cl then
   172 
   176         return []
   173     return [
   177         else
   174         ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}),
   178         return [
   175         ModifyClient (\c -> c{isReady = not $ isReady cl}),
   179             ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}),
   176         AnswerClients chans $ if clientProto cl < 38 then
   180             ModifyClient (\c -> c{isReady = not $ isReady cl}),
   177                 [if isReady cl then "NOT_READY" else "READY", nick cl]
   181             AnswerClients chans $ if clientProto cl < 38 then
   178                 else
   182                     [if isReady cl then "NOT_READY" else "READY", nick cl]
   179                 ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl]
   183                     else
   180         ]
   184                     ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl]
       
   185             ]
       
   186 
   181 
   187 
   182 
   188 handleCmd_inRoom ["START_GAME"] = do
   183 handleCmd_inRoom ["START_GAME"] = do
   189     (ci, rnc) <- ask
   184     (ci, rnc) <- ask
   190     cl <- thisClient
   185     cl <- thisClient
   351                 KickRoomClient banId
   346                 KickRoomClient banId
   352             ]
   347             ]
   353         else
   348         else
   354         return []
   349         return []
   355 
   350 
       
   351 handleCmd_inRoom ("RND":rs) = do
       
   352     n <- clientNick
       
   353     s <- roomClientsChans
       
   354     return [AnswerClients s ["CHAT", n, B.unwords $ "/rnd" : rs], Random s rs]
   356 
   355 
   357 handleCmd_inRoom ["LIST"] = return [] -- for old clients (<= 0.9.17)
   356 handleCmd_inRoom ["LIST"] = return [] -- for old clients (<= 0.9.17)
   358 
   357 
   359 handleCmd_inRoom (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: in room)"]
   358 handleCmd_inRoom (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: in room)"]
   360 
   359