gameServer/HWProtoLobbyState.hs
changeset 4932 f11d80bac7ed
parent 4917 8ff92bdc9f98
child 4936 d65d438acd23
--- a/gameServer/HWProtoLobbyState.hs	Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/HWProtoLobbyState.hs	Sun Feb 06 21:50:29 2011 +0300
@@ -2,14 +2,11 @@
 module HWProtoLobbyState where
 
 import qualified Data.Map as Map
-import qualified Data.IntSet as IntSet
 import qualified Data.Foldable as Foldable
 import Data.Maybe
 import Data.List
-import Data.Word
 import Control.Monad.Reader
 import qualified Data.ByteString.Char8 as B
-import Control.DeepSeq
 --------------------------------------
 import CoreTypes
 import Actions
@@ -17,6 +14,8 @@
 import HandlerUtils
 import RoomsAndClients
 
+
+answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
 answerAllTeams cl = concatMap toAnswer
     where
         clChan = sendChan cl
@@ -35,15 +34,15 @@
     let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r))
     return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
     where
-        roomInfo irnc room = [
-                showB $ gameinprogress room,
-                name room,
-                showB $ playersIn room,
-                showB $ length $ teams room,
-                nick $ irnc `client` masterID room,
-                head (Map.findWithDefault ["+gen+"] "MAP" (params room)),
-                head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
-                head (Map.findWithDefault ["Default"] "AMMO" (params room))
+        roomInfo irnc r = [
+                showB $ gameinprogress r,
+                name r,
+                showB $ playersIn r,
+                showB $ length $ teams r,
+                nick $ irnc `client` masterID r,
+                head (Map.findWithDefault ["+gen+"] "MAP" (params r)),
+                head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
+                head (Map.findWithDefault ["Default"] "AMMO" (params r))
                 ]
 
 
@@ -52,26 +51,26 @@
     s <- roomOthersChans
     return [AnswerClients s ["CHAT", n, msg]]
 
-handleCmd_lobby ["CREATE_ROOM", newRoom, roomPassword]
-    | illegalName newRoom = return [Warning "Illegal room name"]
+handleCmd_lobby ["CREATE_ROOM", rName, roomPassword]
+    | illegalName rName = return [Warning "Illegal room name"]
     | otherwise = do
         rs <- allRoomInfos
         cl <- thisClient
-        return $ if isJust $ find (\room -> newRoom == name room) rs then 
+        return $ if isJust $ find (\r -> rName == name r) rs then
             [Warning "Room exists"]
             else
             [
-                AddRoom newRoom roomPassword,
+                AddRoom rName roomPassword,
                 AnswerClients [sendChan cl] ["CLIENT_FLAGS", "-r", nick cl]
             ]
 
 
-handleCmd_lobby ["CREATE_ROOM", newRoom] =
-    handleCmd_lobby ["CREATE_ROOM", newRoom, ""]
+handleCmd_lobby ["CREATE_ROOM", rName] =
+    handleCmd_lobby ["CREATE_ROOM", rName, ""]
 
 
 handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do
-    (ci, irnc) <- ask
+    (_, irnc) <- ask
     let ris = allRooms irnc
     cl <- thisClient
     let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris
@@ -93,19 +92,19 @@
                 AnswerClients [sendChan cl] $ "JOINED" : nicks,
                 AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl]
             ]
-            ++ (map (readynessMessage cl) jRoomClients)
-            ++ (answerFullConfig cl $ params jRoom)
-            ++ (answerTeams cl jRoom)
-            ++ (watchRound cl jRoom)
+            ++ map (readynessMessage cl) jRoomClients
+            ++ answerFullConfig cl (params jRoom)
+            ++ answerTeams cl jRoom
+            ++ watchRound cl jRoom
 
         where
         readynessMessage cl c = AnswerClients [sendChan cl] ["CLIENT_FLAGS", if isReady c then "+r" else "-r", nick c]
 
         toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs
 
-        answerFullConfig cl params = map (toAnswer cl) (leftConfigPart ++ rightConfigPart)
+        answerFullConfig cl pr = map (toAnswer cl) (leftConfigPart ++ rightConfigPart)
             where
-            (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") $ Map.toList params
+            (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") $ Map.toList pr
 
         answerTeams cl jRoom = let f = if gameinprogress jRoom then teamsAtStart else teams in answerAllTeams cl $ f jRoom
 
@@ -161,7 +160,7 @@
     where
         readNum = case B.readInt protoNum of
                        Just (i, t) | B.null t -> fromIntegral i
-                       otherwise -> 0
+                       _ -> 0
 
 handleCmd_lobby ["GET_SERVER_VAR"] = do
     cl <- thisClient