4 import qualified Data.IntMap as IntMap |
4 import qualified Data.IntMap as IntMap |
5 import qualified Data.Map as Map |
5 import qualified Data.Map as Map |
6 import Data.Sequence(Seq, (|>), (><), fromList, empty) |
6 import Data.Sequence(Seq, (|>), (><), fromList, empty) |
7 import Data.List |
7 import Data.List |
8 import Maybe |
8 import Maybe |
|
9 import qualified Codec.Binary.UTF8.String as UTF8 |
9 -------------------------------------- |
10 -------------------------------------- |
10 import CoreTypes |
11 import CoreTypes |
11 import Actions |
12 import Actions |
12 import Utils |
13 import Utils |
13 |
14 |
47 | isJust findTeam = [Warning "There's already a team with same name in the list"] |
48 | isJust findTeam = [Warning "There's already a team with same name in the list"] |
48 | gameinprogress room = [Warning "round in progress"] |
49 | gameinprogress room = [Warning "round in progress"] |
49 | isRestrictedTeams room = [Warning "restricted"] |
50 | isRestrictedTeams room = [Warning "restricted"] |
50 | otherwise = |
51 | otherwise = |
51 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
52 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
52 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1}), |
53 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}), |
53 AnswerThisClient ["TEAM_ACCEPTED", name], |
54 AnswerThisClient ["TEAM_ACCEPTED", name], |
54 AnswerOthersInRoom $ teamToNet newTeam, |
55 AnswerOthersInRoom $ teamToNet newTeam, |
55 AnswerOthersInRoom ["TEAM_COLOR", name, color] |
56 AnswerOthersInRoom ["TEAM_COLOR", name, color] |
56 ] |
57 ] |
57 where |
58 where |
58 client = clients IntMap.! clID |
59 client = clients IntMap.! clID |
59 room = rooms IntMap.! (roomID client) |
60 room = rooms IntMap.! (roomID client) |
60 canAddNumber = 48 - (sum . map hhnum $ teams room) |
61 canAddNumber = 48 - (sum . map hhnum $ teams room) |
61 findTeam = find (\t -> name == teamname t) $ teams room |
62 findTeam = find (\t -> name == teamname t) $ teams room |
62 newTeam = (TeamInfo (nick client) name color grave fort voicepack difficulty newTeamHHNum (hhsList hhsInfo)) |
63 newTeam = (TeamInfo clID (nick client) name color grave fort voicepack difficulty newTeamHHNum (hhsList hhsInfo)) |
63 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
64 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
64 hhsList [] = [] |
65 hhsList [] = [] |
65 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
66 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
66 newTeamHHNum = min 4 canAddNumber |
67 newTeamHHNum = min 4 canAddNumber |
67 |
68 |
99 |
100 |
100 handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor] |
101 handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor] |
101 | not $ isMaster client = [ProtocolError "Not room master"] |
102 | not $ isMaster client = [ProtocolError "Not room master"] |
102 | noSuchTeam = [] |
103 | noSuchTeam = [] |
103 | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
104 | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
104 AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor]] |
105 AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor], |
|
106 ModifyClient2 (teamownerId team) (\c -> c{clientClan = newColor})] |
105 where |
107 where |
106 noSuchTeam = isNothing findTeam |
108 noSuchTeam = isNothing findTeam |
107 team = fromJust findTeam |
109 team = fromJust findTeam |
108 findTeam = find (\t -> teamName == teamname t) $ teams room |
110 findTeam = find (\t -> teamName == teamname t) $ teams room |
109 client = clients IntMap.! clID |
111 client = clients IntMap.! clID |
189 noSuchClient = isNothing maybeClient |
191 noSuchClient = isNothing maybeClient |
190 kickClient = fromJust maybeClient |
192 kickClient = fromJust maybeClient |
191 kickID = clientUID kickClient |
193 kickID = clientUID kickClient |
192 |
194 |
193 |
195 |
|
196 handleCmd_inRoom clID clients _ ["TEAMCHAT", msg] = |
|
197 if (teamsInGame client > 0) then |
|
198 [AnswerSameClan ["EM", engineMsg]] |
|
199 else |
|
200 [] |
|
201 where |
|
202 client = clients IntMap.! clID |
|
203 engineMsg = toEngineMsg $ 'b' : (nick client ++ "(team): " ++ decodedMsg ++ "\x20\x20") |
|
204 decodedMsg = UTF8.decodeString msg |
|
205 |
194 handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"] |
206 handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"] |