author  unc0rr 
Thu, 05 Dec 2013 00:51:27 +0400  
changeset 9753  9579596cf471 
parent 9715  30a303d226f9 
child 9770  5706b637bae2 
permissions  rwrr 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

1 
{# LANGUAGE OverloadedStrings #} 
1804  2 
module HWProtoInRoomState where 
3 

4 
import qualified Data.Map as Map 

7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset

5 
import Data.List as L 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

6 
import Data.Maybe 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

7 
import qualified Data.ByteString.Char8 as B 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

8 
import Control.Monad 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

9 
import Control.Monad.Reader 
1804  10 
 
11 
import CoreTypes 

12 
import Actions 

13 
import Utils 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

14 
import HandlerUtils 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

15 
import RoomsAndClients 
6068  16 
import EngineInteraction 
1804  17 

4989  18 
handleCmd_inRoom :: CmdHandler 
1804  19 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

20 
handleCmd_inRoom ["CHAT", msg] = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

21 
n < clientNick 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

22 
s < roomOthersChans 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

23 
return [AnswerClients s ["CHAT", n, msg]] 
1804  24 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

25 
handleCmd_inRoom ["PART"] = return [MoveToLobby "part"] 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

26 
handleCmd_inRoom ["PART", msg] = return [MoveToLobby $ "part: " `B.append` msg] 
3531  27 

1811  28 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

29 
handleCmd_inRoom ("CFG" : paramName : paramStrs) 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

30 
 null paramStrs = return [ProtocolError $ loc "Empty config entry"] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

31 
 otherwise = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

32 
chans < roomOthersChans 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

33 
cl < thisClient 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

34 
if isMaster cl then 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

35 
return [ 
4941  36 
ModifyRoom f, 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

37 
AnswerClients chans ("CFG" : paramName : paramStrs)] 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

38 
else 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

39 
return [ProtocolError $ loc "Not room master"] 
4941  40 
where 
41 
f r = if paramName `Map.member` (mapParams r) then 

42 
r{mapParams = Map.insert paramName (head paramStrs) (mapParams r)} 

43 
else 

44 
r{params = Map.insert paramName paramStrs (params r)} 

1804  45 

9753
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

46 

4932  47 
handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo) 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

48 
 length hhsInfo /= 16 = return [ProtocolError $ loc "Corrupted hedgehogs info"] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

49 
 otherwise = do 
4932  50 
(ci, _) < ask 
51 
rm < thisRoom 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

52 
clNick < clientNick 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

53 
clChan < thisClientChans 
4932  54 
othChans < roomOthersChans 
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset

55 
roomChans < roomClientsChans 
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset

56 
cl < thisClient 
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset

57 
teamColor < 
8924  58 
if clientProto cl < 42 then 
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset

59 
return color 
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset

60 
else 
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset

61 
liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom 
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset

62 
let roomTeams = teams rm 
8897
d6c310c65c91
 Revert server workaround over desync from r98e2dbdda8c0
unc0rr
parents:
8757
diff
changeset

63 
let hhNum = let p = if not $ null roomTeams then minimum [hhnum $ head roomTeams, canAddNumber roomTeams] else 4 in newTeamHHNum roomTeams p 
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset

64 
let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif hhNum (hhsList hhsInfo) 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

65 
return $ 
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset

66 
if not . null . drop (maxTeams rm  1) $ roomTeams then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

67 
[Warning $ loc "too many teams"] 
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset

68 
else if canAddNumber roomTeams <= 0 then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

69 
[Warning $ loc "too many hedgehogs"] 
4932  70 
else if isJust $ findTeam rm then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

71 
[Warning $ loc "There's already a team with same name in the list"] 
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5931
diff
changeset

72 
else if isJust $ gameInfo rm then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

73 
[Warning $ loc "round in progress"] 
4932  74 
else if isRestrictedTeams rm then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

75 
[Warning $ loc "restricted"] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

76 
else 
7986
53b1da5ee7f4
Maybe this caused server crashes? Add more strictness on team owner record field
unc0rr
parents:
7947
diff
changeset

