3 |
3 |
4 import qualified Data.Foldable as Foldable |
4 import qualified Data.Foldable as Foldable |
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 Data.Maybe |
9 import qualified Data.ByteString.Char8 as B |
9 import qualified Data.ByteString.Char8 as B |
|
10 import Control.Monad |
|
11 import Control.Monad.Reader |
10 -------------------------------------- |
12 -------------------------------------- |
11 import CoreTypes |
13 import CoreTypes |
12 import Actions |
14 import Actions |
13 import Utils |
15 import Utils |
14 import HandlerUtils |
16 import HandlerUtils |
15 |
17 import RoomsAndClients |
16 |
18 |
17 handleCmd_inRoom :: CmdHandler |
19 handleCmd_inRoom :: CmdHandler |
18 |
20 |
19 handleCmd_inRoom ["CHAT", msg] = do |
21 handleCmd_inRoom ["CHAT", msg] = do |
20 n <- clientNick |
22 n <- clientNick |
37 else |
39 else |
38 return [ProtocolError "Not room master"] |
40 return [ProtocolError "Not room master"] |
39 |
41 |
40 handleCmd_inRoom ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo) |
42 handleCmd_inRoom ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo) |
41 | length hhsInfo /= 16 = return [ProtocolError "Corrupted hedgehogs info"] |
43 | length hhsInfo /= 16 = return [ProtocolError "Corrupted hedgehogs info"] |
42 {- | length (teams room) == 6 = [Warning "too many teams"] |
44 | otherwise = do |
43 | canAddNumber <= 0 = [Warning "too many hedgehogs"] |
45 (ci, rnc) <- ask |
44 | isJust findTeam = [Warning "There's already a team with same name in the list"] |
46 let r = room rnc $ clientRoom rnc ci |
45 | gameinprogress room = [Warning "round in progress"] |
47 clNick <- clientNick |
46 | isRestrictedTeams room = [Warning "restricted"] |
48 clChan <- thisClientChans |
47 | otherwise = |
49 othersChans <- roomOthersChans |
48 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
50 return $ |
49 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}), |
51 if null . drop 5 $ teams r then |
50 AnswerThisClient ["TEAM_ACCEPTED", name], |
52 [Warning "too many teams"] |
51 AnswerOthersInRoom $ teamToNet (clientProto client) newTeam, |
53 else if canAddNumber r <= 0 then |
52 AnswerOthersInRoom ["TEAM_COLOR", name, color] |
54 [Warning "too many hedgehogs"] |
53 ] |
55 else if isJust $ findTeam r then |
54 where |
56 [Warning "There's already a team with same name in the list"] |
55 client = clients IntMap.! clID |
57 else if gameinprogress r then |
56 room = rooms IntMap.! (roomID client) |
58 [Warning "round in progress"] |
57 canAddNumber = 48 - (sum . map hhnum $ teams room) |
59 else if isRestrictedTeams r then |
58 findTeam = find (\t -> name == teamname t) $ teams room |
60 [Warning "restricted"] |
59 newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo)) |
61 else |
60 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
62 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r]}), |
|
63 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}), |
|
64 AnswerClients clChan ["TEAM_ACCEPTED", name], |
|
65 AnswerClients othersChans $ teamToNet $ newTeam ci clNick r, |
|
66 AnswerClients othersChans ["TEAM_COLOR", name, color] |
|
67 ] |
|
68 where |
|
69 canAddNumber r = 48 - (sum . map hhnum $ teams r) |
|
70 findTeam = find (\t -> name == teamname t) . teams |
|
71 newTeam ci clNick r = (TeamInfo ci clNick name color grave fort voicepack flag difficulty (newTeamHHNum r) (hhsList hhsInfo)) |
|
72 difficulty = case B.readInt difStr of |
|
73 Just (i, t) | B.null t -> fromIntegral i |
|
74 otherwise -> 0 |
61 hhsList [] = [] |
75 hhsList [] = [] |
62 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
76 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
63 newTeamHHNum = min 4 canAddNumber |
77 newTeamHHNum r = min 4 (canAddNumber r) |
64 -} |
|
65 {- |
78 {- |
66 handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName] |
79 handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName] |
67 | noSuchTeam = [Warning "REMOVE_TEAM: no such team"] |
80 | noSuchTeam = [Warning "REMOVE_TEAM: no such team"] |
68 | nick client /= teamowner team = [ProtocolError "Not team owner!"] |
81 | nick client /= teamowner team = [ProtocolError "Not team owner!"] |
69 | otherwise = |
82 | otherwise = |