netserver/HWProto.hs
changeset 1327 9d43a6e6b9ca
parent 1325 c8994d47f41d
child 1328 c41344e3c236
--- a/netserver/HWProto.hs	Thu Oct 09 13:01:52 2008 +0000
+++ b/netserver/HWProto.hs	Thu Oct 09 13:43:47 2008 +0000
@@ -9,8 +9,9 @@
 
 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])]
 answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])]
+answerBadParam = [(clientOnly, ["ERROR", "Bad parameter"])]
 answerQuit = [(clientOnly, ["off"])]
-answerAbandoned = [(sameRoom, ["BYE"])]
+answerAbandoned = [(othersInRoom, ["BYE"])]
 answerQuitInform nick = [(othersInRoom, ["LEFT", nick])]
 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])]
 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])]
@@ -29,11 +30,12 @@
 	where
 		toAnswer (paramName, paramStrs) =
 			(clientOnly, "CONFIG_PARAM" : paramName : paramStrs)
-answerCantAdd = [(clientOnly, ["WARNING", "Too many teams"])]
+answerCantAdd = [(clientOnly, ["WARNING", "Too many teams or hedgehogs"])]
 answerTeamAccepted team = [(clientOnly, ["TEAM_ACCEPTED", teamname team])]
 answerAddTeam team = [(othersInRoom, ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo)]
 	where
 		hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team
+answerHHNum teamName hhNumber = [(othersInRoom, ["HH_NUM", teamName, show hhNumber])]
 
 -- Main state-independent cmd handler
 handleCmd :: CmdHandler
@@ -41,7 +43,7 @@
 	if null (room client) then
 		(noChangeClients, noChangeRooms, answerQuit)
 	else if isMaster client then
-		(noChangeClients, removeRoom (room client), answerAbandoned) -- core disconnects clients on ROOMABANDONED answer
+		(noChangeClients, removeRoom (room client), answerQuit ++ answerAbandoned) -- core disconnects clients on ROOMABANDONED answer
 	else
 		(noChangeClients, noChangeRooms, answerQuit ++ (answerQuitInform $ nick client))
 
@@ -120,7 +122,7 @@
 handleCmd_inRoom client _ _ ["CHAT_STRING", msg] =
 	(noChangeClients, noChangeRooms, answerChatString (nick client) msg)
 
-handleCmd_inRoom client _ rooms ("CONFIG_PARAM":paramName:paramStrs) =
+handleCmd_inRoom client _ rooms ("CONFIG_PARAM" : paramName : paramStrs) =
 	if isMaster client then
 		(noChangeClients, modifyRoom clRoom{params = Map.insert paramName paramStrs (params clRoom)}, answerConfigParam paramName paramStrs)
 	else
@@ -128,18 +130,36 @@
 	where
 		clRoom = roomByName (room client) rooms
 
-handleCmd_inRoom client _ rooms ("ADDTEAM" : name : color : grave : fort : difStr : hhsInfo)
+handleCmd_inRoom client _ rooms ("ADD_TEAM" : name : color : grave : fort : difStr : hhsInfo)
 	| length hhsInfo == 16 =
-	if length (teams clRoom) == 6 then
+	if length (teams clRoom) == 6 || canAddNumber <= 0 then
 		(noChangeClients, noChangeRooms, answerCantAdd)
 	else
 		(noChangeClients, modifyRoom clRoom{teams = newTeam : teams clRoom}, answerTeamAccepted newTeam ++ answerAddTeam newTeam)
 	where
 		clRoom = roomByName (room client) rooms
-		newTeam = (TeamInfo name color grave fort difficulty (hhsList hhsInfo))
+		newTeam = (TeamInfo name color grave fort difficulty newTeamHHNum (hhsList hhsInfo))
 		difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
 		hhsList [] = []
 		hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
+		canAddNumber = 18 - (sum . map hhnum $ teams clRoom)
+		newTeamHHNum = min 4 canAddNumber
+
+handleCmd_inRoom client _ rooms ["HH_NUM", teamName, numberStr] =
+	if not $ isMaster client then
+		(noChangeClients, noChangeRooms, answerNotMaster)
+	else
+		if hhNumber < 1 || hhNumber > 8 || hhNumber > canAddNumber|| noSuchTeam then
+			(noChangeClients, noChangeRooms, answerBadParam)
+		else
+			(noChangeClients, modifyRoom $ modifyTeam clRoom team{hhnum = hhNumber}, answerHHNum teamName hhNumber)
+	where
+		hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)
+		noSuchTeam = isNothing findTeam
+		team = fromJust findTeam
+		findTeam = find (\t -> teamName == teamname t) $ teams clRoom
+		clRoom = roomByName (room client) rooms
+		canAddNumber = 18 - (sum . map hhnum $ teams clRoom)
 
 
 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd)