gameServer/Actions.hs
changeset 6758 26bf919aeb57
parent 6756 344d32bb1328
child 6805 097289be7200
equal deleted inserted replaced
6757:ed9b3a567a3d 6758:26bf919aeb57
    36     | MoveToRoom RoomIndex
    36     | MoveToRoom RoomIndex
    37     | MoveToLobby B.ByteString
    37     | MoveToLobby B.ByteString
    38     | RemoveTeam B.ByteString
    38     | RemoveTeam B.ByteString
    39     | SendTeamRemovalMessage B.ByteString
    39     | SendTeamRemovalMessage B.ByteString
    40     | RemoveRoom
    40     | RemoveRoom
       
    41     | FinishGame
    41     | UnreadyRoomClients
    42     | UnreadyRoomClients
    42     | JoinLobby
    43     | JoinLobby
    43     | ProtocolError B.ByteString
    44     | ProtocolError B.ByteString
    44     | Warning B.ByteString
    45     | Warning B.ByteString
    45     | NoticeMessage Notice
    46     | NoticeMessage Notice
   248     proto <- client's clientProto
   249     proto <- client's clientProto
   249     newRoom <- io $ room'sM rnc id ri
   250     newRoom <- io $ room'sM rnc id ri
   250     chans <- liftM (map sendChan) $! sameProtoClientsS proto
   251     chans <- liftM (map sendChan) $! sameProtoClientsS proto
   251     processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo (nick newMaster) newRoom)
   252     processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo (nick newMaster) newRoom)
   252 
   253 
       
   254     
   253 processAction (AddRoom roomName roomPassword) = do
   255 processAction (AddRoom roomName roomPassword) = do
   254     Just clId <- gets clientIndex
   256     Just clId <- gets clientIndex
   255     rnc <- gets roomsClients
   257     rnc <- gets roomsClients
   256     proto <- client's clientProto
   258     proto <- client's clientProto
   257     n <- client's nick
   259     n <- client's nick
   290         ]
   292         ]
   291 
   293 
   292     io $ removeRoom rnc ri
   294     io $ removeRoom rnc ri
   293 
   295 
   294 
   296 
   295 processAction (UnreadyRoomClients) = do
   297 processAction UnreadyRoomClients = do
   296     rnc <- gets roomsClients
   298     rnc <- gets roomsClients
   297     ri <- clientRoomA
   299     ri <- clientRoomA
   298     roomPlayers <- roomClientsS ri
   300     roomPlayers <- roomClientsS ri
   299     roomClIDs <- io $ roomClientsIndicesM rnc ri
   301     roomClIDs <- io $ roomClientsIndicesM rnc ri
   300     pr <- client's clientProto
   302     pr <- client's clientProto
   302     io $ mapM_ (modifyClient rnc (\cl -> cl{isReady = False})) roomClIDs
   304     io $ mapM_ (modifyClient rnc (\cl -> cl{isReady = False})) roomClIDs
   303     processAction $ ModifyRoom (\r -> r{readyPlayers = 0})
   305     processAction $ ModifyRoom (\r -> r{readyPlayers = 0})
   304     where
   306     where
   305         notReadyMessage p nicks = if p < 38 then "NOT_READY" : nicks else "CLIENT_FLAGS" : "-r" : nicks
   307         notReadyMessage p nicks = if p < 38 then "NOT_READY" : nicks else "CLIENT_FLAGS" : "-r" : nicks
   306 
   308 
   307 
   309         
       
   310 processAction FinishGame = do
       
   311     rnc <- gets roomsClients
       
   312     ri <- clientRoomA
       
   313     thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
       
   314     clNick <- client's nick
       
   315     answerRemovedTeams <- io $ 
       
   316          room'sM rnc (map (\t -> AnswerClients thisRoomChans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo) ri
       
   317     
       
   318     mapM_ processAction $ SaveReplay
       
   319         : ModifyRoom
       
   320             (\r -> r{
       
   321                 gameInfo = Nothing,
       
   322                 readyPlayers = 0
       
   323                 }
       
   324             )
       
   325         : UnreadyRoomClients
       
   326         : answerRemovedTeams
       
   327 
       
   328         
   308 processAction (SendTeamRemovalMessage teamName) = do
   329 processAction (SendTeamRemovalMessage teamName) = do
   309     chans <- othersChans
   330     chans <- othersChans
   310     mapM_ processAction [
   331     mapM_ processAction [
   311         AnswerClients chans ["EM", rmTeamMsg],
   332         AnswerClients chans ["EM", rmTeamMsg],
   312         ModifyRoom (\r -> r{
   333         ModifyRoom (\r -> r{
   314                 teamsInGameNumber = teamsInGameNumber g - 1,
   335                 teamsInGameNumber = teamsInGameNumber g - 1,
   315                 roundMsgs = roundMsgs g Seq.|> rmTeamMsg
   336                 roundMsgs = roundMsgs g Seq.|> rmTeamMsg
   316                 }) $ gameInfo r
   337                 }) $ gameInfo r
   317             })
   338             })
   318         ]
   339         ]
       
   340         
       
   341     rnc <- gets roomsClients
       
   342     ri <- clientRoomA
       
   343     gi <- io $ room'sM rnc gameInfo ri
       
   344     when (isJust gi && 0 == teamsInGameNumber (fromJust gi)) $
       
   345         processAction FinishGame        
   319     where
   346     where
   320         rmTeamMsg = toEngineMsg $ 'F' `B.cons` teamName
   347         rmTeamMsg = toEngineMsg $ 'F' `B.cons` teamName
   321     
   348     
   322     
   349     
   323 processAction (RemoveTeam teamName) = do
   350 processAction (RemoveTeam teamName) = do