gameServer/Actions.hs
changeset 3531 66c403badff6
parent 3502 ad38c653b7d9
child 3566 772a46ef8288
equal deleted inserted replaced
3530:390e5048d39c 3531:66c403badff6
    21 data Action =
    21 data Action =
    22     AnswerClients [ClientChan] [B.ByteString]
    22     AnswerClients [ClientChan] [B.ByteString]
    23     | SendServerMessage
    23     | SendServerMessage
    24     | SendServerVars
    24     | SendServerVars
    25     | MoveToRoom RoomIndex
    25     | MoveToRoom RoomIndex
    26     | RoomRemoveThisClient B.ByteString
    26     | MoveToLobby B.ByteString
    27     | RemoveTeam B.ByteString
    27     | RemoveTeam B.ByteString
    28     | RemoveRoom
    28     | RemoveRoom
    29     | UnreadyRoomClients
    29     | UnreadyRoomClients
    30     | JoinLobby
    30     | JoinLobby
    31     | ProtocolError B.ByteString
    31     | ProtocolError B.ByteString
    95 processAction (ByeClient msg) = do
    95 processAction (ByeClient msg) = do
    96     (Just ci) <- gets clientIndex
    96     (Just ci) <- gets clientIndex
    97     rnc <- gets roomsClients
    97     rnc <- gets roomsClients
    98     ri <- clientRoomA
    98     ri <- clientRoomA
    99     when (ri /= lobbyId) $ do
    99     when (ri /= lobbyId) $ do
   100         processAction $ RoomRemoveThisClient ("quit: " `B.append` msg)
   100         processAction $ MoveToLobby ("quit: " `B.append` msg)
   101         return ()
   101         return ()
   102 
   102 
   103     chan <- client's sendChan
   103     chan <- client's sendChan
   104 
   104 
   105     liftIO $ do
   105     liftIO $ do
   154 processAction (clID, serverInfo, rnc) (ModifyServerInfo func) =
   154 processAction (clID, serverInfo, rnc) (ModifyServerInfo func) =
   155     return (clID, func serverInfo, rnc)
   155     return (clID, func serverInfo, rnc)
   156 
   156 
   157 -}
   157 -}
   158 
   158 
   159 processAction (MoveToRoom rId) = do
   159 processAction (MoveToRoom ri) = do
   160     (Just ci) <- gets clientIndex
   160     (Just ci) <- gets clientIndex
   161     rnc <- gets roomsClients
   161     rnc <- gets roomsClients
   162     liftIO $ do
   162     liftIO $ do
   163         modifyClient rnc (\cl -> cl{teamsInGame = 0}) ci
   163         modifyClient rnc (\cl -> cl{teamsInGame = 0}) ci
   164         modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) rId
   164         modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri
   165         
   165 
   166     chans <- liftM (map sendChan) $ roomClientsS rId
   166     liftIO $ moveClientToRoom rnc ri ci
   167      liftio movetoroom
   167 
       
   168     chans <- liftM (map sendChan) $ roomClientsS ri
   168     clNick <- client's nick
   169     clNick <- client's nick
   169     
   170     
   170     processAction $ AnswerClients chans ["JOINED", clNick]
   171     processAction $ AnswerClients chans ["JOINED", clNick]
   171 
   172 
   172 {-
   173 processAction (MoveToLobby msg) = do
   173 processAction (clID, serverInfo, rnc) (RoomRemoveThisClient msg) = do
   174     (Just ci) <- gets clientIndex
       
   175     --ri <- clientRoomA
       
   176     rnc <- gets roomsClients
       
   177 
       
   178     liftIO $ moveClientToLobby rnc ci
       
   179 
       
   180 {-
   174     (_, _, newClients, newRooms) <-
   181     (_, _, newClients, newRooms) <-
   175         if roomID client /= 0 then
       
   176             if isMaster client then
   182             if isMaster client then
   177                 if (gameinprogress room) && (playersIn room > 1) then
   183                 if (gameinprogress room) && (playersIn room > 1) then
   178                     (changeMaster >>= (\state -> foldM processAction state
   184                     (changeMaster >>= (\state -> foldM processAction state
   179                         [AnswerOthersInRoom ["LEFT", nick client, msg],
   185                         [AnswerOthersInRoom ["LEFT", nick client, msg],
   180                         AnswerOthersInRoom ["WARNING", "Admin left the room"],
   186                         AnswerOthersInRoom ["WARNING", "Admin left the room"],
   185                 foldM
   191                 foldM
   186                     processAction
   192                     processAction
   187                         (clID, serverInfo, rnc)
   193                         (clID, serverInfo, rnc)
   188                         [AnswerOthersInRoom ["LEFT", nick client, msg],
   194                         [AnswerOthersInRoom ["LEFT", nick client, msg],
   189                         RemoveClientTeams clID]
   195                         RemoveClientTeams clID]
   190         else -- in lobby
   196 
   191             return (clID, serverInfo, rnc)
       
   192 
   197 
   193     return (
   198     return (
   194         clID,
   199         clID,
   195         serverInfo,
   200         serverInfo,
   196         adjust resetClientFlags clID newClients,
   201         adjust resetClientFlags clID newClients,