1 {-# LANGUAGE OverloadedStrings #-} |
1 {-# LANGUAGE OverloadedStrings #-} |
2 module HWProtoInRoomState where |
2 module HWProtoInRoomState where |
3 |
3 |
4 import qualified Data.Map as Map |
4 import qualified Data.Map as Map |
5 import Data.Sequence((|>)) |
5 import Data.Sequence((|>)) |
6 import Data.List |
6 import Data.List as L |
7 import Data.Maybe |
7 import Data.Maybe |
8 import qualified Data.ByteString.Char8 as B |
8 import qualified Data.ByteString.Char8 as B |
9 import Control.Monad |
9 import Control.Monad |
10 import Control.Monad.Reader |
10 import Control.Monad.Reader |
11 -------------------------------------- |
11 -------------------------------------- |
50 (ci, _) <- ask |
50 (ci, _) <- ask |
51 rm <- thisRoom |
51 rm <- thisRoom |
52 clNick <- clientNick |
52 clNick <- clientNick |
53 clChan <- thisClientChans |
53 clChan <- thisClientChans |
54 othChans <- roomOthersChans |
54 othChans <- roomOthersChans |
|
55 roomChans <- roomClientsChans |
|
56 cl <- thisClient |
|
57 teamColor <- |
|
58 if clientProto cl < 42 then |
|
59 return color |
|
60 else |
|
61 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
55 return $ |
62 return $ |
56 if not . null . drop (maxTeams rm - 1) $ teams rm then |
63 if not . null . drop (maxTeams rm - 1) $ teams rm then |
57 [Warning "too many teams"] |
64 [Warning "too many teams"] |
58 else if canAddNumber rm <= 0 then |
65 else if canAddNumber rm <= 0 then |
59 [Warning "too many hedgehogs"] |
66 [Warning "too many hedgehogs"] |
62 else if isJust $ gameInfo rm then |
69 else if isJust $ gameInfo rm then |
63 [Warning "round in progress"] |
70 [Warning "round in progress"] |
64 else if isRestrictedTeams rm then |
71 else if isRestrictedTeams rm then |
65 [Warning "restricted"] |
72 [Warning "restricted"] |
66 else |
73 else |
67 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r]}), |
74 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r teamColor]}), |
68 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just color}), |
75 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
69 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
76 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
70 AnswerClients othChans $ teamToNet $ newTeam ci clNick rm, |
77 AnswerClients othChans $ teamToNet $ newTeam ci clNick rm teamColor, |
71 AnswerClients othChans ["TEAM_COLOR", tName, color] |
78 AnswerClients roomChans ["TEAM_COLOR", tName, teamColor] |
72 ] |
79 ] |
73 where |
80 where |
74 canAddNumber r = 48 - (sum . map hhnum $ teams r) |
81 canAddNumber r = 48 - (sum . map hhnum $ teams r) |
75 findTeam = find (\t -> tName == teamname t) . teams |
82 findTeam = find (\t -> tName == teamname t) . teams |
76 newTeam ci clNick r = TeamInfo ci clNick tName color grave fort voicepack flag dif (newTeamHHNum r) (hhsList hhsInfo) |
83 newTeam ci clNick r tColor = TeamInfo ci clNick tName tColor grave fort voicepack flag dif (newTeamHHNum r) (hhsList hhsInfo) |
77 dif = readInt_ difStr |
84 dif = readInt_ difStr |
78 hhsList [] = [] |
85 hhsList [] = [] |
79 hhsList [_] = error "Hedgehogs list with odd elements number" |
86 hhsList [_] = error "Hedgehogs list with odd elements number" |
80 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
87 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
81 newTeamHHNum r = min 4 (canAddNumber r) |
88 newTeamHHNum r = min 4 (canAddNumber r) |