77 
[ModifyRoom (\r > r{teams = teams r ++ [newTeam]}), 
7921
6b074de32bea
Send ROOM UPD message when team is added/deleted from room, and when game starts or finishes
unc0rr
parents:
7862
diff
changeset

78 
SendUpdateOnThisRoom, 
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset

79 
ModifyClient (\c > c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), 
4932  80 
AnswerClients clChan ["TEAM_ACCEPTED", tName], 
8550
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset

81 
AnswerClients othChans $ teamToNet $ newTeam, 
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset

82 
AnswerClients roomChans ["TEAM_COLOR", tName, teamColor], 
8899  83 
AnswerClients roomChans ["HH_NUM", tName, showB $ hhnum newTeam] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

84 
] 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

85 
where 
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset

86 
canAddNumber rt = (48::Int)  (sum $ map hhnum rt) 
4932  87 
findTeam = find (\t > tName == teamname t) . teams 
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset

88 
dif = readInt_ difStr 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

89 
hhsList [] = [] 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

90 
hhsList [_] = error "Hedgehogs list with odd elements number" 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

91 
hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs 
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset

92 
newTeamHHNum rt p = min p (canAddNumber rt) 
7321
57bd4f201401
 Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset

93 
maxTeams r 
5931  94 
 roomProto r < 38 = 6 
95 
 otherwise = 8 

7321
57bd4f201401
 Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset

96 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

97 

4932  98 
handleCmd_inRoom ["REMOVE_TEAM", tName] = do 
99 
(ci, _) < ask 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

100 
r < thisRoom 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

101 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

102 
let maybeTeam = findTeam r 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

103 
let team = fromJust maybeTeam 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

104 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

105 
return $ 
8428  106 
if isNothing $ maybeTeam then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

107 
[Warning $ loc "REMOVE_TEAM: no such team"] 
8431  108 
else if ci /= teamownerId team then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

109 
[ProtocolError $ loc "Not team owner!"] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

110 
else 
4932  111 
[RemoveTeam tName, 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

112 
ModifyClient 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

113 
(\c > c{ 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

114 
teamsInGame = teamsInGame c  1, 
8433  115 
clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci team r 
4989  116 
}) 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

117 
] 
4568  118 
where 
8433  119 
anotherTeamClan ci team = teamcolor . fromMaybe (error "CHECKPOINT 011") . find (\t > (teamownerId t == ci) && (t /= team)) . teams 
4932  120 
findTeam = find (\t > tName == teamname t) . teams 
3561  121 

3568  122 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

123 
handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

124 
cl < thisClient 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

125 
r < thisRoom 
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset

126 
clChan < thisClientChans 
8477
330b0b8846cf
Don't confirm hogs number to room admin when no constraint hit
unc0rr
parents:
8433
diff
changeset

127 
others < roomOthersChans 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

128 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

129 
let maybeTeam = findTeam r 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

130 
let team = fromJust maybeTeam 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

131 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

132 
return $ 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

133 
if not $ isMaster cl then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

134 
[ProtocolError $ loc "Not room master"] 
8429  135 
else if isNothing maybeTeam then 
136 
[] 

8428  137 
else if hhNumber < 1  hhNumber > 8  hhNumber > canAddNumber r + hhnum team then 
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset

138 
[AnswerClients clChan ["HH_NUM", teamName, showB $ hhnum team]] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

139 
else 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

140 
[ModifyRoom $ modifyTeam team{hhnum = hhNumber}, 
8477
330b0b8846cf
Don't confirm hogs number to room admin when no constraint hit
unc0rr
parents:
8433
diff
changeset

141 
AnswerClients others ["HH_NUM", teamName, showB hhNumber]] 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

142 
where 
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset

143 
hhNumber = readInt_ numberStr 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

144 
findTeam = find (\t > teamName == teamname t) . teams 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

145 
canAddNumber = () 48 . sum . map hhnum . teams 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

146 

1804  147 

3568  148 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

149 
handleCmd_inRoom ["TEAM_COLOR", teamName, newColor] = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

150 
cl < thisClient 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

151 
others < roomOthersChans 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

152 
r < thisRoom 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

153 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

154 
let maybeTeam = findTeam r 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

155 
let team = fromJust maybeTeam 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

156 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

157 
return $ 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

158 
if not $ isMaster cl then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

159 
[ProtocolError $ loc "Not room master"] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

160 
else if isNothing maybeTeam then 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

161 
[] 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

162 
else 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

163 
[ModifyRoom $ modifyTeam team{teamcolor = newColor}, 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

164 
AnswerClients others ["TEAM_COLOR", teamName, newColor], 
4986
33fe91b2bcbf
Use Maybe for storing client's clan, allows less errorprone spectator checks
unc0rr
parents:
4975
diff
changeset

165 
ModifyClient2 (teamownerId team) (\c > c{clientClan = Just newColor})] 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

166 
where 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

167 
findTeam = find (\t > teamName == teamname t) . teams 
3568  168 

1804  169 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

170 
handleCmd_inRoom ["TOGGLE_READY"] = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

171 
cl < thisClient 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

172 
chans < roomClientsChans 
8983  173 

174 
return [ 

175 
ModifyRoom (\r > r{readyPlayers = readyPlayers r + (if isReady cl then 1 else 1)}), 

176 
ModifyClient (\c > c{isReady = not $ isReady cl}), 

177 
AnswerClients chans $ if clientProto cl < 38 then 

178 
[if isReady cl then "NOT_READY" else "READY", nick cl] 

179 
else 

180 
["CLIENT_FLAGS", if isReady cl then "r" else "+r", nick cl] 

181 
] 

1804  182 

8513  183 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

184 
handleCmd_inRoom ["START_GAME"] = do 
6012  185 
(ci, rnc) < ask 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

186 
cl < thisClient 
4932  187 
rm < thisRoom 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

188 
chans < roomClientsChans 
7321
57bd4f201401
 Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset

189 

7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset

190 
let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci 
6012  191 
let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm 
3577  192 

8418
4543cc2049af
Forcestarting a game now only works for client versions >43
dag10
parents:
8416
diff
changeset

193 
if isMaster cl && (playersIn rm == readyPlayers rm  clientProto cl > 43) && not (isJust $ gameInfo rm) then 
4932  194 
if enoughClans rm then 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

195 
return [ 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

196 
ModifyRoom 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

197 
(\r > r{ 
6756
344d32bb1328
Also consider game finished when the last player reports ROUNDFINISHED despite the correctness parameter.
unc0rr
parents:
6753
diff
changeset

198 
gameInfo = Just $ newGameInfo (teams rm) (length $ teams rm) allPlayersRegistered (mapParams rm) (params rm) 
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5931
diff
changeset

199 
} 
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset

200 
) 
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset

201 
, AnswerClients chans ["RUN_GAME"] 
7921
6b074de32bea
Send ROOM UPD message when team is added/deleted from room, and when game starts or finishes
unc0rr
parents:
7862
diff
changeset

202 
, SendUpdateOnThisRoom 
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset

203 
, AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks 
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset

204 
, ModifyRoomClients (\c > c{isInGame = True}) 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

205 
] 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

206 
else 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

207 
return [Warning $ loc "Less than two clans!"] 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

208 
else 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

209 
return [] 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

210 
where 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

211 
enoughClans = not . null . drop 1 . group . map teamcolor . teams 
1804  212 

213 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

214 
handleCmd_inRoom ["EM", msg] = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

215 
cl < thisClient 
4932  216 
rm < thisRoom 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

217 
chans < roomOthersChans 
4931
da43c36a6e92
Don't accept EM message when the game isn't started
unc0rr
parents:
4917
diff
changeset

218 

8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset

219 
if teamsInGame cl > 0 && (isJust $ gameInfo rm) && (not $ B.null legalMsgs) then 
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset

220 
return $ AnswerClients chans ["EM", legalMsgs] 
9304
3f4c3fc146c2
Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents:
9035
diff
changeset

221 
: [ModifyRoom (\r > r{gameInfo = liftM 
3f4c3fc146c2
Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents:
9035
diff
changeset

222 
(\g > g{ 
3f4c3fc146c2
Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents:
9035
diff
changeset

223 
roundMsgs = if B.null nonEmptyMsgs then roundMsgs g else nonEmptyMsgs : roundMsgs g 
3f4c3fc146c2
Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents:
9035
diff
changeset

224 
, lastFilteredTimedMsg = fromMaybe (lastFilteredTimedMsg g) lastFTMsg}) 
3f4c3fc146c2
Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents:
9035
diff
changeset

225 
$ gameInfo r})] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

226 
else 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

227 
return [] 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

228 
where 
9304
3f4c3fc146c2
Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents:
9035
diff
changeset

229 
(legalMsgs, nonEmptyMsgs, lastFTMsg) = checkNetCmd msg 
1804  230 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

231 

8550
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset

232 
handleCmd_inRoom ["ROUNDFINISHED", _] = do 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

233 
cl < thisClient 
4932  234 
rm < thisRoom 
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset

235 
chans < roomClientsChans 
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset

236 

