gameServer/Actions.hs
changeset 3947 709fdb89f76c
parent 3741 73246d25dfe1
child 4242 5e3c5fe2cb14
equal deleted inserted replaced
3946:41e06b74c991 3947:709fdb89f76c
    96 
    96 
    97 processAction (ByeClient msg) = do
    97 processAction (ByeClient msg) = do
    98     (Just ci) <- gets clientIndex
    98     (Just ci) <- gets clientIndex
    99     rnc <- gets roomsClients
    99     rnc <- gets roomsClients
   100     ri <- clientRoomA
   100     ri <- clientRoomA
       
   101 
       
   102     chan <- client's sendChan
       
   103     ready <- client's isReady
       
   104 
   101     when (ri /= lobbyId) $ do
   105     when (ri /= lobbyId) $ do
   102         processAction $ MoveToLobby ("quit: " `B.append` msg)
   106         processAction $ MoveToLobby ("quit: " `B.append` msg)
   103         return ()
   107         liftIO $ modifyRoom rnc (\r -> r{
   104 
       
   105     chan <- client's sendChan
       
   106     ready <- client's isReady
       
   107 
       
   108     liftIO $ do
       
   109         infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
       
   110 
       
   111         --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
       
   112         modifyRoom rnc (\r -> r{
       
   113                         --playersIDs = IntSet.delete ci (playersIDs r)
   108                         --playersIDs = IntSet.delete ci (playersIDs r)
   114                         playersIn = (playersIn r) - 1,
   109                         playersIn = (playersIn r) - 1,
   115                         readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
   110                         readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
   116                         }) ri
   111                         }) ri
       
   112         return ()
       
   113 
       
   114     liftIO $ do
       
   115         infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
       
   116 
       
   117         --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
   117 
   118 
   118     processAction $ AnswerClients [chan] ["BYE", msg]
   119     processAction $ AnswerClients [chan] ["BYE", msg]
   119     modify (\s -> s{removedClients = ci `Set.insert` removedClients s})
   120 
       
   121     s <- get
       
   122     put $! s{removedClients = ci `Set.insert` removedClients s}
   120 
   123 
   121 processAction (DeleteClient ci) = do
   124 processAction (DeleteClient ci) = do
   122     rnc <- gets roomsClients
   125     rnc <- gets roomsClients
   123     liftIO $ removeClient rnc ci
   126     liftIO $ removeClient rnc ci
   124     modify (\s -> s{removedClients = ci `Set.delete` removedClients s})
   127 
       
   128     s <- get
       
   129     put $! s{removedClients = ci `Set.delete` removedClients s}
   125 
   130 
   126 {-
   131 {-
   127     where
   132     where
   128         client = clients ! clID
   133         client = clients ! clID
   129         clientNick = nick client
   134         clientNick = nick client
   254 
   259 
   255     rId <- liftIO $ addRoom rnc room
   260     rId <- liftIO $ addRoom rnc room
   256 
   261 
   257     processAction $ MoveToRoom rId
   262     processAction $ MoveToRoom rId
   258 
   263 
   259     chans <- liftM (map sendChan) $ roomClientsS lobbyId
   264     chans <- liftM (map sendChan) $! roomClientsS lobbyId
   260 
   265 
   261     mapM_ processAction [
   266     mapM_ processAction [
   262         AnswerClients chans ["ROOM", "ADD", roomName]
   267         AnswerClients chans ["ROOM", "ADD", roomName]
   263         , ModifyClient (\cl -> cl{isMaster = True})
   268         , ModifyClient (\cl -> cl{isMaster = True})
   264         ]
   269         ]
   397     rnc <- gets roomsClients
   402     rnc <- gets roomsClients
   398     si <- gets serverInfo
   403     si <- gets serverInfo
   399     liftIO $ do
   404     liftIO $ do
   400         ci <- addClient rnc client
   405         ci <- addClient rnc client
   401         forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci
   406         forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci
   402         forkIO $ clientSendLoop (clientSocket client) (coreChan si) (sendChan client) ci
   407         forkIO $ clientSendLoop (clientSocket client) (sendChan client) ci
   403 
   408 
   404         infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
   409         infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
   405 
   410 
   406     processAction $ AnswerClients [sendChan client] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
   411     processAction $ AnswerClients [sendChan client] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
   407 {-        let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo
   412 {-        let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo