--- a/QTfrontend/newnetclient.cpp Thu Jun 24 19:52:04 2010 +0400
+++ b/QTfrontend/newnetclient.cpp Fri Jun 25 10:05:42 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 Thu Jun 24 19:52:04 2010 +0400
+++ b/gameServer/CMakeLists.txt Fri Jun 25 10:05:42 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 Thu Jun 24 19:52:04 2010 +0400
+++ b/gameServer/CoreTypes.hs Fri Jun 25 10:05:42 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 Thu Jun 24 19:52:04 2010 +0400
+++ b/gameServer/HWProtoInRoomState.hs Fri Jun 25 10:05:42 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,29 +41,40 @@
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 clID clients rooms ["REMOVE_TEAM", teamName]
| noSuchTeam = [Warning "REMOVE_TEAM: no such team"]
--- a/gameServer/HWProtoLobbyState.hs Thu Jun 24 19:52:04 2010 +0400
+++ b/gameServer/HWProtoLobbyState.hs Fri Jun 25 10:05:42 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 Thu Jun 24 19:52:04 2010 +0400
+++ b/gameServer/RoomsAndClients.hs Fri Jun 25 10:05:42 2010 +0400
@@ -23,6 +23,7 @@
withRoomsAndClients,
allRooms,
allClients,
+ clientRoom,
showRooms,
roomClients
) where
--- a/gameServer/Utils.hs Thu Jun 24 19:52:04 2010 +0400
+++ b/gameServer/Utils.hs Fri Jun 25 10:05:42 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