netserver/HWProto.hs
changeset 1329 69ddc231a911
parent 1328 c41344e3c236
child 1330 12c13ffb426f
equal deleted inserted replaced
1328:c41344e3c236 1329:69ddc231a911
    35 answerAddTeam team = [(othersInRoom, ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo)]
    35 answerAddTeam team = [(othersInRoom, ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo)]
    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 
    41 
    41 -- Main state-independent cmd handler
    42 -- Main state-independent cmd handler
    42 handleCmd :: CmdHandler
    43 handleCmd :: CmdHandler
    43 handleCmd client _ rooms ("QUIT":xs) =
    44 handleCmd client _ rooms ("QUIT":xs) =
    44 	if null (room client) then
    45 	if null (room client) then
   137 		(noChangeClients, noChangeRooms, answerCantAdd)
   138 		(noChangeClients, noChangeRooms, answerCantAdd)
   138 	else
   139 	else
   139 		(noChangeClients, modifyRoom clRoom{teams = newTeam : teams clRoom}, answerTeamAccepted newTeam ++ answerAddTeam newTeam)
   140 		(noChangeClients, modifyRoom clRoom{teams = newTeam : teams clRoom}, answerTeamAccepted newTeam ++ answerAddTeam newTeam)
   140 	where
   141 	where
   141 		clRoom = roomByName (room client) rooms
   142 		clRoom = roomByName (room client) rooms
   142 		newTeam = (TeamInfo name color grave fort difficulty newTeamHHNum (hhsList hhsInfo))
   143 		newTeam = (TeamInfo (nick client) name color grave fort difficulty newTeamHHNum (hhsList hhsInfo))
   143 		findTeam = find (\t -> name == teamname t) $ teams clRoom
   144 		findTeam = find (\t -> name == teamname t) $ teams clRoom
   144 		difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
   145 		difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
   145 		hhsList [] = []
   146 		hhsList [] = []
   146 		hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
   147 		hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
   147 		canAddNumber = 18 - (sum . map hhnum $ teams clRoom)
   148 		canAddNumber = 18 - (sum . map hhnum $ teams clRoom)
   149 
   150 
   150 handleCmd_inRoom client _ rooms ["HH_NUM", teamName, numberStr] =
   151 handleCmd_inRoom client _ rooms ["HH_NUM", teamName, numberStr] =
   151 	if not $ isMaster client then
   152 	if not $ isMaster client then
   152 		(noChangeClients, noChangeRooms, answerNotMaster)
   153 		(noChangeClients, noChangeRooms, answerNotMaster)
   153 	else
   154 	else
   154 		if hhNumber < 1 || hhNumber > 8 || hhNumber > canAddNumber|| noSuchTeam then
   155 		if hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) then
   155 			(noChangeClients, noChangeRooms, answerBadParam)
   156 			(noChangeClients, noChangeRooms, answerBadParam)
   156 		else
   157 		else
   157 			(noChangeClients, modifyRoom $ modifyTeam clRoom team{hhnum = hhNumber}, answerHHNum teamName hhNumber)
   158 			(noChangeClients, modifyRoom $ modifyTeam clRoom team{hhnum = hhNumber}, answerHHNum teamName hhNumber)
   158 	where
   159 	where
   159 		hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)
   160 		hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)
   162 		findTeam = find (\t -> teamName == teamname t) $ teams clRoom
   163 		findTeam = find (\t -> teamName == teamname t) $ teams clRoom
   163 		clRoom = roomByName (room client) rooms
   164 		clRoom = roomByName (room client) rooms
   164 		canAddNumber = 18 - (sum . map hhnum $ teams clRoom)
   165 		canAddNumber = 18 - (sum . map hhnum $ teams clRoom)
   165 
   166 
   166 handleCmd_inRoom client _ rooms ["REMOVE_TEAM", teamName] =
   167 handleCmd_inRoom client _ rooms ["REMOVE_TEAM", teamName] =
   167 	if not $ isMaster client then
   168 	if noSuchTeam then
   168 		(noChangeClients, noChangeRooms, answerNotMaster)
   169 		(noChangeClients, noChangeRooms, answerBadParam)
   169 	else
   170 	else
   170 		if noSuchTeam then
   171 		if not $ nick client == teamowner team then
   171 			(noChangeClients, noChangeRooms, answerBadParam)
   172 			(noChangeClients, noChangeRooms, answerNotOwner)
   172 		else
   173 		else
   173 			(noChangeClients, modifyRoom clRoom{teams = filter (\t -> teamName /= teamname t) $ teams clRoom}, answerRemoveTeam teamName)
   174 			(noChangeClients, modifyRoom clRoom{teams = filter (\t -> teamName /= teamname t) $ teams clRoom}, answerRemoveTeam teamName)
   174 	where
   175 	where
   175 		noSuchTeam = isNothing findTeam
   176 		noSuchTeam = isNothing findTeam
   176 		team = fromJust findTeam
   177 		team = fromJust findTeam