netserver/HWProto.hs
changeset 1330 12c13ffb426f
parent 1329 69ddc231a911
child 1331 ae291cfd617a
equal deleted inserted replaced
1329:69ddc231a911 1330:12c13ffb426f
    36 	where
    36 	where
    37 		hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team
    37 		hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team
    38 answerHHNum teamName hhNumber = [(othersInRoom, ["HH_NUM", teamName, show hhNumber])]
    38 answerHHNum teamName hhNumber = [(othersInRoom, ["HH_NUM", teamName, show hhNumber])]
    39 answerRemoveTeam teamName = [(othersInRoom, ["REMOVE_TEAM", teamName])]
    39 answerRemoveTeam teamName = [(othersInRoom, ["REMOVE_TEAM", teamName])]
    40 answerNotOwner = [(clientOnly, ["ERROR", "You do not own this team"])]
    40 answerNotOwner = [(clientOnly, ["ERROR", "You do not own this team"])]
       
    41 answerTeamColor teamName newColor = [(othersInRoom, ["TEAM_COLOR", teamName, newColor])]
    41 
    42 
    42 -- Main state-independent cmd handler
    43 -- Main state-independent cmd handler
    43 handleCmd :: CmdHandler
    44 handleCmd :: CmdHandler
    44 handleCmd client _ rooms ("QUIT":xs) =
    45 handleCmd client _ rooms ("QUIT":xs) =
    45 	if null (room client) then
    46 	if null (room client) then
   162 		team = fromJust findTeam
   163 		team = fromJust findTeam
   163 		findTeam = find (\t -> teamName == teamname t) $ teams clRoom
   164 		findTeam = find (\t -> teamName == teamname t) $ teams clRoom
   164 		clRoom = roomByName (room client) rooms
   165 		clRoom = roomByName (room client) rooms
   165 		canAddNumber = 18 - (sum . map hhnum $ teams clRoom)
   166 		canAddNumber = 18 - (sum . map hhnum $ teams clRoom)
   166 
   167 
       
   168 handleCmd_inRoom client _ rooms ["TEAM_COLOR", teamName, newColor] =
       
   169 	if not $ isMaster client then
       
   170 		(noChangeClients, noChangeRooms, answerNotMaster)
       
   171 	else
       
   172 		(noChangeClients, modifyRoom $ modifyTeam clRoom team{teamcolor = newColor}, answerTeamColor teamName newColor)
       
   173 	where
       
   174 		noSuchTeam = isNothing findTeam
       
   175 		team = fromJust findTeam
       
   176 		findTeam = find (\t -> teamName == teamname t) $ teams clRoom
       
   177 		clRoom = roomByName (room client) rooms
       
   178 
   167 handleCmd_inRoom client _ rooms ["REMOVE_TEAM", teamName] =
   179 handleCmd_inRoom client _ rooms ["REMOVE_TEAM", teamName] =
   168 	if noSuchTeam then
   180 	if noSuchTeam then
   169 		(noChangeClients, noChangeRooms, answerBadParam)
   181 		(noChangeClients, noChangeRooms, answerBadParam)
   170 	else
   182 	else
   171 		if not $ nick client == teamowner team then
   183 		if not $ nick client == teamowner team then