# HG changeset patch
# User unc0rr
# Date 1224527736 0
# Node ID 329d3308e2e3f22356e390b19b019e97c596c371
# Parent  d20e6e8928e364282cb54a9b21a949d17ea65685
Support for private servers in frontend

diff -r d20e6e8928e3 -r 329d3308e2e3 QTfrontend/netserver.cpp
--- a/QTfrontend/netserver.cpp	Mon Oct 20 15:59:05 2008 +0000
+++ b/QTfrontend/netserver.cpp	Mon Oct 20 18:35:36 2008 +0000
@@ -33,6 +33,7 @@
 
 	QStringList params;
 	params << QString("--port=%1").arg(port);
+	params << "--dedicated=False";
 	
 	process.start(bindir->absolutePath() + "/hedgewars-server", params);
 
diff -r d20e6e8928e3 -r 329d3308e2e3 QTfrontend/newnetclient.cpp
--- a/QTfrontend/newnetclient.cpp	Mon Oct 20 15:59:05 2008 +0000
+++ b/QTfrontend/newnetclient.cpp	Mon Oct 20 18:35:36 2008 +0000
@@ -184,7 +184,7 @@
 
 void HWNewNet::ParseCmd(const QStringList & lst)
 {
-	//qDebug() << "Server: " << lst;
+	qDebug() << "Server: " << lst;
 
 	if(!lst.size())
 	{
diff -r d20e6e8928e3 -r 329d3308e2e3 netserver/HWProto.hs
--- a/netserver/HWProto.hs	Mon Oct 20 15:59:05 2008 +0000
+++ b/netserver/HWProto.hs	Mon Oct 20 18:35:36 2008 +0000
@@ -6,12 +6,15 @@
 import Miscutils
 import Maybe
 import qualified Data.Map as Map
+import Opts
 
 teamToNet team = ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo
 	where
 		hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team
 
-answerServerMessage = [(clientOnly, ["SERVER_MESSAGE", ""])]
+answerServerMessage = [(clientOnly, "SERVER_MESSAGE" : [body])]
+	where
+		body = serverMessage globalOptions ++ if isDedicated globalOptions then "" else "<p align=center>Private server</p>"
 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])]
 answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])]
 answerBadParam = [(clientOnly, ["ERROR", "Bad parameter"])]
@@ -50,7 +53,7 @@
 			(clientOnly, ["HH_NUM", teamname team, show $ hhnum team])]
 answerMap mapName = [(othersInRoom, ["MAP", mapName])]
 answerRunGame = [(sameRoom, ["RUN_GAME"])]
-
+answerCannotCreateRoom = [(clientOnly, ["WARNING", "Cannot create more rooms"])]
 -- Main state-independent cmd handler
 handleCmd :: CmdHandler
 handleCmd client _ rooms ("QUIT":xs) =
@@ -107,10 +110,13 @@
 		(noChangeClients, noChangeRooms, answerServerMessage ++ (answerRoomsList $ map name rooms))
 
 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] =
-	if haveSameRoom then
-		(noChangeClients, noChangeRooms, answerRoomExists)
+	if (not $ isDedicated globalOptions) && (not $ null rooms) then
+		(noChangeClients, noChangeRooms, answerCannotCreateRoom)
 	else
-		(modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, answerJoined $ nick client)
+		if haveSameRoom then
+			(noChangeClients, noChangeRooms, answerRoomExists)
+		else
+			(modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, answerJoined $ nick client)
 	where
 		haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms
 
diff -r d20e6e8928e3 -r 329d3308e2e3 netserver/hedgewars-server.hs
--- a/netserver/hedgewars-server.hs	Mon Oct 20 15:59:05 2008 +0000
+++ b/netserver/hedgewars-server.hs	Mon Oct 20 18:35:36 2008 +0000
@@ -6,7 +6,7 @@
 import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Exception (setUncaughtExceptionHandler, handle, finally)
-import Control.Monad (forM, forM_, filterM, liftM, unless)
+import Control.Monad (forM, forM_, filterM, liftM, when, unless)
 import Maybe (fromMaybe)
 import Data.List
 import Miscutils
@@ -16,11 +16,11 @@
 acceptLoop :: Socket -> TChan ClientInfo -> IO ()
 acceptLoop servSock acceptChan = do
 	(cHandle, host, port) <- accept servSock
+	hPutStrLn cHandle "CONNECTED\n"
+	hFlush cHandle
 	cChan <- atomically newTChan
 	forkIO $ clientLoop cHandle cChan
 	atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" 0 "" False)
-	hPutStrLn cHandle "CONNECTED\n"
-	hFlush cHandle
 	acceptLoop servSock acceptChan
 
 
@@ -77,7 +77,7 @@
 
 			clientsIn <- sendAnswers answers mclient mclients mrooms
 			
-			mainLoop servSock acceptChan clientsIn mrooms
+			when ((isDedicated globalOptions) || (not $ null clientsIn)) $ mainLoop servSock acceptChan clientsIn mrooms
 
 
 startServer serverSocket = do