Merge
authorunc0rr
Tue, 29 Jan 2013 17:28:47 +0400
changeset 8459 d0c60699f606
parent 8458 a7ff58c92d2e (diff)
parent 8456 cc76826f14c2 (current diff)
child 8460 75e771c3c039
Merge
--- a/gameServer/CoreTypes.hs	Tue Jan 29 01:41:41 2013 -0500
+++ b/gameServer/CoreTypes.hs	Tue Jan 29 17:28:47 2013 +0400
@@ -38,7 +38,7 @@
         isAdministrator :: Bool,
         isChecker :: Bool,
         isKickedFromServer :: Bool,
-        clientClan :: Maybe B.ByteString,
+        clientClan :: !(Maybe B.ByteString),
         teamsInGame :: Word
     }
 
@@ -66,6 +66,9 @@
     }
     deriving (Show, Read)
 
+instance Eq TeamInfo where
+    (==) = (==) `on` teamname
+    
 data GameInfo =
     GameInfo
     {
--- a/gameServer/HWProtoInRoomState.hs	Tue Jan 29 01:41:41 2013 -0500
+++ b/gameServer/HWProtoInRoomState.hs	Tue Jan 29 17:28:47 2013 +0400
@@ -97,7 +97,6 @@
 handleCmd_inRoom ["REMOVE_TEAM", tName] = do
         (ci, _) <- ask
         r <- thisRoom
-        clNick <- clientNick
 
         let maybeTeam = findTeam r
         let team = fromJust maybeTeam
@@ -105,18 +104,18 @@
         return $
             if isNothing $ maybeTeam then
                 [Warning $ loc "REMOVE_TEAM: no such team"]
-            else if clNick /= teamowner team then
+            else if ci /= teamownerId team then
                 [ProtocolError $ loc "Not team owner!"]
             else
                 [RemoveTeam tName,
                 ModifyClient
                     (\c -> c{
                         teamsInGame = teamsInGame c - 1,
-                        clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci r
+                        clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci team r
                     })
                 ]
     where
-        anotherTeamClan ci = teamcolor . fromJust . find (\t -> teamownerId t == ci) . teams
+        anotherTeamClan ci team = teamcolor . fromMaybe (error "CHECKPOINT 011") . find (\t -> (teamownerId t == ci) && (t /= team)) . teams
         findTeam = find (\t -> tName == teamname t) . teams