diff -r 36023de30dac -r b67a124afe53 netserver/HWProto.hs --- a/netserver/HWProto.hs Sun Jan 25 14:00:28 2009 +0000 +++ b/netserver/HWProto.hs Sun Jan 25 18:07:10 2009 +0000 @@ -6,7 +6,7 @@ import IO import Data.List import Data.Word -import Data.Sequence(Seq, (|>), empty) +import Data.Sequence(Seq, (|>), (><), fromList, empty) import Data.Foldable(toList) import Miscutils import Maybe @@ -135,13 +135,43 @@ else if isMaster client then (modifyRoomClients clRoom (\cl -> cl{isReady = False, partRoom = True}), removeRoom (room client), (answerQuit msg) ++ (answerQuitLobby (nick client) msg) ++ (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client)) -- core disconnects clients on ROOMABANDONED answer else - (noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform (nick client) msg) ++ (answerQuitLobby (nick client) msg) ++ answerRemoveClientTeams) + if not $ gameinprogress clRoom then + (noChangeClients, + modifyRoom clRoom{ + teams = othersTeams, + playersIn = (playersIn clRoom) - 1, + readyPlayers = newReadyPlayers + }, + (answerQuit msg) ++ + (answerQuitInform (nick client) msg) ++ + (answerQuitLobby (nick client) msg) ++ + answerRemoveClientTeams) + else + (noChangeClients, + modifyRoom clRoom{ + teams = othersTeams, + leftTeams = (map teamname clientTeams) ++ (leftTeams clRoom), + roundMsgs = (roundMsgs clRoom) >< (fromList rmTeamsMsgs), + playersIn = (playersIn clRoom) - 1, + readyPlayers = newReadyPlayers + }, + (answerQuit msg) ++ + (answerQuitInform (nick client) msg) ++ + (answerQuitLobby (nick client) msg) ++ + answerRemoveClientTeams ++ + answerEngineTeamsRemoveMsg) where clRoom = roomByName (room client) rooms answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams (clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom msg = if not $ null xs then head xs else "" + rmTeamsMsgs = map (\team -> toEngineMsg $ 'F' : teamname team) clientTeams + answerEngineTeamsRemoveMsg = + if not $ null rmTeamsMsgs then + answerOthersRoom $ "GAMEMSG" : rmTeamsMsgs + else + [] handleCmd _ _ _ ["PING"] = -- core requsted (noChangeClients, noChangeRooms, answerPing) @@ -292,12 +322,44 @@ if isMaster client then (modifyRoomClients clRoom (\cl -> cl{isReady = False, isMaster = False, partRoom = True}), removeRoom (room client), (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client)) else - (modifyClient client{isReady = False, partRoom = True}, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerPartInform (nick client)) ++ answerRemoveClientTeams) + if not $ gameinprogress clRoom then + (modifyClient client{ + isReady = False, + partRoom = True + }, + modifyRoom clRoom{ + teams = othersTeams, + playersIn = (playersIn clRoom) - 1, + readyPlayers = newReadyPlayers + }, + (answerPartInform (nick client)) ++ answerRemoveClientTeams) + else + (modifyClient client{ + isReady = False, + partRoom = True + }, + modifyRoom clRoom{ + teams = othersTeams, + leftTeams = (map teamname clientTeams) ++ (leftTeams clRoom), + roundMsgs = (roundMsgs clRoom) >< (fromList rmTeamsMsgs), + playersIn = (playersIn clRoom) - 1, + readyPlayers = newReadyPlayers + }, + answerEngineTeamsRemoveMsg ++ + (answerPartInform (nick client)) ++ + answerRemoveClientTeams) where clRoom = roomByName (room client) rooms answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams (clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom + rmTeamsMsgs = map (\team -> toEngineMsg $ 'F' : teamname team) clientTeams + answerEngineTeamsRemoveMsg = + if not $ null rmTeamsMsgs then + answerOthersRoom $ "GAMEMSG" : rmTeamsMsgs + else + [] + handleCmd_inRoom client _ rooms ["MAP", mapName] = if isMaster client then @@ -437,7 +499,7 @@ clRoom = roomByName (room client) rooms sameRoomClients = filter (\ci -> room ci == name clRoom) clients answerAllNotReady = concatMap (\cl -> answerSameRoom ["NOT_READY", nick cl]) sameRoomClients - answerRemovedTeams = concatMap answerRemoveTeam $ leftTeams clRoom + answerRemovedTeams = concatMap (\t -> answerSameRoom ["REMOVE_TEAM", t]) $ leftTeams clRoom handleCmd_inRoom client _ rooms ["GAMEMSG", msg] = (noChangeClients, addMsg, answerOthersRoom ["GAMEMSG", msg])