diff -r bf91f935feff -r 9d43a6e6b9ca netserver/HWProto.hs --- 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)