--- a/gameServer/Actions.hs Thu Jul 15 04:31:25 2010 +0200
+++ b/gameServer/Actions.hs Sat Jul 17 23:44:42 2010 +0400
@@ -181,7 +181,7 @@
chans <- liftM (map sendChan) $ roomClientsS ri
clNick <- client's nick
-
+
processAction $ AnswerClients chans ["JOINED", clNick]
processAction (MoveToLobby msg) = do
@@ -244,22 +244,24 @@
Just clId <- gets clientIndex
rnc <- gets roomsClients
proto <- liftIO $ client'sM rnc clientProto clId
-
+
let room = newRoom{
masterID = clId,
name = roomName,
password = roomPassword,
roomProto = proto
}
-
- rId <- liftIO $ addRoom rnc room
-
+
+ rId <- liftIO $ addRoom rnc room
+
+ processAction $ MoveToRoom rId
+
chans <- liftM (map sendChan) $ roomClientsS lobbyId
mapM_ processAction [
AnswerClients chans ["ROOM", "ADD", roomName]
, ModifyClient (\cl -> cl{isMaster = True})
- , MoveToRoom rId]
+ ]
{-
processAction (clID, serverInfo, rnc) (RemoveRoom) = do
@@ -289,29 +291,30 @@
roomPlayers = Prelude.map (nick . (clients !)) roomPlayersIDs
roomPlayersIDs = IntSet.elems $ playersIDs room
+-}
-processAction (clID, serverInfo, rnc) (RemoveTeam teamName) = do
- newRooms <- if not $ gameinprogress room then
- do
- processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["REMOVE_TEAM", teamName]
- return $
- adjust (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) rID rooms
+processAction (RemoveTeam teamName) = do
+ rnc <- gets roomsClients
+ cl <- client's id
+ ri <- clientRoomA
+ inGame <- liftIO $ room'sM rnc gameinprogress ri
+ chans <- liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
+ if inGame then
+ mapM_ processAction [
+ AnswerClients chans ["REMOVE_TEAM", teamName],
+ ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r})
+ ]
else
- do
- processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["EM", rmTeamMsg]
- return $
- adjust (\r -> r{
- teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,
- leftTeams = teamName : leftTeams r,
- roundMsgs = roundMsgs r Seq.|> rmTeamMsg
- }) rID rooms
- return (clID, serverInfo, clients, newRooms)
+ mapM_ processAction [
+ AnswerClients chans ["EM", rmTeamMsg],
+ ModifyRoom (\r -> r{
+ teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,
+ leftTeams = teamName : leftTeams r,
+ roundMsgs = roundMsgs r Seq.|> rmTeamMsg
+ })
+ ]
where
- room = rooms ! rID
- rID = roomID client
- client = clients ! clID
- rmTeamMsg = toEngineMsg $ 'F' : teamName
--}
+ rmTeamMsg = toEngineMsg $ (B.singleton 'F') `B.append` teamName
processAction CheckRegistered = do
(Just ci) <- gets clientIndex
--- a/gameServer/HWProtoLobbyState.hs Thu Jul 15 04:31:25 2010 +0200
+++ b/gameServer/HWProtoLobbyState.hs Sat Jul 17 23:44:42 2010 +0400
@@ -54,8 +54,7 @@
| illegalName newRoom = return [Warning "Illegal room name"]
| otherwise = do
rs <- allRoomInfos
- (ci, irnc) <- ask
- let cl = irnc `client` ci
+ cl <- thisClient
return $ if isJust $ find (\room -> newRoom == name room) rs then
[Warning "Room exists"]
else
--- a/gameServer/RoomsAndClients.hs Thu Jul 15 04:31:25 2010 +0200
+++ b/gameServer/RoomsAndClients.hs Sat Jul 17 23:44:42 2010 +0400
@@ -18,6 +18,7 @@
client,
room,
client'sM,
+ room'sM,
clientsM,
roomClientsM,
withRoomsAndClients,
@@ -142,6 +143,9 @@
client'sM :: MRoomsAndClients r c -> (c -> a) -> ClientIndex -> IO a
client'sM (MRoomsAndClients (_, clients)) f (ClientIndex ci) = liftM (f . client') (clients `readElem` ci)
+room'sM :: MRoomsAndClients r c -> (r -> a) -> RoomIndex -> IO a
+room'sM (MRoomsAndClients (rooms, _)) f (RoomIndex ri) = liftM (f . room') (rooms `readElem` ri)
+
clientsM :: MRoomsAndClients r c -> IO [c]
clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (\ci -> liftM client' $ readElem clients ci)
--- a/gameServer/ServerState.hs Thu Jul 15 04:31:25 2010 +0200
+++ b/gameServer/ServerState.hs Sat Jul 17 23:44:42 2010 +0400
@@ -33,7 +33,7 @@
(Just ci) <- gets clientIndex
rnc <- gets roomsClients
liftIO $ client'sM rnc f ci
-
+
allClientsS :: StateT ServerState IO [ClientInfo]
allClientsS = gets roomsClients >>= liftIO . clientsM
@@ -41,4 +41,3 @@
roomClientsS ri = do
rnc <- gets roomsClients
liftIO $ roomClientsM rnc ri
-
\ No newline at end of file