6753
e95b1f62d0de
Don't remove client's teams from teams list on "ROUNDFINISHED 0", just send team removal message to others.
unc0rr
parents:
6738
diff
changeset

237 
let clTeams = map teamname . filter (\t > teamowner t == nick cl) . teams $ rm 
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset

238 
let unsetInGameState = [AnswerClients chans ["CLIENT_FLAGS", "g", nick cl], ModifyClient (\c > c{isInGame = False})] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

239 

7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset

240 
if isInGame cl then 
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset

241 
if isJust $ gameInfo rm then 
8422  242 
return $ unsetInGameState ++ map SendTeamRemovalMessage clTeams 
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset

243 
else 
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset

244 
return unsetInGameState 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

245 
else 
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset

246 
return []  don't accept this message twice 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

247 
where 
8550
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset

248 
 isCorrect = correctly == "1" 
1811  249 

4942
1c85a8e6e11c
Okay, a compatibility layer for clients of 0.9.15 version (not sure about old versions, as I removed all compatibility hacks for older versions previously)
unc0rr
parents:
4941
diff
changeset

250 
 compatibility with clients with protocol < 38 
1c85a8e6e11c
Okay, a compatibility layer for clients of 0.9.15 version (not sure about old versions, as I removed all compatibility hacks for older versions previously)
unc0rr
parents:
4941
diff
changeset

251 
handleCmd_inRoom ["ROUNDFINISHED"] = 
1c85a8e6e11c
Okay, a compatibility layer for clients of 0.9.15 version (not sure about old versions, as I removed all compatibility hacks for older versions previously)
unc0rr
parents:
4941
diff
changeset

252 
handleCmd_inRoom ["ROUNDFINISHED", "1"] 
1c85a8e6e11c
Okay, a compatibility layer for clients of 0.9.15 version (not sure about old versions, as I removed all compatibility hacks for older versions previously)
unc0rr
parents:
4941
diff
changeset

253 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

254 
handleCmd_inRoom ["TOGGLE_RESTRICT_JOINS"] = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

255 
cl < thisClient 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

256 
return $ 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

257 
if not $ isMaster cl then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

258 
[ProtocolError $ loc "Not room master"] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

259 
else 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

260 
[ModifyRoom (\r > r{isRestrictedJoins = not $ isRestrictedJoins r})] 
4568  261 

1831  262 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

263 
handleCmd_inRoom ["TOGGLE_RESTRICT_TEAMS"] = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

264 
cl < thisClient 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

265 
return $ 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

266 
if not $ isMaster cl then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

267 
[ProtocolError $ loc "Not room master"] 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

268 
else 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

269 
[ModifyRoom (\r > r{isRestrictedTeams = not $ isRestrictedTeams r})] 
1879  270 

1831  271 

8232  272 
handleCmd_inRoom ["TOGGLE_REGISTERED_ONLY"] = do 
273 
cl < thisClient 

274 
return $ 

275 
if not $ isMaster cl then 

8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

276 
[ProtocolError $ loc "Not room master"] 
8232  277 
else 
278 
[ModifyRoom (\r > r{isRegisteredOnly = not $ isRegisteredOnly r})] 

279 

8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset

280 

5098  281 
handleCmd_inRoom ["ROOM_NAME", newName] = do 
282 
cl < thisClient 

283 
rs < allRoomInfos 

6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset

284 
rm < thisRoom 
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset

285 
chans < sameProtoChans 
7321
57bd4f201401
 Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset

286 

5098  287 
return $ 
288 
if not $ isMaster cl then 

8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

289 
[ProtocolError $ loc "Not room master"] 
5098  290 
else 
9454  291 
if illegalName newName then 
292 
[Warning $ loc "Illegal room name"] 

293 
else 

9753
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

294 
if isSpecial rm then 
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

295 
[Warning $ loc "Restricted"] 
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

296 
else 
5098  297 
if isJust $ find (\r > newName == name r) rs then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

298 
[Warning $ loc "Room with such name already exists"] 
5098  299 
else 
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset

300 
[ModifyRoom roomUpdate, 
9702  301 
AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo (clientProto cl) (nick cl) (roomUpdate rm))] 
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset

302 
where 
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset

303 
roomUpdate r = r{name = newName} 
5098  304 

305 

4614  306 
handleCmd_inRoom ["KICK", kickNick] = do 
307 
(thisClientId, rnc) < ask 

308 
maybeClientId < clientByNick kickNick 

309 
master < liftM isMaster thisClient 

