gameServer/HWProtoLobbyState.hs
changeset 4568 f85243bf890e
parent 4337 85e02b1a8e8f
child 4570 fa19f0579083
--- a/gameServer/HWProtoLobbyState.hs	Sun Dec 19 20:45:15 2010 +0300
+++ b/gameServer/HWProtoLobbyState.hs	Sun Dec 19 13:31:55 2010 -0500
@@ -1,102 +1,73 @@
-{-# LANGUAGE OverloadedStrings #-}
 module HWProtoLobbyState where
 
 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 Data.Maybe
 import Data.List
 import Data.Word
-import Control.Monad.Reader
-import qualified Data.ByteString.Char8 as B
 --------------------------------------
 import CoreTypes
 import Actions
 import Utils
-import HandlerUtils
-import RoomsAndClients
 
-{-answerAllTeams protocol teams = concatMap toAnswer teams
+answerAllTeams protocol teams = concatMap toAnswer teams
     where
         toAnswer team =
             [AnswerThisClient $ teamToNet protocol team,
             AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team],
             AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]]
--}
+
 handleCmd_lobby :: CmdHandler
 
-
-handleCmd_lobby ["LIST"] = do
-    (ci, irnc) <- ask
-    let cl = irnc `client` ci
-    rooms <- allRoomInfos
-    let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r))
-    return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
+handleCmd_lobby clID clients rooms ["LIST"] =
+    [AnswerThisClient ("ROOMS" : roomsInfoList)]
     where
-        roomInfo irnc room = [
-                showB $ gameinprogress room,
+        roomsInfoList = concatMap roomInfo sameProtoRooms
+        sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList
+        roomsList = IntMap.elems rooms
+        protocol = clientProto client
+        client = clients IntMap.! clID
+        roomInfo room
+            | clientProto client < 28 = [
                 name room,
-                showB $ playersIn room,
-                showB $ length $ teams room,
-                nick $ irnc `client` masterID room,
+                show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")",
+                show $ gameinprogress room
+                ]
+            | otherwise = [
+                show $ gameinprogress room,
+                name room,
+                show $ playersIn room,
+                show $ length $ teams room,
+                nick $ clients IntMap.! (masterID room),
                 head (Map.findWithDefault ["+gen+"] "MAP" (params room)),
                 head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
                 head (Map.findWithDefault ["Default"] "AMMO" (params room))
                 ]
 
-
-handleCmd_lobby ["CHAT", msg] = do
-    n <- clientNick
-    s <- roomOthersChans
-    return [AnswerClients s ["CHAT", n, msg]]
-
-handleCmd_lobby ["CREATE_ROOM", newRoom, roomPassword]
-    | illegalName newRoom = return [Warning "Illegal room name"]
-    | otherwise = do
-        rs <- allRoomInfos
-        cl <- thisClient
-        return $ if isJust $ find (\room -> newRoom == name room) rs then 
-            [Warning "Room exists"]
-            else
-            [
-                AddRoom newRoom roomPassword,
-                AnswerClients [sendChan cl] ["NOT_READY", nick cl]
-            ]
-
-
-handleCmd_lobby ["CREATE_ROOM", newRoom] =
-    handleCmd_lobby ["CREATE_ROOM", newRoom, ""]
+handleCmd_lobby clID clients _ ["CHAT", msg] =
+    [AnswerOthersInRoom ["CHAT", clientNick, msg]]
+    where
+        clientNick = nick $ clients IntMap.! clID
 
 
-handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do
-    (ci, irnc) <- ask
-    let ris = allRooms irnc
-    cl <- thisClient
-    let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris
-    let jRI = fromJust maybeRI
-    let jRoom = irnc `room` jRI
-    let jRoomClients = map (client irnc) $! roomClients irnc jRI -- no lazyness here!
-    return $
-        if isNothing maybeRI then 
-            [Warning "No such rooms"]
-            else if isRestrictedJoins jRoom then
-            [Warning "Joining restricted"]
-            else if roomPassword /= password jRoom then
-            [Warning "Wrong password"]
-            else
-            [
-                MoveToRoom jRI,
-                AnswerClients (map sendChan $ cl : jRoomClients) ["NOT_READY", nick cl]
-            ]
-            ++ [ AnswerClients [sendChan cl] $ "JOINED" : map nick jRoomClients | playersIn jRoom /= 0]
-            ++ (map (readynessMessage cl) jRoomClients)
-
+handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword]
+    | haveSameRoom = [Warning "Room exists"]
+    | illegalName newRoom = [Warning "Illegal room name"]
+    | otherwise =
+        [RoomRemoveThisClient "", -- leave lobby
+        AddRoom newRoom roomPassword,
+        AnswerThisClient ["NOT_READY", clientNick]
+        ]
     where
-        readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c]
+        clientNick = nick $ clients IntMap.! clID
+        haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms
 
 
+handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom] =
+    handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""]
 
-{-
 
 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword]
     | noSuchRoom = [Warning "No such room"]
@@ -112,6 +83,12 @@
         ++ answerTeams
         ++ watchRound
     where
+        noSuchRoom = isNothing mbRoom
+        mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms
+        jRoom = fromJust mbRoom
+        rID = roomUID jRoom
+        client = clients IntMap.! clID
+        roomClientsIDs = IntSet.elems $ playersIDs jRoom
         answerNicks =
             [AnswerThisClient $ "JOINED" :
             map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs | playersIn jRoom /= 0]
@@ -123,7 +100,7 @@
             roomClientsIDs
 
         toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
-
+        
         answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart)
         (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom)
 
@@ -137,12 +114,12 @@
                 answerAllTeams (clientProto client) (teamsAtStart jRoom)
             else
                 answerAllTeams (clientProto client) (teams jRoom)
--}
+
 
-handleCmd_lobby ["JOIN_ROOM", roomName] =
-    handleCmd_lobby ["JOIN_ROOM", roomName, ""]
+handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName] =
+    handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, ""]
+    
 
-{-
 handleCmd_lobby clID clients rooms ["FOLLOW", asknick] =
     if noSuchClient || roomID followClient == 0 then
         []
@@ -203,7 +180,6 @@
         [ClearAccountsCache | isAdministrator client]
     where
         client = clients IntMap.! clID
--}
 
 
-handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"]
+handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"]