author | koda |
Wed, 08 Jan 2014 18:57:23 +0100 | |
changeset 9957 | 7a62f31895ac |
parent 9787 | 0da6ba2f1f93 |
child 9950 | 2759212a27de |
child 9995 | 8bf092ddc536 |
permissions | -rw-r--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
|
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 |
9770 | 34 |
rm <- thisRoom |
35 |
||
36 |
if isSpecial rm then |
|
37 |
return [Warning $ loc "Restricted"] |
|
38 |
else if isMaster cl 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
|
39 |
return [ |
4941 | 40 |
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
|
41 |
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
|
42 |
else |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
43 |
return [ProtocolError $ loc "Not room master"] |
4941 | 44 |
where |
45 |
f r = if paramName `Map.member` (mapParams r) then |
|
46 |
r{mapParams = Map.insert paramName (head paramStrs) (mapParams r)} |
|
47 |
else |
|
48 |
r{params = Map.insert paramName paramStrs (params r)} |
|
1804 | 49 |
|
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
|
50 |
|
4932 | 51 |
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
|
52 |
| 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
|
53 |
| otherwise = do |
4932 | 54 |
(ci, _) <- ask |
55 |
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
|
56 |
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
|
57 |
clChan <- thisClientChans |
4932 | 58 |
othChans <- roomOthersChans |
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
59 |
roomChans <- roomClientsChans |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
60 |
cl <- thisClient |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
61 |
teamColor <- |
8924 | 62 |
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
|
63 |
return color |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
64 |
else |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
65 |
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
|
66 |
let roomTeams = teams rm |
8897
d6c310c65c91
- Revert server workaround over desync from r98e2dbdda8c0
unc0rr
parents:
8757
diff
changeset
|
67 |
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
|
68 |
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
|
69 |
return $ |
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset
|
70 |
if not . null . drop (maxTeams rm - 1) $ roomTeams then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
71 |
[Warning $ loc "too many teams"] |
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset
|
72 |
else if canAddNumber roomTeams <= 0 then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
73 |
[Warning $ loc "too many hedgehogs"] |
4932 | 74 |
else if isJust $ findTeam rm then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
75 |
[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
|
76 |
else if isJust $ gameInfo rm then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
77 |
[Warning $ loc "round in progress"] |
4932 | 78 |
else if isRestrictedTeams rm then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
79 |
[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
|
80 |
else |
7986
53b1da5ee7f4
Maybe this caused server crashes? Add more strictness on team owner record field
unc0rr
parents:
7947
diff
changeset
|
81 |
[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
|
82 |
SendUpdateOnThisRoom, |
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
83 |
ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
4932 | 84 |
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
|
85 |
AnswerClients othChans $ teamToNet $ newTeam, |
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset
|
86 |
AnswerClients roomChans ["TEAM_COLOR", tName, teamColor], |
8899 | 87 |
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
|
88 |
] |
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 |
where |
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset
|
90 |
canAddNumber rt = (48::Int) - (sum $ map hhnum rt) |
4932 | 91 |
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
|
92 |
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
|
93 |
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
|
94 |
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
|
95 |
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
|
96 |
newTeamHHNum rt p = min p (canAddNumber rt) |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
97 |
maxTeams r |
5931 | 98 |
| roomProto r < 38 = 6 |
99 |
| otherwise = 8 |
|
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
100 |
|
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
|
101 |
|
4932 | 102 |
handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
103 |
(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
|
104 |
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
|
105 |
|
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
|
106 |
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
|
107 |
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
|
108 |
|
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
|
109 |
return $ |
8428 | 110 |
if isNothing $ maybeTeam then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
111 |
[Warning $ loc "REMOVE_TEAM: no such team"] |
8431 | 112 |
else if ci /= teamownerId team then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
113 |
[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
|
114 |
else |
4932 | 115 |
[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
|
116 |
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
|
117 |
(\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
|
118 |
teamsInGame = teamsInGame c - 1, |
8433 | 119 |
clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci team r |
4989 | 120 |
}) |
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
|
121 |
] |
4568 | 122 |
where |
8433 | 123 |
anotherTeamClan ci team = teamcolor . fromMaybe (error "CHECKPOINT 011") . find (\t -> (teamownerId t == ci) && (t /= team)) . teams |
4932 | 124 |
findTeam = find (\t -> tName == teamname t) . teams |
3561 | 125 |
|
3568 | 126 |
|
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
|
127 |
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
|
128 |
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
|
129 |
r <- thisRoom |
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset
|
130 |
clChan <- thisClientChans |
8477
330b0b8846cf
Don't confirm hogs number to room admin when no constraint hit
unc0rr
parents:
8433
diff
changeset
|
131 |
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
|
132 |
|
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 |
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
|
134 |
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
|
135 |
|
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
|
136 |
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
|
137 |
if not $ isMaster cl then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
138 |
[ProtocolError $ loc "Not room master"] |
8429 | 139 |
else if isNothing maybeTeam then |
140 |
[] |
|
8428 | 141 |
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
|
142 |
[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
|
143 |
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
|
144 |
[ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
8477
330b0b8846cf
Don't confirm hogs number to room admin when no constraint hit
unc0rr
parents:
8433
diff
changeset
|
145 |
AnswerClients others ["HH_NUM", teamName, showB hhNumber]] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
146 |
where |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset
|
147 |
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
|
148 |
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
|
149 |
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
|
150 |
|
1804 | 151 |
|
3568 | 152 |
|
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
|
153 |
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
|
154 |
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
|
155 |
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
|
156 |
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
|
157 |
|
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 |
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
|
159 |
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
|
160 |
|
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 |
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
|
162 |
if not $ isMaster cl then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
163 |
[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
|
164 |
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
|
165 |
[] |
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
|
166 |
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
|
167 |
[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
|
168 |
AnswerClients others ["TEAM_COLOR", teamName, newColor], |
4986
33fe91b2bcbf
Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents:
4975
diff
changeset
|
169 |
ModifyClient2 (teamownerId team) (\c -> c{clientClan = Just newColor})] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
170 |
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
|
171 |
findTeam = find (\t -> teamName == teamname t) . teams |
3568 | 172 |
|
1804 | 173 |
|
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
|
174 |
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
|
175 |
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
|
176 |
chans <- roomClientsChans |
8983 | 177 |
|
178 |
return [ |
|
179 |
ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}), |
|
180 |
ModifyClient (\c -> c{isReady = not $ isReady cl}), |
|
181 |
AnswerClients chans $ if clientProto cl < 38 then |
|
182 |
[if isReady cl then "NOT_READY" else "READY", nick cl] |
|
183 |
else |
|
184 |
["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl] |
|
185 |
] |
|
1804 | 186 |
|
8513 | 187 |
|
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 |
handleCmd_inRoom ["START_GAME"] = do |
6012 | 189 |
(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
|
190 |
cl <- thisClient |
4932 | 191 |
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
|
192 |
chans <- roomClientsChans |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
193 |
|
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
194 |
let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci |
6012 | 195 |
let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm |
3577 | 196 |
|
8418
4543cc2049af
Force-starting a game now only works for client versions >43
dag10
parents:
8416
diff
changeset
|
197 |
if isMaster cl && (playersIn rm == readyPlayers rm || clientProto cl > 43) && not (isJust $ gameInfo rm) then |
4932 | 198 |
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
|
199 |
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
|
200 |
ModifyRoom |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
201 |
(\r -> r{ |
6756
344d32bb1328
Also consider game finished when the last player reports ROUNDFINISHED despite the correctness parameter.
unc0rr
parents:
6753
diff
changeset
|
202 |
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
|
203 |
} |
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
204 |
) |
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
205 |
, 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
|
206 |
, SendUpdateOnThisRoom |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
207 |
, 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
|
208 |
, 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
|
209 |
] |
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
|
210 |
else |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
211 |
return [Warning $ loc "Less than two clans!"] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
212 |
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
|
213 |
return [] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
214 |
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
|
215 |
enoughClans = not . null . drop 1 . group . map teamcolor . teams |
1804 | 216 |
|
217 |
||
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
|
218 |
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
|
219 |
cl <- thisClient |
4932 | 220 |
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
|
221 |
chans <- roomOthersChans |
4931
da43c36a6e92
Don't accept EM message when the game isn't started
unc0rr
parents:
4917
diff
changeset
|
222 |
|
8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset
|
223 |
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
|
224 |
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
|
225 |
: [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
|
226 |
(\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
|
227 |
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
|
228 |
, 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
|
229 |
$ 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
|
230 |
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
|
231 |
return [] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
232 |
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
|
233 |
(legalMsgs, nonEmptyMsgs, lastFTMsg) = checkNetCmd msg |
1804 | 234 |
|
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
|
235 |
|
8550
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset
|
236 |
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
|
237 |
cl <- thisClient |
4932 | 238 |
rm <- thisRoom |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
239 |
chans <- roomClientsChans |
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
240 |
|
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
|
241 |
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
|
242 |
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
|
243 |
|
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
244 |
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
|
245 |
if isJust $ gameInfo rm then |
8422 | 246 |
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
|
247 |
else |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
248 |
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
|
249 |
else |
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
250 |
return [] -- don't accept this message twice |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
251 |
where |
8550
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset
|
252 |
-- isCorrect = correctly == "1" |
1811 | 253 |
|
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
|
254 |
-- 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
|
255 |
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
|
256 |
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
|
257 |
|
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
|
258 |
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
|
259 |
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
|
260 |
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
|
261 |
if not $ isMaster cl then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
262 |
[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
|
263 |
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
|
264 |
[ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})] |
4568 | 265 |
|
1831 | 266 |
|
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
|
267 |
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
|
268 |
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
|
269 |
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
|
270 |
if not $ isMaster cl then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
271 |
[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
|
272 |
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
|
273 |
[ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})] |
1879 | 274 |
|
1831 | 275 |
|
8232 | 276 |
handleCmd_inRoom ["TOGGLE_REGISTERED_ONLY"] = do |
277 |
cl <- thisClient |
|
278 |
return $ |
|
279 |
if not $ isMaster cl then |
|
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
280 |
[ProtocolError $ loc "Not room master"] |
8232 | 281 |
else |
282 |
[ModifyRoom (\r -> r{isRegisteredOnly = not $ isRegisteredOnly r})] |
|
283 |
||
8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset
|
284 |
|
5098 | 285 |
handleCmd_inRoom ["ROOM_NAME", newName] = do |
286 |
cl <- thisClient |
|
287 |
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
|
288 |
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
|
289 |
chans <- sameProtoChans |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
290 |
|
5098 | 291 |
return $ |
292 |
if not $ isMaster cl then |
|
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
293 |
[ProtocolError $ loc "Not room master"] |
5098 | 294 |
else |
9454 | 295 |
if illegalName newName then |
296 |
[Warning $ loc "Illegal room name"] |
|
297 |
else |
|
9770 | 298 |
if isSpecial rm then |
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
|
299 |
[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
|
300 |
else |
5098 | 301 |
if isJust $ find (\r -> newName == name r) rs then |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset
|
302 |
[Warning $ loc "Room with such name already exists"] |
5098 | 303 |
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
|
304 |
[ModifyRoom roomUpdate, |
9702 | 305 |
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
|
306 |
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
|
307 |
roomUpdate r = r{name = newName} |
5098 | 308 |
|
309 |
||
4614 | 310 |
handleCmd_inRoom ["KICK", kickNick] = do |
311 |
(thisClientId, rnc) <- ask |
|
312 |
maybeClientId <- clientByNick kickNick |
|
313 |
master <- liftM isMaster thisClient |
|
8513 | 314 |
rm <- thisRoom |
4614 | 315 |
let kickId = fromJust maybeClientId |
8513 | 316 |
let kickCl = rnc `client` kickId |
4932 | 317 |
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
|
318 |
let notOnly2Players = (length . group . sort . map teamowner . teams $ rm) > 2 |
4614 | 319 |
return |
8513 | 320 |
[KickRoomClient kickId | |
321 |
master |
|
322 |
&& isJust maybeClientId |
|
323 |
&& (kickId /= thisClientId) |
|
324 |
&& sameRoom |
|
8627
ea2d32a03ac9
Eh, two players condition seems to make more sense than two clans here
unc0rr
parents:
8550
diff
changeset
|
325 |
&& ((isNothing $ gameInfo rm) || notOnly2Players || teamsInGame kickCl == 0) |
8513 | 326 |
] |
1879 | 327 |
|
1831 | 328 |
|
8247 | 329 |
handleCmd_inRoom ["DELEGATE", newAdmin] = do |
330 |
(thisClientId, rnc) <- ask |
|
331 |
maybeClientId <- clientByNick newAdmin |
|
332 |
master <- liftM isMaster thisClient |
|
8403
fbc6e7602e05
- Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset
|
333 |
serverAdmin <- liftM isAdministrator thisClient |
9715 | 334 |
thisRoomMasterId <- liftM masterID thisRoom |
8247 | 335 |
let newAdminId = fromJust maybeClientId |
336 |
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc newAdminId |
|
337 |
return |
|
8403
fbc6e7602e05
- Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset
|
338 |
[ChangeMaster (Just newAdminId) | |
fbc6e7602e05
- Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset
|
339 |
(master || serverAdmin) |
fbc6e7602e05
- Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset
|
340 |
&& isJust maybeClientId |
fbc6e7602e05
- Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset
|
341 |
&& ((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
|
342 |
&& (Just newAdminId /= thisRoomMasterId) |
8403
fbc6e7602e05
- Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset
|
343 |
&& sameRoom] |
8247 | 344 |
|
345 |
||
4614 | 346 |
handleCmd_inRoom ["TEAMCHAT", msg] = do |
347 |
cl <- thisClient |
|
348 |
chans <- roomSameClanChans |
|
349 |
return [AnswerClients chans ["EM", engineMsg cl]] |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
350 |
where |
8757 | 351 |
engineMsg cl = toEngineMsg $ B.concat ["b", nick cl, " (team): ", msg, "\x20\x20"] |
4568 | 352 |
|
8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset
|
353 |
|
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 |
handleCmd_inRoom ["BAN", banNick] = do |
8002 | 355 |
(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
|
356 |
maybeClientId <- clientByNick banNick |
8002 | 357 |
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
|
358 |
let banId = fromJust maybeClientId |
8002 | 359 |
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc banId |
360 |
if master && isJust maybeClientId && (banId /= thisClientId) && sameRoom then |
|
361 |
return [ |
|
8189 | 362 |
-- ModifyRoom (\r -> r{roomBansList = let h = host $ rnc `client` banId in h `deepseq` h : roomBansList r}) |
363 |
KickRoomClient banId |
|
8002 | 364 |
] |
365 |
else |
|
366 |
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
|
367 |
|
9035
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset
|
368 |
handleCmd_inRoom ("RND":rs) = do |
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset
|
369 |
n <- clientNick |
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset
|
370 |
s <- roomClientsChans |
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset
|
371 |
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
|
372 |
|
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
|
373 |
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
|
374 |
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
|
375 |
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
|
376 |
|
9770 | 377 |
handleCmd_inRoom ["UNFIX"] = do |
378 |
cl <- thisClient |
|
379 |
return [ModifyRoom (\r -> r{isSpecial = False}) | isAdministrator cl] |
|
380 |
||
9787 | 381 |
handleCmd_inRoom ["GREETING", msg] = do |
382 |
cl <- thisClient |
|
383 |
rm <- thisRoom |
|
384 |
return [ModifyRoom (\r -> r{greeting = msg}) | isAdministrator cl || (isMaster cl && (not $ isSpecial rm))] |
|
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
|
385 |
|
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
|
386 |
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
|
387 |
|
6721
7dbf8a0c1f5d
- Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset
|
388 |
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
|
389 |
|
7dbf8a0c1f5d
- Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset
|
390 |
handleCmd_inRoom [] = return [ProtocolError "Empty command (state: in room)"] |