gameServer/Actions.hs
changeset 3645 c0b3f1bb9316
parent 3568 ae89cf0735dc
child 3653 c0d94fedbd86
equal deleted inserted replaced
3644:42c5684289ae 3645:c0b3f1bb9316
   179 
   179 
   180     liftIO $ moveClientToRoom rnc ri ci
   180     liftIO $ moveClientToRoom rnc ri ci
   181 
   181 
   182     chans <- liftM (map sendChan) $ roomClientsS ri
   182     chans <- liftM (map sendChan) $ roomClientsS ri
   183     clNick <- client's nick
   183     clNick <- client's nick
   184     
   184 
   185     processAction $ AnswerClients chans ["JOINED", clNick]
   185     processAction $ AnswerClients chans ["JOINED", clNick]
   186 
   186 
   187 processAction (MoveToLobby msg) = do
   187 processAction (MoveToLobby msg) = do
   188     (Just ci) <- gets clientIndex
   188     (Just ci) <- gets clientIndex
   189     --ri <- clientRoomA
   189     --ri <- clientRoomA
   242 
   242 
   243 processAction (AddRoom roomName roomPassword) = do
   243 processAction (AddRoom roomName roomPassword) = do
   244     Just clId <- gets clientIndex
   244     Just clId <- gets clientIndex
   245     rnc <- gets roomsClients
   245     rnc <- gets roomsClients
   246     proto <- liftIO $ client'sM rnc clientProto clId
   246     proto <- liftIO $ client'sM rnc clientProto clId
   247     
   247 
   248     let room = newRoom{
   248     let room = newRoom{
   249             masterID = clId,
   249             masterID = clId,
   250             name = roomName,
   250             name = roomName,
   251             password = roomPassword,
   251             password = roomPassword,
   252             roomProto = proto
   252             roomProto = proto
   253             }
   253             }
   254             
   254 
   255     rId <- liftIO $ addRoom rnc room      
   255     rId <- liftIO $ addRoom rnc room
   256     
   256 
       
   257     processAction $ MoveToRoom rId
       
   258 
   257     chans <- liftM (map sendChan) $ roomClientsS lobbyId
   259     chans <- liftM (map sendChan) $ roomClientsS lobbyId
   258 
   260 
   259     mapM_ processAction [
   261     mapM_ processAction [
   260         AnswerClients chans ["ROOM", "ADD", roomName]
   262         AnswerClients chans ["ROOM", "ADD", roomName]
   261         , ModifyClient (\cl -> cl{isMaster = True})
   263         , ModifyClient (\cl -> cl{isMaster = True})
   262         , MoveToRoom rId]
   264         ]
   263 
   265 
   264 {-
   266 {-
   265 processAction (clID, serverInfo, rnc) (RemoveRoom) = do
   267 processAction (clID, serverInfo, rnc) (RemoveRoom) = do
   266     processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "DEL", name room]
   268     processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "DEL", name room]
   267     processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["ROOMABANDONED", name room]
   269     processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["ROOMABANDONED", name room]
   287         rID = roomID client
   289         rID = roomID client
   288         client = clients ! clID
   290         client = clients ! clID
   289         roomPlayers = Prelude.map (nick . (clients !)) roomPlayersIDs
   291         roomPlayers = Prelude.map (nick . (clients !)) roomPlayersIDs
   290         roomPlayersIDs = IntSet.elems $ playersIDs room
   292         roomPlayersIDs = IntSet.elems $ playersIDs room
   291 
   293 
   292 
   294 -}
   293 processAction (clID, serverInfo, rnc) (RemoveTeam teamName) = do
   295 
   294     newRooms <- if not $ gameinprogress room then
   296 processAction (RemoveTeam teamName) = do
   295             do
   297     rnc <- gets roomsClients
   296             processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["REMOVE_TEAM", teamName]
   298     cl <- client's id
   297             return $
   299     ri <- clientRoomA
   298                 adjust (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) rID rooms
   300     inGame <- liftIO $ room'sM rnc gameinprogress ri
       
   301     chans <- liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
       
   302     if inGame then
       
   303             mapM_ processAction [
       
   304                 AnswerClients chans ["REMOVE_TEAM", teamName],
       
   305                 ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r})
       
   306                 ]
   299         else
   307         else
   300             do
   308             mapM_ processAction [
   301             processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["EM", rmTeamMsg]
   309                 AnswerClients chans ["EM", rmTeamMsg],
   302             return $
   310                 ModifyRoom (\r -> r{
   303                 adjust (\r -> r{
   311                     teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,
   304                 teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,
   312                     leftTeams = teamName : leftTeams r,
   305                 leftTeams = teamName : leftTeams r,
   313                     roundMsgs = roundMsgs r Seq.|> rmTeamMsg
   306                 roundMsgs = roundMsgs r Seq.|> rmTeamMsg
   314                     })
   307                 }) rID rooms
   315                 ]
   308     return (clID, serverInfo, clients, newRooms)
   316     where
   309     where
   317         rmTeamMsg = toEngineMsg $ (B.singleton 'F') `B.append` teamName
   310         room = rooms ! rID
       
   311         rID = roomID client
       
   312         client = clients ! clID
       
   313         rmTeamMsg = toEngineMsg $ 'F' : teamName
       
   314 -}
       
   315 
   318 
   316 processAction CheckRegistered = do
   319 processAction CheckRegistered = do
   317     (Just ci) <- gets clientIndex
   320     (Just ci) <- gets clientIndex
   318     n <- client's nick
   321     n <- client's nick
   319     h <- client's host
   322     h <- client's host