gameServer/Actions.hs
branchserver_refactor
changeset 4622 8bdc879ee6b2
parent 4610 9541b2a76067
child 4904 0eab727d4717
equal deleted inserted replaced
4620:6122a43d3424 4622:8bdc879ee6b2
    34     | Warning B.ByteString
    34     | Warning B.ByteString
    35     | NoticeMessage Notice
    35     | NoticeMessage Notice
    36     | ByeClient B.ByteString
    36     | ByeClient B.ByteString
    37     | KickClient ClientIndex
    37     | KickClient ClientIndex
    38     | KickRoomClient ClientIndex
    38     | KickRoomClient ClientIndex
    39     | BanClient B.ByteString -- nick
    39     | BanClient B.ByteString
       
    40     | ChangeMaster
    40     | RemoveClientTeams ClientIndex
    41     | RemoveClientTeams ClientIndex
    41     | ModifyClient (ClientInfo -> ClientInfo)
    42     | ModifyClient (ClientInfo -> ClientInfo)
    42     | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
    43     | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
    43     | ModifyRoom (RoomInfo -> RoomInfo)
    44     | ModifyRoom (RoomInfo -> RoomInfo)
    44     | ModifyServerInfo (ServerInfo -> ServerInfo)
    45     | ModifyServerInfo (ServerInfo -> ServerInfo)
   177 
   178 
   178 processAction (MoveToLobby msg) = do
   179 processAction (MoveToLobby msg) = do
   179     (Just ci) <- gets clientIndex
   180     (Just ci) <- gets clientIndex
   180     ri <- clientRoomA
   181     ri <- clientRoomA
   181     rnc <- gets roomsClients
   182     rnc <- gets roomsClients
   182     room <- clientRoomA
   183     (gameProgress, playersNum) <- io $ room'sM rnc (\r -> (gameinprogress r, playersIn r)) ri
   183     ready <- client's isReady
   184     ready <- client's isReady
   184     master <- client's isMaster
   185     master <- client's isMaster
   185     client <- client's id
   186 --    client <- client's id
       
   187     clNick <- client's nick
       
   188     chans <- othersChans
   186 
   189 
   187     if master then
   190     if master then
   188         processAction RemoveRoom
   191         if gameProgress && playersNum > 1 then
       
   192             mapM_ processAction [ChangeMaster, AnswerClients chans ["LEFT", clNick, msg], NoticeMessage AdminLeft, RemoveClientTeams ci]
       
   193             else
       
   194             processAction RemoveRoom
   189         else
   195         else
   190         do
       
   191         clNick <- client's nick
       
   192         clChan <- client's sendChan
       
   193         chans <- othersChans
       
   194         mapM_ processAction [AnswerClients chans ["LEFT", clNick, msg], RemoveClientTeams ci]
   196         mapM_ processAction [AnswerClients chans ["LEFT", clNick, msg], RemoveClientTeams ci]
   195 
   197 
   196     io $ do
   198     io $ do
   197             modifyRoom rnc (\r -> r{
   199             modifyRoom rnc (\r -> r{
   198                     playersIn = (playersIn r) - 1,
   200                     playersIn = (playersIn r) - 1,
   199                     readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
   201                     readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
   200                     }) ri
   202                     }) ri
   201             moveClientToLobby rnc ci
   203             moveClientToLobby rnc ci
   202 
   204 
   203 {-
   205 processAction ChangeMaster = do
   204     (_, _, newClients, newRooms) <-
   206     ri <- clientRoomA
   205             if isMaster client then
   207     rnc <- gets roomsClients
   206                 if (gameinprogress room) && (playersIn room > 1) then
   208     newMasterId <- liftM head . io $ roomClientsIndicesM rnc ri
   207                     (changeMaster >>= (\state -> foldM processAction state
   209     newMaster <- io $ client'sM rnc id newMasterId
   208                         [AnswerOthersInRoom ["LEFT", nick client, msg],
   210     let newRoomName = nick newMaster
   209                         AnswerOthersInRoom ["WARNING", "Admin left the room"],
   211     mapM_ processAction [
   210                         RemoveClientTeams clID]))
   212         ModifyRoom (\r -> r{masterID = newMasterId, name = newRoomName}),
   211                 else -- not in game
   213         ModifyClient2 newMasterId (\c -> c{isMaster = True}),
   212                     processAction (clID, serverInfo, rnc) RemoveRoom
   214         AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"]
   213             else -- not master
   215         ]
   214                 foldM
       
   215                     processAction
       
   216                         (clID, serverInfo, rnc)
       
   217                         [AnswerOthersInRoom ["LEFT", nick client, msg],
       
   218                         RemoveClientTeams clID]
       
   219 
       
   220 
       
   221     return (
       
   222         clID,
       
   223         serverInfo,
       
   224         adjust resetClientFlags clID newClients,
       
   225         adjust removeClientFromRoom rID $ adjust insertClientToRoom 0 newRooms
       
   226         )
       
   227     where
       
   228         rID = roomID client
       
   229         client = clients ! clID
       
   230         room = rooms ! rID
       
   231         resetClientFlags cl = cl{roomID = 0, isMaster = False, isReady = False, teamsInGame = undefined}
       
   232         removeClientFromRoom r = r{
       
   233                 playersIDs = otherPlayersSet,
       
   234                 playersIn = (playersIn r) - 1,
       
   235                 readyPlayers = if isReady client then (readyPlayers r) - 1 else readyPlayers r
       
   236                 }
       
   237         insertClientToRoom r = r{playersIDs = IntSet.insert clID (playersIDs r)}
       
   238         changeMaster = do
       
   239             processAction (newMasterId, serverInfo, rnc) $ AnswerThisClient ["ROOM_CONTROL_ACCESS", "1"]
       
   240             return (
       
   241                 clID,
       
   242                 serverInfo,
       
   243                 adjust (\cl -> cl{isMaster = True}) newMasterId clients,
       
   244                 adjust (\r -> r{masterID = newMasterId, name = newRoomName}) rID rooms
       
   245                 )
       
   246         newRoomName = nick newMasterClient
       
   247         otherPlayersSet = IntSet.delete clID (playersIDs room)
       
   248         newMasterId = IntSet.findMin otherPlayersSet
       
   249         newMasterClient = clients ! newMasterId
       
   250 -}
       
   251 
   216 
   252 processAction (AddRoom roomName roomPassword) = do
   217 processAction (AddRoom roomName roomPassword) = do
   253     Just clId <- gets clientIndex
   218     Just clId <- gets clientIndex
   254     rnc <- gets roomsClients
   219     rnc <- gets roomsClients
   255     proto <- io $ client'sM rnc clientProto clId
   220     proto <- io $ client'sM rnc clientProto clId