--- a/gameServer/Actions.hs Fri Feb 20 14:12:16 2009 +0000
+++ b/gameServer/Actions.hs Fri Feb 20 19:40:55 2009 +0000
@@ -4,9 +4,11 @@
import Control.Concurrent.Chan
import Data.IntMap
import qualified Data.IntSet as IntSet
+import qualified Data.Sequence as Seq
import Monad
-----------------------------
import CoreTypes
+import Utils
data Action =
AnswerThisClient [String]
@@ -17,6 +19,7 @@
| AnswerLobby [String]
| RoomAddThisClient Int -- roomID
| RoomRemoveThisClient
+ | RemoveTeam String
| RemoveRoom
| UnreadyRoomClients
| ProtocolError String
@@ -192,6 +195,7 @@
rID = roomID client
client = clients ! clID
+
processAction (clID, serverInfo, clients, rooms) (UnreadyRoomClients) = do
processAction (clID, serverInfo, clients, rooms) $ AnswerThisRoom ("NOT_READY" : roomPlayers)
return (clID,
@@ -206,6 +210,29 @@
roomPlayersIDs = IntSet.elems $ playersIDs room
+processAction (clID, serverInfo, clients, rooms) (RemoveTeam teamName) = do
+ newRooms <- if not $ gameinprogress room then
+ do
+ processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["REMOVE_TEAM", teamName]
+ return $
+ adjust (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) rID rooms
+ else
+ do
+ processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["GAMEMSG", 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)
+ where
+ room = rooms ! rID
+ rID = roomID client
+ client = clients ! clID
+ rmTeamMsg = toEngineMsg $ 'F' : teamName
+
+
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/HWProtoInRoomState.hs Fri Feb 20 14:12:16 2009 +0000
+++ b/gameServer/HWProtoInRoomState.hs Fri Feb 20 19:40:55 2009 +0000
@@ -75,26 +75,13 @@
if not $ nick client == teamowner team then
[ProtocolError "Not team owner!"]
else
- if not $ gameinprogress room then
- [ModifyRoom (\r -> r{teams = filter (\t -> teamName /= teamname t) $ teams r}),
- AnswerOthersInRoom ["REMOVE_TEAM", teamName]]
- else
- []
-{- else
- (noChangeClients,
- modifyRoom clRoom{
- teams = filter (\t -> teamName /= teamname t) $ teams clRoom,
- leftTeams = teamName : leftTeams clRoom,
- roundMsgs = roundMsgs clRoom |> rmTeamMsg
- },
- answerOthersRoom ["GAMEMSG", rmTeamMsg]) -}
+ [RemoveTeam teamName]
where
client = clients IntMap.! clID
room = rooms IntMap.! (roomID client)
noSuchTeam = isNothing findTeam
team = fromJust findTeam
findTeam = find (\t -> teamName == teamname t) $ teams room
- rmTeamMsg = toEngineMsg $ 'F' : teamName
handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr] =
--- a/gameServer/HWProtoLobbyState.hs Fri Feb 20 14:12:16 2009 +0000
+++ b/gameServer/HWProtoLobbyState.hs Fri Feb 20 19:40:55 2009 +0000
@@ -3,6 +3,7 @@
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
+import qualified Data.Foldable as Foldable
import Maybe
import Data.List
--------------------------------------
@@ -68,7 +69,7 @@
++ [AnswerThisRoom ["NOT_READY", nick client]]
++ answerFullConfig jRoom
++ answerTeams
--- ++ watchRound)
+ ++ watchRound
where
noSuchRoom = isNothing mbRoom
mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms
@@ -86,12 +87,13 @@
toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
answerFullConfig room = map toAnswer (Map.toList $ params room)
-{-
- watchRound = if (roomProto clRoom < 20) || (not $ gameinprogress clRoom) then
+
+ watchRound = if not $ gameinprogress jRoom then
[]
else
- (answerClientOnly ["RUN_GAME"]) ++
- answerClientOnly ("GAMEMSG" : toEngineMsg "e$spectate 1" : (toList $ roundMsgs clRoom)) -}
+ [AnswerThisClient ["RUN_GAME"],
+ AnswerThisClient $ "GAMEMSG" : toEngineMsg "e$spectate 1" : (Foldable.toList $ roundMsgs jRoom)]
+
answerTeams = if gameinprogress jRoom then
answerAllTeams (teamsAtStart jRoom)
else