netserver/HWProto.hs
changeset 1384 329d3308e2e3
parent 1383 d20e6e8928e3
child 1385 ca72264f921a
--- 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