Implement 'roundfinished' cmd on net server
authorunc0rr
Fri, 20 Feb 2009 11:58:58 +0000
changeset 1811 1b9e33623b7e
parent 1810 4059cafd1da7
child 1812 3d4692e825e7
Implement 'roundfinished' cmd on net server
gameServer/Actions.hs
gameServer/HWProtoCore.hs
gameServer/HWProtoInRoomState.hs
gameServer/HWProtoLobbyState.hs
--- a/gameServer/Actions.hs	Thu Feb 19 14:52:32 2009 +0000
+++ b/gameServer/Actions.hs	Fri Feb 20 11:58:58 2009 +0000
@@ -18,6 +18,7 @@
 	| RoomAddThisClient Int -- roomID
 	| RoomRemoveThisClient
 	| RemoveRoom
+	| UnreadyRoomClients
 	| ProtocolError String
 	| Warning String
 	| ByeClient String
@@ -179,18 +180,32 @@
 
 
 processAction (clID, serverInfo, clients, rooms) (RemoveRoom) = do
-	processAction (clID, serverInfo, clients, rooms) $ AnswerLobby ["ROOM", "DEL", name clRoom]
-	processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["ROOMABANDONED", name clRoom]
+	processAction (clID, serverInfo, clients, rooms) $ AnswerLobby ["ROOM", "DEL", name room]
+	processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["ROOMABANDONED", name room]
 	return (clID,
 		serverInfo,
 		Data.IntMap.map (\cl -> if roomID cl == rID then cl{roomID = 0, isMaster = False} else cl) clients,
-		delete rID $ adjust (\r -> r{playersIDs = IntSet.union (playersIDs clRoom) (playersIDs r)}) 0 rooms
+		delete rID $ adjust (\r -> r{playersIDs = IntSet.union (playersIDs room) (playersIDs r)}) 0 rooms
 		)
 	where
-		clRoom = rooms ! rID
+		room = rooms ! rID
 		rID = roomID client
 		client = clients ! clID
 
+processAction (clID, serverInfo, clients, rooms) (UnreadyRoomClients) = do
+	processAction (clID, serverInfo, clients, rooms) $ AnswerThisRoom ("NOT_READY" : roomPlayers)
+	return (clID,
+		serverInfo,
+		Data.IntMap.map (\cl -> if roomID cl == rID then cl{isReady = False} else cl) clients,
+		rooms)
+	where
+		room = rooms ! rID
+		rID = roomID client
+		client = clients ! clID
+		roomPlayers = Prelude.map (nick . (clients !)) roomPlayersIDs
+		roomPlayersIDs = IntSet.elems $ playersIDs room
+
+
 processAction (clID, serverInfo, clients, rooms) (Dump) = do
 	writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms]
 	return (clID, serverInfo, clients, rooms)
--- a/gameServer/HWProtoCore.hs	Thu Feb 19 14:52:32 2009 +0000
+++ b/gameServer/HWProtoCore.hs	Fri Feb 20 11:58:58 2009 +0000
@@ -5,7 +5,6 @@
 import CoreTypes
 import Actions
 import Utils
-import Answers
 import HWProtoNEState
 import HWProtoLobbyState
 import HWProtoInRoomState
--- a/gameServer/HWProtoInRoomState.hs	Thu Feb 19 14:52:32 2009 +0000
+++ b/gameServer/HWProtoInRoomState.hs	Fri Feb 20 11:58:58 2009 +0000
@@ -18,6 +18,7 @@
 	where
 		clientNick = nick $ clients IntMap.! clID
 
+
 handleCmd_inRoom clID clients _ ["PART"] =
 	if isMaster client then
 		[RemoveRoom]
@@ -26,6 +27,7 @@
 	where
 		client = clients IntMap.! clID
 
+
 handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs) =
 	if isMaster client then
 		[ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)})
@@ -142,7 +144,13 @@
 handleCmd_inRoom clID clients rooms ["START_GAME"] =
 	if isMaster client && (playersIn room == readyPlayers room) && (not $ gameinprogress room) then
 		if enoughClans then
-			[ModifyRoom (\r -> r{gameinprogress = True, roundMsgs = empty, leftTeams = [], teamsAtStart = teams r}),
+			[ModifyRoom
+					(\r -> r{
+						gameinprogress = True,
+						roundMsgs = empty,
+						leftTeams = [],
+						teamsAtStart = teams r}
+					),
 			AnswerThisRoom ["RUN_GAME"]]
 		else
 			[Warning "Less than two clans!"]
@@ -154,9 +162,29 @@
 		enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room
 
 
-handleCmd_inRoom client _ rooms ["GAMEMSG", msg] =
+handleCmd_inRoom _ _ rooms ["GAMEMSG", msg] =
 	[ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}),
 	AnswerOthersInRoom ["GAMEMSG", msg]]
 
 
+handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] =
+	if isMaster client then
+		[ModifyRoom
+				(\r -> r{
+					gameinprogress = False,
+					readyPlayers = 0,
+					roundMsgs = empty,
+					leftTeams = [],
+					teamsAtStart = []}
+				),
+		UnreadyRoomClients
+		] ++ answerRemovedTeams
+	else
+		[]
+	where
+		client = clients IntMap.! clID
+		room = rooms IntMap.! (roomID client)
+		answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room
+
+
 handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]
--- a/gameServer/HWProtoLobbyState.hs	Thu Feb 19 14:52:32 2009 +0000
+++ b/gameServer/HWProtoLobbyState.hs	Fri Feb 20 11:58:58 2009 +0000
@@ -8,7 +8,6 @@
 --------------------------------------
 import CoreTypes
 import Actions
-import Answers
 import Utils
 
 answerAllTeams teams = concatMap toAnswer teams