merge
authorunc0rr
Sat, 26 Jun 2010 16:58:19 +0400
changeset 3565 bc3410104894
parent 3564 7c583c88327b (diff)
parent 3562 c601630a12d5 (current diff)
child 3566 772a46ef8288
child 3567 28e90e4541ce
merge
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Sat Jun 26 16:58:19 2010 +0400
@@ -0,0 +1,16 @@
+glob:CMakeCache.txt
+glob:CMakeFiles
+glob:moc_*.cxx
+glob:qrc_*.cxx
+glob:*.o
+glob:Makefile
+glob:bin
+glob:*.hi
+glob:*.*~
+glob:*.core
+glob:hedgewars/config.inc
+glob:cmake_install.cmake
+glob:QTfrontend/hwconsts.cpp
+glob:CPackConfig.cmake
+glob:CPackSourceConfig.cmake
+glob:tools/cmake_uninstall.cmake
--- a/QTfrontend/newnetclient.cpp	Sat Jun 26 09:59:53 2010 +0200
+++ b/QTfrontend/newnetclient.cpp	Sat Jun 26 16:58:19 2010 +0400
@@ -153,7 +153,7 @@
 
 void HWNewNet::RawSendNet(const QByteArray & buf)
 {
-  //qDebug() << "Client: " << QString(buf).split("\n");
+  qDebug() << "Client: " << QString(buf).split("\n");
     NetSocket.write(buf);
     NetSocket.write("\n\n", 2);
 }
@@ -202,7 +202,7 @@
 
 void HWNewNet::ParseCmd(const QStringList & lst)
 {
-  //qDebug() << "Server: " << lst;
+  qDebug() << "Server: " << lst;
 
     if(!lst.size())
     {
--- a/gameServer/CMakeLists.txt	Sat Jun 26 09:59:53 2010 +0200
+++ b/gameServer/CMakeLists.txt	Sat Jun 26 16:58:19 2010 +0400
@@ -28,6 +28,7 @@
 set(hwserv_main ${hedgewars_SOURCE_DIR}/gameServer/hedgewars-server.hs)
 
 set(ghc_flags
+    -Wall
     --make ${hwserv_main}
     -i${hedgewars_SOURCE_DIR}/gameServer
     -o ${EXECUTABLE_OUTPUT_PATH}/hedgewars-server${CMAKE_EXECUTABLE_SUFFIX}
--- a/gameServer/CoreTypes.hs	Sat Jun 26 09:59:53 2010 +0200
+++ b/gameServer/CoreTypes.hs	Sat Jun 26 16:58:19 2010 +0400
@@ -49,7 +49,7 @@
 data TeamInfo =
     TeamInfo
     {
-        teamownerId :: !Int,
+        teamownerId :: ClientIndex,
         teamowner :: B.ByteString,
         teamname :: B.ByteString,
         teamcolor :: B.ByteString,
--- a/gameServer/HWProtoInRoomState.hs	Sat Jun 26 09:59:53 2010 +0200
+++ b/gameServer/HWProtoInRoomState.hs	Sat Jun 26 16:58:19 2010 +0400
@@ -5,14 +5,16 @@
 import qualified Data.Map as Map
 import Data.Sequence(Seq, (|>), (><), fromList, empty)
 import Data.List
-import Maybe
+import Data.Maybe
 import qualified Data.ByteString.Char8 as B
+import Control.Monad
+import Control.Monad.Reader
 --------------------------------------
 import CoreTypes
 import Actions
 import Utils
 import HandlerUtils
-
+import RoomsAndClients
 
 handleCmd_inRoom :: CmdHandler
 
@@ -39,45 +41,67 @@
 
 handleCmd_inRoom ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
     | length hhsInfo /= 16 = return [ProtocolError "Corrupted hedgehogs info"]
-{-    | length (teams room) == 6 = [Warning "too many teams"]
-    | canAddNumber <= 0 = [Warning "too many hedgehogs"]
-    | isJust findTeam = [Warning "There's already a team with same name in the list"]
-    | gameinprogress room = [Warning "round in progress"]
-    | isRestrictedTeams room = [Warning "restricted"]
-    | otherwise =
-        [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}),
-        ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
-        AnswerThisClient ["TEAM_ACCEPTED", name],
-        AnswerOthersInRoom $ teamToNet (clientProto client) newTeam,
-        AnswerOthersInRoom ["TEAM_COLOR", name, color]
-        ]
-    where
-        client = clients IntMap.! clID
-        room = rooms IntMap.! (roomID client)
-        canAddNumber = 48 - (sum . map hhnum $ teams room)
-        findTeam = find (\t -> name == teamname t) $ teams room
-        newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo))
-        difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
+    | otherwise = do
+        (ci, rnc) <- ask
+        let r = room rnc $ clientRoom rnc ci
+        clNick <- clientNick
+        clChan <- thisClientChans
+        othersChans <- roomOthersChans
+        return $
+            if null . drop 5 $ teams r then
+                [Warning "too many teams"]
+            else if canAddNumber r <= 0 then
+                [Warning "too many hedgehogs"]
+            else if isJust $ findTeam r then
+                [Warning "There's already a team with same name in the list"]
+            else if gameinprogress r then
+                [Warning "round in progress"]
+            else if isRestrictedTeams r then
+                [Warning "restricted"]
+            else
+                [ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r]}),
+                ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
+                AnswerClients clChan ["TEAM_ACCEPTED", name],
+                AnswerClients othersChans $ teamToNet $ newTeam ci clNick r,
+                AnswerClients othersChans ["TEAM_COLOR", name, color]
+                ]
+        where
+        canAddNumber r = 48 - (sum . map hhnum $ teams r)
+        findTeam = find (\t -> name == teamname t) . teams
+        newTeam ci clNick r = (TeamInfo ci clNick name color grave fort voicepack flag difficulty (newTeamHHNum r) (hhsList hhsInfo))
+        difficulty = case B.readInt difStr of
+                           Just (i, t) | B.null t -> fromIntegral i
+                           otherwise -> 0
         hhsList [] = []
         hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