8513  310 
rm < thisRoom 
4614  311 
let kickId = fromJust maybeClientId 
8513  312 
let kickCl = rnc `client` kickId 
4932  313 
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId 
8627
ea2d32a03ac9
Eh, two players condition seems to make more sense than two clans here
unc0rr
parents:
8550
diff
changeset

314 
let notOnly2Players = (length . group . sort . map teamowner . teams $ rm) > 2 
4614  315 
return 
8513  316 
[KickRoomClient kickId  
317 
master 

318 
&& isJust maybeClientId 

319 
&& (kickId /= thisClientId) 

320 
&& sameRoom 

8627
ea2d32a03ac9
Eh, two players condition seems to make more sense than two clans here
unc0rr
parents:
8550
diff
changeset

321 
&& ((isNothing $ gameInfo rm)  notOnly2Players  teamsInGame kickCl == 0) 
8513  322 
] 
1879  323 

1831  324 

8247  325 
handleCmd_inRoom ["DELEGATE", newAdmin] = do 
326 
(thisClientId, rnc) < ask 

327 
maybeClientId < clientByNick newAdmin 

328 
master < liftM isMaster thisClient 

8403
fbc6e7602e05
 Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset

329 
serverAdmin < liftM isAdministrator thisClient 
9715  330 
thisRoomMasterId < liftM masterID thisRoom 
8247  331 
let newAdminId = fromJust maybeClientId 
332 
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc newAdminId 

333 
return 

8403
fbc6e7602e05
 Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset

334 
[ChangeMaster (Just newAdminId)  
fbc6e7602e05
 Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset

335 
(master  serverAdmin) 
fbc6e7602e05
 Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset

336 
&& isJust maybeClientId 
fbc6e7602e05
 Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset

337 
&& ((newAdminId /= thisClientId)  (serverAdmin && not master)) 
9753
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

338 
&& (Just newAdminId /= thisRoomMasterId) 
8403
fbc6e7602e05
 Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset

339 
&& sameRoom] 
8247  340 

341 

4614  342 
handleCmd_inRoom ["TEAMCHAT", msg] = do 
343 
cl < thisClient 

344 
chans < roomSameClanChans 

345 
return [AnswerClients chans ["EM", engineMsg cl]] 

2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

346 
where 
8757  347 
engineMsg cl = toEngineMsg $ B.concat ["b", nick cl, " (team): ", msg, "\x20\x20"] 
4568  348 

8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset

349 

7537
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset

350 
handleCmd_inRoom ["BAN", banNick] = do 
8002  351 
(thisClientId, rnc) < ask 
7537
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset

352 
maybeClientId < clientByNick banNick 
8002  353 
master < liftM isMaster thisClient 
7537
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset

354 
let banId = fromJust maybeClientId 
8002  355 
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc banId 
356 
if master && isJust maybeClientId && (banId /= thisClientId) && sameRoom then 

357 
return [ 

8189  358 
 ModifyRoom (\r > r{roomBansList = let h = host $ rnc `client` banId in h `deepseq` h : roomBansList r}) 
359 
KickRoomClient banId 

8002  360 
] 
361 
else 

362 
return [] 

7537
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset

363 

9035
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset

364 
handleCmd_inRoom ("RND":rs) = do 
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset

365 
n < clientNick 
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset

366 
s < roomClientsChans 
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset

367 
return [AnswerClients s ["CHAT", n, B.unwords $ "/rnd" : rs], Random s rs] 
7537
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset

368 

9753
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

369 
handleCmd_inRoom ["FIX"] = do 
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

370 
cl < thisClient 
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

371 
return [ModifyRoom (\r > r{isSpecial = True})  isAdministrator cl] 
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

372 

9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9715
diff
changeset

373 

6912
831416764d2d
Allow LIST command while in room to not annoy old frontends (0.9.17 or less) with warnings
unc0rr
parents:
6815
diff
changeset

374 
handleCmd_inRoom ["LIST"] = return []  for old clients (<= 0.9.17) 
831416764d2d
Allow LIST command while in room to not annoy old frontends (0.9.17 or less) with warnings
unc0rr
parents:
6815
diff
changeset

375 

6721
7dbf8a0c1f5d
 Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset

376 
handleCmd_inRoom (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: in room)"] 
7dbf8a0c1f5d
 Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset

377 

7dbf8a0c1f5d
 Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset

378 
handleCmd_inRoom [] = return [ProtocolError "Empty command (state: in room)"] 