gameServer/HWProtoInRoomState.hs
changeset 6101 5a4ea2c7b9df
parent 6069 d59745e525ec
child 6403 477034740077
equal deleted inserted replaced
5801:531f64292489 6101:5a4ea2c7b9df
    12 import CoreTypes
    12 import CoreTypes
    13 import Actions
    13 import Actions
    14 import Utils
    14 import Utils
    15 import HandlerUtils
    15 import HandlerUtils
    16 import RoomsAndClients
    16 import RoomsAndClients
       
    17 import EngineInteraction
    17 
    18 
    18 handleCmd_inRoom :: CmdHandler
    19 handleCmd_inRoom :: CmdHandler
    19 
    20 
    20 handleCmd_inRoom ["CHAT", msg] = do
    21 handleCmd_inRoom ["CHAT", msg] = do
    21     n <- clientNick
    22     n <- clientNick
    50         rm <- thisRoom
    51         rm <- thisRoom
    51         clNick <- clientNick
    52         clNick <- clientNick
    52         clChan <- thisClientChans
    53         clChan <- thisClientChans
    53         othChans <- roomOthersChans
    54         othChans <- roomOthersChans
    54         return $
    55         return $
    55             if not . null . drop 5 $ teams rm then
    56             if not . null . drop (maxTeams rm - 1) $ teams rm then
    56                 [Warning "too many teams"]
    57                 [Warning "too many teams"]
    57             else if canAddNumber rm <= 0 then
    58             else if canAddNumber rm <= 0 then
    58                 [Warning "too many hedgehogs"]
    59                 [Warning "too many hedgehogs"]
    59             else if isJust $ findTeam rm then
    60             else if isJust $ findTeam rm then
    60                 [Warning "There's already a team with same name in the list"]
    61                 [Warning "There's already a team with same name in the list"]
    61             else if gameinprogress rm then
    62             else if isJust $ gameInfo rm then
    62                 [Warning "round in progress"]
    63                 [Warning "round in progress"]
    63             else if isRestrictedTeams rm then
    64             else if isRestrictedTeams rm then
    64                 [Warning "restricted"]
    65                 [Warning "restricted"]
    65             else
    66             else
    66                 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r]}),
    67                 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r]}),
    76         dif = readInt_ difStr
    77         dif = readInt_ difStr
    77         hhsList [] = []
    78         hhsList [] = []
    78         hhsList [_] = error "Hedgehogs list with odd elements number"
    79         hhsList [_] = error "Hedgehogs list with odd elements number"
    79         hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
    80         hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
    80         newTeamHHNum r = min 4 (canAddNumber r)
    81         newTeamHHNum r = min 4 (canAddNumber r)
       
    82         maxTeams r 
       
    83             | roomProto r < 38 = 6
       
    84             | otherwise = 8
       
    85                 
    81 
    86 
    82 handleCmd_inRoom ["REMOVE_TEAM", tName] = do
    87 handleCmd_inRoom ["REMOVE_TEAM", tName] = do
    83         (ci, _) <- ask
    88         (ci, _) <- ask
    84         r <- thisRoom
    89         r <- thisRoom
    85         clNick <- clientNick
    90         clNick <- clientNick
   160                 else
   165                 else
   161                 ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl]
   166                 ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl]
   162         ]
   167         ]
   163 
   168 
   164 handleCmd_inRoom ["START_GAME"] = do
   169 handleCmd_inRoom ["START_GAME"] = do
       
   170     (ci, rnc) <- ask
   165     cl <- thisClient
   171     cl <- thisClient
   166     rm <- thisRoom
   172     rm <- thisRoom
   167     chans <- roomClientsChans
   173     chans <- roomClientsChans
   168 
   174     
   169     if isMaster cl && playersIn rm == readyPlayers rm && not (gameinprogress rm) then
   175     let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm
       
   176 
       
   177     if isMaster cl && playersIn rm == readyPlayers rm && not (isJust $ gameInfo rm) then
   170         if enoughClans rm then
   178         if enoughClans rm then
   171             return [
   179             return [
   172                 ModifyRoom
   180                 ModifyRoom
   173                     (\r -> r{
   181                     (\r -> r{
   174                         gameinprogress = True,
   182                         gameInfo = Just $ newGameInfo allPlayersRegistered (mapParams rm) (params rm)
   175                         roundMsgs = empty,
   183                         }
   176                         leftTeams = [],
       
   177                         teamsAtStart = teams r}
       
   178                     ),
   184                     ),
   179                 AnswerClients chans ["RUN_GAME"]
   185                 AnswerClients chans ["RUN_GAME"]
   180                 ]
   186                 ]
   181             else
   187             else
   182             return [Warning "Less than two clans!"]
   188             return [Warning "Less than two clans!"]
   189 handleCmd_inRoom ["EM", msg] = do
   195 handleCmd_inRoom ["EM", msg] = do
   190     cl <- thisClient
   196     cl <- thisClient
   191     rm <- thisRoom
   197     rm <- thisRoom
   192     chans <- roomOthersChans
   198     chans <- roomOthersChans
   193 
   199 
   194     if teamsInGame cl > 0 && gameinprogress rm && isLegal then
   200     if teamsInGame cl > 0 && (isJust $ gameInfo rm) && isLegal then
   195         return $ AnswerClients chans ["EM", msg] : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
   201         return $ AnswerClients chans ["EM", msg] : [ModifyRoom (\r -> r{gameInfo = liftM (\g -> g{roundMsgs = roundMsgs g |> msg}) $ gameInfo r}) | not isKeepAlive]
   196         else
   202         else
   197         return []
   203         return []
   198     where
   204     where
   199         (isLegal, isKeepAlive) = checkNetCmd msg
   205         (isLegal, isKeepAlive) = checkNetCmd msg
   200 
   206 
   201 
   207 
   202 handleCmd_inRoom ["ROUNDFINISHED", _] = do
   208 handleCmd_inRoom ["ROUNDFINISHED", correctly] = do
   203     cl <- thisClient
   209     cl <- thisClient
   204     rm <- thisRoom
   210     rm <- thisRoom
   205     chans <- roomClientsChans
   211     chans <- roomClientsChans
   206 
   212 
   207     if isMaster cl && gameinprogress rm then
   213     if isMaster cl && (isJust $ gameInfo rm) then
   208         return $ 
   214         return $
   209             ModifyRoom
   215             SaveReplay
       
   216             : ModifyRoom
   210                 (\r -> r{
   217                 (\r -> r{
   211                     gameinprogress = False,
   218                     gameInfo = Nothing,
   212                     readyPlayers = 0,
   219                     readyPlayers = 0
   213                     roundMsgs = empty,
   220                     }
   214                     leftTeams = [],
       
   215                     teamsAtStart = []}
       
   216                 )
   221                 )
   217             : UnreadyRoomClients
   222             : UnreadyRoomClients
   218             : answerRemovedTeams chans rm
   223             : answerRemovedTeams chans rm
   219         else
   224         else
   220         return []
   225         return []
   221     where
   226     where
   222         answerRemovedTeams chans = map (\t -> AnswerClients chans ["REMOVE_TEAM", t]) . leftTeams
   227         answerRemovedTeams chans = map (\t -> AnswerClients chans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo
       
   228         isCorrect = correctly == "1"
   223 
   229 
   224 -- compatibility with clients with protocol < 38
   230 -- compatibility with clients with protocol < 38
   225 handleCmd_inRoom ["ROUNDFINISHED"] =
   231 handleCmd_inRoom ["ROUNDFINISHED"] =
   226     handleCmd_inRoom ["ROUNDFINISHED", "1"]
   232     handleCmd_inRoom ["ROUNDFINISHED", "1"]
   227 
   233