-        newTeamHHNum = min 4 canAddNumber
--}
+        newTeamHHNum r = min 4 (canAddNumber r)
+
+handleCmd_inRoom ["REMOVE_TEAM", name] = do
+        (ci, rnc) <- ask
+        let r = room rnc $ clientRoom rnc ci
+        clNick <- clientNick
+
+        let maybeTeam = findTeam r
+        let team = fromJust maybeTeam
+
+        return $
+            if isNothing $ findTeam r then
+                [Warning "REMOVE_TEAM: no such team"]
+            else if clNick /= teamowner team then
+                [ProtocolError "Not team owner!"]
+            else
+                [RemoveTeam name,
+                ModifyClient
+                    (\c -> c{
+                        teamsInGame = teamsInGame c - 1,
+                        clientClan = if teamsInGame c == 1 then undefined else anotherTeamClan ci r
+                        })
+                ]
+    where
+        anotherTeamClan ci = teamcolor . fromJust . find (\t -> teamownerId t == ci) . teams
+        findTeam = find (\t -> name == teamname t) . teams
+
 {-
-handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName]
-    | noSuchTeam = [Warning "REMOVE_TEAM: no such team"]
-    | nick client /= teamowner team = [ProtocolError "Not team owner!"]
-    | otherwise =
-            [RemoveTeam teamName,
-            ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1, clientClan = if teamsInGame client == 1 then undefined else anotherTeamClan})
-            ]
-    where
-        client = clients IntMap.! clID
-        room = rooms IntMap.! (roomID client)
-        noSuchTeam = isNothing findTeam
-        team = fromJust findTeam
-        findTeam = find (\t -> teamName == teamname t) $ teams room
-        anotherTeamClan = teamcolor $ fromJust $ find (\t -> teamownerId t == clID) $ teams room
-
 
 handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr]
     | not $ isMaster client = [ProtocolError "Not room master"]
--- a/gameServer/HWProtoLobbyState.hs	Sat Jun 26 09:59:53 2010 +0200
+++ b/gameServer/HWProtoLobbyState.hs	Sat Jun 26 16:58:19 2010 +0400
@@ -4,7 +4,7 @@
 import qualified Data.Map as Map
 import qualified Data.IntSet as IntSet
 import qualified Data.Foldable as Foldable
-import Maybe
+import Data.Maybe
 import Data.List
 import Data.Word
 import Control.Monad.Reader
@@ -44,7 +44,7 @@
                 name room,
                 showB $ playersIn room,
                 showB $ length $ teams room,
-                nick $ irnc `client` (masterID 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))
--- a/gameServer/RoomsAndClients.hs	Sat Jun 26 09:59:53 2010 +0200
+++ b/gameServer/RoomsAndClients.hs	Sat Jun 26 16:58:19 2010 +0400
@@ -23,6 +23,7 @@
     withRoomsAndClients,
     allRooms,
     allClients,
+    clientRoom,
     showRooms,
     roomClients
     ) where
--- a/gameServer/Utils.hs	Sat Jun 26 09:59:53 2010 +0200
+++ b/gameServer/Utils.hs	Sat Jun 26 16:58:19 2010 +0400
@@ -52,18 +52,8 @@
     [(x, rest)] | all isSpace rest -> Just x
     _         -> Nothing
 
-teamToNet :: Word16 -> TeamInfo -> [B.ByteString]
-teamToNet protocol team 
-    | protocol < 30 =
-        "ADD_TEAM"
-        : teamname team
-        : teamgrave team
-        : teamfort team
-        : teamvoicepack team
-        : teamowner team
-        : (B.pack $ show $ difficulty team)
-        : hhsInfo
-    | otherwise = 
+teamToNet :: TeamInfo -> [B.ByteString]
+teamToNet team =
         "ADD_TEAM"
         : teamname team
         : teamgrave team