author | koda |
Sat, 27 Mar 2010 16:57:18 +0000 | |
changeset 3113 | 2829ea0dd47c |
parent 2960 | b467a681c5e0 |
child 3435 | 4e4f88a7bdf2 |
permissions | -rw-r--r-- |
module HWProtoInRoomState where import qualified Data.Foldable as Foldable import qualified Data.IntMap as IntMap import qualified Data.Map as Map import Data.Sequence(Seq, (|>), (><), fromList, empty) import Data.List import Maybe -------------------------------------- import CoreTypes import Actions import Utils handleCmd_inRoom :: CmdHandler handleCmd_inRoom clID clients _ ["CHAT", msg] = [AnswerOthersInRoom ["CHAT", clientNick, msg]] where clientNick = nick $ clients IntMap.! clID handleCmd_inRoom clID clients rooms ["PART"] = [RoomRemoveThisClient "part"] where client = clients IntMap.! clID handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs) | null paramStrs = [ProtocolError "Empty config entry"] | isMaster client = [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}), AnswerOthersInRoom ("CFG" : paramName : paramStrs)] | otherwise = [ProtocolError "Not room master"] where client = clients IntMap.! clID handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo) | length hhsInfo == 15 && clientProto client < 30 = handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : " " : flag : difStr : hhsInfo) | length hhsInfo /= 16 = [ProtocolError "Corrupted hedgehogs info"] | length (teams room) == 6 = [Warning "too many teams"] | canAddNumber <= 0 = [Warning "too many hedgehogs"] | isJust findTeam = [Warning "There's already a team with same name in the list"] | gameinprogress room = [Warning "round in progress"] | isRestrictedTeams room = [Warning "restricted"] | otherwise = [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}), AnswerThisClient ["TEAM_ACCEPTED", name], AnswerOthersInRoom $ teamToNet (clientProto client) newTeam, AnswerOthersInRoom ["TEAM_COLOR", name, color] ] where client = clients IntMap.! clID room = rooms IntMap.! (roomID client) canAddNumber = 48 - (sum . map hhnum $ teams room) findTeam = find (\t -> name == teamname t) $ teams room newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo)) difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) hhsList [] = [] hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs newTeamHHNum = min 4 canAddNumber handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName] | noSuchTeam = [Warning "REMOVE_TEAM: no such team"] | nick client /= teamowner team = [ProtocolError "Not team owner!"] | otherwise = [RemoveTeam teamName, ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1, clientClan = if teamsInGame client == 1 then undefined else anotherTeamClan}) ] where client = clients IntMap.! clID room = rooms IntMap.! (roomID client) noSuchTeam = isNothing findTeam team = fromJust findTeam findTeam = find (\t -> teamName == teamname t) $ teams room anotherTeamClan = teamcolor $ fromJust $ find (\t -> teamownerId t == clID) $ teams room handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr] | not $ isMaster client = [ProtocolError "Not room master"] | hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) = [] | otherwise = [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]] where client = clients IntMap.! clID room = rooms IntMap.! (roomID client) hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int) noSuchTeam = isNothing findTeam team = fromJust findTeam findTeam = find (\t -> teamName == teamname t) $ teams room canAddNumber = 48 - (sum . map hhnum $ teams room) handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor] | not $ isMaster client = [ProtocolError "Not room master"] | noSuchTeam = [] | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor}, AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor], ModifyClient2 (teamownerId team) (\c -> c{clientClan = newColor})] where noSuchTeam = isNothing findTeam team = fromJust findTeam findTeam = find (\t -> teamName == teamname t) $ teams room client = clients IntMap.! clID room = rooms IntMap.! (roomID client) handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] = [ModifyClient (\c -> c{isReady = not $ isReady client}), ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}), AnswerThisRoom [if isReady client then "NOT_READY" else "READY", nick client]] where client = clients IntMap.! clID handleCmd_inRoom clID clients rooms ["START_GAME"] = if isMaster client && (playersIn room == readyPlayers room) && (not . gameinprogress) room then if enoughClans then [ModifyRoom (\r -> r{ gameinprogress = True, roundMsgs = empty, leftTeams = [], teamsAtStart = teams r} ), AnswerThisRoom ["RUN_GAME"]] else [Warning "Less than two clans!"] else [] where client = clients IntMap.! clID room = rooms IntMap.! (roomID client) enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room handleCmd_inRoom clID clients rooms ["EM", msg] = if (teamsInGame client > 0) && isLegal then (AnswerOthersInRoom ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive] else [] where client = clients IntMap.! clID (isLegal, isKeepAlive) = checkNetCmd msg handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] = if isMaster client then [ModifyRoom (\r -> r{ gameinprogress = False, readyPlayers = 0, roundMsgs = empty, leftTeams = [], teamsAtStart = []} ), UnreadyRoomClients ] ++ answerRemovedTeams else [] where client = clients IntMap.! clID room = rooms IntMap.! (roomID client) answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_JOINS"] | isMaster client = [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})] | otherwise = [ProtocolError "Not room master"] where client = clients IntMap.! clID handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_TEAMS"] | isMaster client = [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})] | otherwise = [ProtocolError "Not room master"] where client = clients IntMap.! clID handleCmd_inRoom clID clients rooms ["KICK", kickNick] = [KickRoomClient kickID | isMaster client && not noSuchClient && (kickID /= clID) && (roomID client == roomID kickClient)] where client = clients IntMap.! clID maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients noSuchClient = isNothing maybeClient kickClient = fromJust maybeClient kickID = clientUID kickClient handleCmd_inRoom clID clients _ ["TEAMCHAT", msg] = [AnswerSameClan ["EM", engineMsg]] where client = clients IntMap.! clID engineMsg = toEngineMsg $ 'b' : ((nick client) ++ "(team): " ++ msg ++ "\x20\x20") handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]