author | Wuzzy <Wuzzy2@mail.ru> |
Tue, 27 Nov 2018 17:48:41 +0100 | |
changeset 14318 | d688455cad8f |
parent 14118 | 589a752c01ca |
child 14379 | b33127bc2424 |
permissions | -rw-r--r-- |
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
1 |
{- |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
2 |
* Hedgewars, a free turn based strategy game |
11046 | 3 |
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com> |
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
4 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
5 |
* This program is free software; you can redistribute it and/or modify |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
6 |
* it under the terms of the GNU General Public License as published by |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
7 |
* the Free Software Foundation; version 2 of the License |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
8 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
9 |
* This program is distributed in the hope that it will be useful, |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
10 |
* but WITHOUT ANY WARRANTY; without even the implied warranty of |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
11 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
12 |
* GNU General Public License for more details. |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
13 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
14 |
* You should have received a copy of the GNU General Public License |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
15 |
* along with this program; if not, write to the Free Software |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
16 |
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
17 |
\-} |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10392
diff
changeset
|
18 |
|
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
|
19 |
{-# LANGUAGE OverloadedStrings #-} |
1804 | 20 |
module HWProtoInRoomState where |
21 |
||
22 |
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
|
23 |
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
|
24 |
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
|
25 |
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
|
26 |
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
|
27 |
import Control.Monad.Reader |
1804 | 28 |
-------------------------------------- |
29 |
import CoreTypes |
|
13504
f747c385b5ba
Server: Replace hardcoded hog-related numbers with consts
Wuzzy <Wuzzy2@mail.ru>
parents:
13079
diff
changeset
|
30 |
import Consts |
1804 | 31 |
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
|
32 |
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
|
33 |
import RoomsAndClients |
6068 | 34 |
import EngineInteraction |
10039 | 35 |
import Votes |
13509
9ba5e4594322
Refactor server chat command help, also add admin commands to help
Wuzzy <Wuzzy2@mail.ru>
parents:
13508
diff
changeset
|
36 |
import CommandHelp |
9995
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
37 |
|
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
38 |
startGame :: Reader (ClientIndex, IRnC) [Action] |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
39 |
startGame = do |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
40 |
(ci, rnc) <- ask |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
41 |
cl <- thisClient |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
42 |
rm <- thisRoom |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
43 |
chans <- roomClientsChans |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
44 |
|
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
45 |
let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci |
10732
7c4f9e5e447c
Get rid of teamownerId since rejoin feature makes it virtually useless, as you cannot rely on it anymore. Should fix recently experienced server crashes.
unc0rr
parents:
10730
diff
changeset
|
46 |
let allPlayersRegistered = all isOwnerRegistered $ teams rm |
9995
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
47 |
|
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
48 |
if (playersIn rm == readyPlayers rm || clientProto cl > 43) && not (isJust $ gameInfo rm) then |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
49 |
if enoughClans rm then |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
50 |
return [ |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
51 |
ModifyRoom |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
52 |
(\r -> r{ |
10392 | 53 |
gameInfo = Just $ newGameInfo (teams rm) (length $ teams rm) allPlayersRegistered (mapParams rm) (params rm) False |
9995
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
54 |
} |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
55 |
) |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
56 |
, AnswerClients chans ["RUN_GAME"] |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
57 |
, SendUpdateOnThisRoom |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
58 |
, AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks |
11557 | 59 |
, ModifyRoomClients (\c -> c{isInGame = True, teamIndexes = map snd . filter (\(t, _) -> teamowner t == nick c) $ zip (teams rm) [0..]}) |
9995
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
60 |
] |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
61 |
else |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
62 |
return [Warning $ loc "The game can't be started with less than two clans!"] |
9995
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
63 |
else |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
64 |
return [] |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
65 |
where |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
66 |
enoughClans = not . null . drop 1 . group . map teamcolor . teams |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
67 |
|
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
68 |
|
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
69 |
|
4989 | 70 |
handleCmd_inRoom :: CmdHandler |
1804 | 71 |
|
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
|
72 |
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
|
73 |
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
|
74 |
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
|
75 |
return [AnswerClients s ["CHAT", n, msg]] |
1804 | 76 |
|
13673
1aa5e884326a
Fix some string/translation inconsistencies in strings related to leaving
Wuzzy <Wuzzy2@mail.ru>
parents:
13510
diff
changeset
|
77 |
-- Leave room normally |
1aa5e884326a
Fix some string/translation inconsistencies in strings related to leaving
Wuzzy <Wuzzy2@mail.ru>
parents:
13510
diff
changeset
|
78 |
handleCmd_inRoom ["PART"] = return [MoveToLobby ""] |
13846 | 79 |
handleCmd_inRoom ["PART", _] = return [MoveToLobby ""] |
3531 | 80 |
|
1811 | 81 |
|
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
|
82 |
handleCmd_inRoom ("CFG" : paramName : paramStrs) |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
83 |
| 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
|
84 |
| 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
|
85 |
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
|
86 |
cl <- thisClient |
9770 | 87 |
rm <- thisRoom |
88 |
||
89 |
if isSpecial rm then |
|
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
90 |
return [Warning $ loc "Access denied."] |
9770 | 91 |
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
|
92 |
return [ |
10730
eac6a4d53752
Server-side workaround for frontend's script parameter bug in .21
unc0rr
parents:
10511
diff
changeset
|
93 |
ModifyRoom $ f (clientProto cl), |
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
|
94 |
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
|
95 |
else |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
96 |
return [ProtocolError $ loc "You're not the room master!"] |
4941 | 97 |
where |
10730
eac6a4d53752
Server-side workaround for frontend's script parameter bug in .21
unc0rr
parents:
10511
diff
changeset
|
98 |
f clproto r = if paramName `Map.member` (mapParams r) then |
4941 | 99 |
r{mapParams = Map.insert paramName (head paramStrs) (mapParams r)} |
100 |
else |
|
10730
eac6a4d53752
Server-side workaround for frontend's script parameter bug in .21
unc0rr
parents:
10511
diff
changeset
|
101 |
r{params = Map.insert paramName (fixedParamStr clproto) (params r)} |
eac6a4d53752
Server-side workaround for frontend's script parameter bug in .21
unc0rr
parents:
10511
diff
changeset
|
102 |
fixedParamStr clproto |
eac6a4d53752
Server-side workaround for frontend's script parameter bug in .21
unc0rr
parents:
10511
diff
changeset
|
103 |
| clproto /= 49 = paramStrs |
eac6a4d53752
Server-side workaround for frontend's script parameter bug in .21
unc0rr
parents:
10511
diff
changeset
|
104 |
| paramName /= "SCHEME" = paramStrs |
eac6a4d53752
Server-side workaround for frontend's script parameter bug in .21
unc0rr
parents:
10511
diff
changeset
|
105 |
| otherwise = L.init paramStrs ++ [B.replicate 50 'X' `B.append` L.last paramStrs] |
1804 | 106 |
|
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
|
107 |
|
4932 | 108 |
handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo) |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
109 |
| 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
|
110 |
| otherwise = do |
4932 | 111 |
rm <- thisRoom |
10732
7c4f9e5e447c
Get rid of teamownerId since rejoin feature makes it virtually useless, as you cannot rely on it anymore. Should fix recently experienced server crashes.
unc0rr
parents:
10730
diff
changeset
|
112 |
cl <- thisClient |
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
|
113 |
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
|
114 |
clChan <- thisClientChans |
4932 | 115 |
othChans <- roomOthersChans |
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
116 |
roomChans <- roomClientsChans |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
117 |
teamColor <- |
8924 | 118 |
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
|
119 |
return color |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
120 |
else |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
121 |
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
|
122 |
let roomTeams = teams rm |
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
123 |
let hhNum = newTeamHHNum roomTeams $ |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
124 |
if not $ null roomTeams then |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
125 |
minimum [hhnum $ head roomTeams, canAddNumber roomTeams] |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
126 |
else |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
127 |
defaultHedgehogsNumber rm |
12114
cdadc1d487f1
Only registered players regain their teams on rejoin
unc0rr
parents:
11575
diff
changeset
|
128 |
let newTeam = clNick `seq` TeamInfo clNick tName teamColor grave fort voicepack flag (isRegistered cl) 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
|
129 |
return $ |
10884 | 130 |
if not . null . drop (teamsNumberLimit rm - 1) $ roomTeams then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
131 |
[Warning $ loc "Too many teams!"] |
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset
|
132 |
else if canAddNumber roomTeams <= 0 then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
133 |
[Warning $ loc "Too many hedgehogs!"] |
4932 | 134 |
else if isJust $ findTeam rm then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
135 |
[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
|
136 |
else if isJust $ gameInfo rm then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
137 |
[Warning $ loc "Joining not possible: Round is in progress."] |
4932 | 138 |
else if isRestrictedTeams rm then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
139 |
[Warning $ loc "This room currently does not allow adding new teams."] |
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
|
140 |
else |
7986
53b1da5ee7f4
Maybe this caused server crashes? Add more strictness on team owner record field
unc0rr
parents:
7947
diff
changeset
|
141 |
[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
|
142 |
SendUpdateOnThisRoom, |
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
143 |
ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
4932 | 144 |
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
|
145 |
AnswerClients othChans $ teamToNet $ newTeam, |
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset
|
146 |
AnswerClients roomChans ["TEAM_COLOR", tName, teamColor], |
8899 | 147 |
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
|
148 |
] |
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 |
where |
13504
f747c385b5ba
Server: Replace hardcoded hog-related numbers with consts
Wuzzy <Wuzzy2@mail.ru>
parents:
13079
diff
changeset
|
150 |
canAddNumber rt = (cMaxHHs) - (sum $ map hhnum rt) |
4932 | 151 |
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
|
152 |
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
|
153 |
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
|
154 |
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
|
155 |
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
|
156 |
newTeamHHNum rt p = min p (canAddNumber rt) |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
157 |
maxTeams r |
5931 | 158 |
| roomProto r < 38 = 6 |
13504
f747c385b5ba
Server: Replace hardcoded hog-related numbers with consts
Wuzzy <Wuzzy2@mail.ru>
parents:
13079
diff
changeset
|
159 |
| otherwise = cMaxTeams |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
160 |
|
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
|
161 |
|
4932 | 162 |
handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
163 |
(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
|
164 |
r <- thisRoom |
10732
7c4f9e5e447c
Get rid of teamownerId since rejoin feature makes it virtually useless, as you cannot rely on it anymore. Should fix recently experienced server crashes.
unc0rr
parents:
10730
diff
changeset
|
165 |
clNick <- clientNick |
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
|
166 |
|
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 |
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
|
168 |
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
|
169 |
|
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 |
return $ |
8428 | 171 |
if isNothing $ maybeTeam then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
172 |
[Warning $ loc "Error: The team you tried to remove does not exist."] |
10732
7c4f9e5e447c
Get rid of teamownerId since rejoin feature makes it virtually useless, as you cannot rely on it anymore. Should fix recently experienced server crashes.
unc0rr
parents:
10730
diff
changeset
|
173 |
else if clNick /= teamowner team then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
174 |
[ProtocolError $ loc "You can't remove a team you don't own."] |
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
|
175 |
else |
4932 | 176 |
[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
|
177 |
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
|
178 |
(\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
|
179 |
teamsInGame = teamsInGame c - 1, |
11414
6f119783a1ad
Remove CHECKPOINT 011 occurence, probably hiding some bug
unc0rr
parents:
11046
diff
changeset
|
180 |
clientClan = if teamsInGame c == 1 then Nothing else anotherTeamClan clNick team r |
4989 | 181 |
}) |
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
|
182 |
] |
4568 | 183 |
where |
11414
6f119783a1ad
Remove CHECKPOINT 011 occurence, probably hiding some bug
unc0rr
parents:
11046
diff
changeset
|
184 |
anotherTeamClan clNick team = liftM teamcolor . find (\t -> (teamowner t == clNick) && (t /= team)) . teams |
4932 | 185 |
findTeam = find (\t -> tName == teamname t) . teams |
3561 | 186 |
|
3568 | 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 ["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
|
189 |
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
|
190 |
r <- thisRoom |
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset
|
191 |
clChan <- thisClientChans |
8477
330b0b8846cf
Don't confirm hogs number to room admin when no constraint hit
unc0rr
parents:
8433
diff
changeset
|
192 |
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
|
193 |
|
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
|
194 |
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
|
195 |
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
|
196 |
|
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
|
197 |
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
|
198 |
if not $ isMaster cl then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
199 |
[ProtocolError $ loc "You're not the room master!"] |
8429 | 200 |
else if isNothing maybeTeam then |
201 |
[] |
|
13504
f747c385b5ba
Server: Replace hardcoded hog-related numbers with consts
Wuzzy <Wuzzy2@mail.ru>
parents:
13079
diff
changeset
|
202 |
else if hhNumber < 1 || hhNumber > cHogsPerTeam || hhNumber > canAddNumber r + hhnum team then |
8421
fc39fe044a4f
Make number of hedgehogs restriction actually work in network game
unc0rr
parents:
8418
diff
changeset
|
203 |
[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
|
204 |
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
|
205 |
[ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
8477
330b0b8846cf
Don't confirm hogs number to room admin when no constraint hit
unc0rr
parents:
8433
diff
changeset
|
206 |
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
|
207 |
where |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset
|
208 |
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
|
209 |
findTeam = find (\t -> teamName == teamname t) . teams |
13504
f747c385b5ba
Server: Replace hardcoded hog-related numbers with consts
Wuzzy <Wuzzy2@mail.ru>
parents:
13079
diff
changeset
|
210 |
canAddNumber = (-) cMaxHHs . sum . map hhnum . teams |
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 |
|
1804 | 212 |
|
3568 | 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 ["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
|
215 |
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
|
216 |
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
|
217 |
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
|
218 |
|
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 |
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
|
220 |
let team = fromJust maybeTeam |
10732
7c4f9e5e447c
Get rid of teamownerId since rejoin feature makes it virtually useless, as you cannot rely on it anymore. Should fix recently experienced server crashes.
unc0rr
parents:
10730
diff
changeset
|
221 |
maybeClientId <- clientByNick $ teamowner team |
7c4f9e5e447c
Get rid of teamownerId since rejoin feature makes it virtually useless, as you cannot rely on it anymore. Should fix recently experienced server crashes.
unc0rr
parents:
10730
diff
changeset
|
222 |
let teamOwnerId = fromJust maybeClientId |
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
|
223 |
|
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
|
224 |
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
|
225 |
if not $ isMaster cl then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
226 |
[ProtocolError $ loc "You're not the room master!"] |
10732
7c4f9e5e447c
Get rid of teamownerId since rejoin feature makes it virtually useless, as you cannot rely on it anymore. Should fix recently experienced server crashes.
unc0rr
parents:
10730
diff
changeset
|
227 |
else if isNothing maybeTeam || isNothing maybeClientId 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
|
228 |
[] |
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
|
229 |
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
|
230 |
[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
|
231 |
AnswerClients others ["TEAM_COLOR", teamName, newColor], |
10732
7c4f9e5e447c
Get rid of teamownerId since rejoin feature makes it virtually useless, as you cannot rely on it anymore. Should fix recently experienced server crashes.
unc0rr
parents:
10730
diff
changeset
|
232 |
ModifyClient2 teamOwnerId (\c -> c{clientClan = Just newColor})] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
233 |
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
|
234 |
findTeam = find (\t -> teamName == teamname t) . teams |
3568 | 235 |
|
1804 | 236 |
|
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 |
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
|
238 |
cl <- thisClient |
4932 | 239 |
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
|
240 |
chans <- roomClientsChans |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
241 |
|
9995
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
242 |
(ci, rnc) <- ask |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
243 |
let ri = clientRoom rnc ci |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
244 |
let unreadyClients = filter (not . isReady) . map (client rnc) $ roomClients rnc ri |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
245 |
|
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
246 |
gs <- if (not $ isReady cl) && (isSpecial rm) && (unreadyClients == [cl]) then startGame else return [] |
3577 | 247 |
|
10017 | 248 |
return $ |
9995
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
249 |
ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}) |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
250 |
: ModifyClient (\c -> c{isReady = not $ isReady cl}) |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
251 |
: (AnswerClients chans $ if clientProto cl < 38 then |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
252 |
[if isReady cl then "NOT_READY" else "READY", nick cl] |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
253 |
else |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
254 |
["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl]) |
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
255 |
: gs |
1804 | 256 |
|
257 |
||
10194 | 258 |
handleCmd_inRoom ["START_GAME"] = roomAdminOnly startGame |
9995
8bf092ddc536
In special rooms game starts when all players are ready
unc0rr
parents:
9787
diff
changeset
|
259 |
|
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
|
260 |
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
|
261 |
cl <- thisClient |
4932 | 262 |
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
|
263 |
chans <- roomOthersChans |
4931
da43c36a6e92
Don't accept EM message when the game isn't started
unc0rr
parents:
4917
diff
changeset
|
264 |
|
11556
af9aa8d5863c
Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents:
11508
diff
changeset
|
265 |
let (legalMsgs, nonEmptyMsgs, lastFTMsg) = checkNetCmd (teamIndexes cl) msg |
af9aa8d5863c
Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents:
11508
diff
changeset
|
266 |
|
8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset
|
267 |
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
|
268 |
return $ AnswerClients chans ["EM", legalMsgs] |
10017 | 269 |
: [ModifyRoom (\r -> r{gameInfo = liftM |
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
|
270 |
(\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
|
271 |
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
|
272 |
, lastFilteredTimedMsg = fromMaybe (lastFilteredTimedMsg g) lastFTMsg}) |
10092 | 273 |
$ gameInfo r}), RegisterEvent EngineMessage] |
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
|
274 |
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
|
275 |
return [] |
1804 | 276 |
|
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
|
277 |
|
8550
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset
|
278 |
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
|
279 |
cl <- thisClient |
4932 | 280 |
rm <- thisRoom |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
281 |
chans <- roomClientsChans |
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
282 |
|
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
|
283 |
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
|
284 |
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
|
285 |
|
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
286 |
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
|
287 |
if isJust $ gameInfo rm then |
8422 | 288 |
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
|
289 |
else |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
290 |
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
|
291 |
else |
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
292 |
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
|
293 |
where |
8550
17378d33e62e
This change from r0cd63b963330 caused more troubles than solved. Also fix some warnings.
unc0rr
parents:
8541
diff
changeset
|
294 |
-- isCorrect = correctly == "1" |
1811 | 295 |
|
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
|
296 |
-- 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
|
297 |
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
|
298 |
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
|
299 |
|
10194 | 300 |
handleCmd_inRoom ["TOGGLE_RESTRICT_JOINS"] = roomAdminOnly $ |
10511
c33b2f001730
This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents:
10460
diff
changeset
|
301 |
return [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r}), SendUpdateOnThisRoom] |
4568 | 302 |
|
1831 | 303 |
|
10194 | 304 |
handleCmd_inRoom ["TOGGLE_RESTRICT_TEAMS"] = roomAdminOnly $ |
305 |
return [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})] |
|
1879 | 306 |
|
1831 | 307 |
|
10194 | 308 |
handleCmd_inRoom ["TOGGLE_REGISTERED_ONLY"] = roomAdminOnly $ |
10511
c33b2f001730
This should work, can't test: room flags passed in room info message instead of just 'in-game' state, including 'in-game', 'restricted joins', 'registered only' and 'passworded' flags
unc0rr
parents:
10460
diff
changeset
|
309 |
return [ModifyRoom (\r -> r{isRegisteredOnly = not $ isRegisteredOnly r}), SendUpdateOnThisRoom] |
8232 | 310 |
|
8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset
|
311 |
|
10194 | 312 |
handleCmd_inRoom ["ROOM_NAME", newName] = roomAdminOnly $ do |
5098 | 313 |
cl <- thisClient |
314 |
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
|
315 |
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
|
316 |
chans <- sameProtoChans |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
317 |
|
5098 | 318 |
return $ |
10017 | 319 |
if illegalName newName then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
320 |
[Warning $ loc "Illegal room name! The room name must be between 1-40 characters long, must not have a trailing or leading space and must not have any of these characters: $()*+?[]^{|}"] |
9454 | 321 |
else |
9770 | 322 |
if isSpecial rm then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
323 |
[Warning $ loc "Access denied."] |
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
|
324 |
else |
5098 | 325 |
if isJust $ find (\r -> newName == name r) rs then |
13079
81c154fd4380
More user-friendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
12114
diff
changeset
|
326 |
[Warning $ loc "A room with the same name already exists."] |
5098 | 327 |
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
|
328 |
[ModifyRoom roomUpdate, |
9702 | 329 |
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
|
330 |
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
|
331 |
roomUpdate r = r{name = newName} |
5098 | 332 |
|
333 |
||
10194 | 334 |
handleCmd_inRoom ["KICK", kickNick] = roomAdminOnly $ do |
4614 | 335 |
(thisClientId, rnc) <- ask |
13697
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
336 |
maybeKickId <- clientByNick kickNick |
8513 | 337 |
rm <- thisRoom |
13697
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
338 |
let kickId = fromJust maybeKickId |
8513 | 339 |
let kickCl = rnc `client` kickId |
4932 | 340 |
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
|
341 |
let notOnly2Players = (length . group . sort . map teamowner . teams $ rm) > 2 |
13697
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
342 |
return $ |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
343 |
-- Catch some error conditions |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
344 |
if (isNothing maybeKickId) then |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
345 |
[Warning $ loc "Player is not online."] |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
346 |
else if (kickId == thisClientId) then |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
347 |
[Warning $ loc "You can't kick yourself!"] |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
348 |
else if (not ((isNothing $ gameInfo rm) || notOnly2Players || teamsInGame kickCl == 0)) then |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
349 |
[Warning $ loc "You can't kick the only other player!"] |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
350 |
else if (not sameRoom) then |
13703
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
351 |
[Warning $ loc "The player is not in your room."] |
13697
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
352 |
else if (hasSuperPower kickCl) then |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
353 |
[Warning $ loc "This player is protected from being kicked."] |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
354 |
else |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
355 |
-- Kick! |
7f174e7285e5
Add a few helpful error messages from server when kicking failed
Wuzzy <Wuzzy2@mail.ru>
parents:
13696
diff
changeset
|
356 |
[KickRoomClient kickId] |
1831 | 357 |
|
8247 | 358 |
handleCmd_inRoom ["DELEGATE", newAdmin] = do |
359 |
(thisClientId, rnc) <- ask |
|
360 |
maybeClientId <- clientByNick newAdmin |
|
361 |
master <- liftM isMaster thisClient |
|
8403
fbc6e7602e05
- Allow server admins to use DELEGATE even when not room owner
unc0rr
parents:
8401
diff
changeset
|
362 |
serverAdmin <- liftM isAdministrator thisClient |
9715 | 363 |
thisRoomMasterId <- liftM masterID thisRoom |
8247 | 364 |
let newAdminId = fromJust maybeClientId |
365 |
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc newAdminId |
|
13703
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
366 |
return $ |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
367 |
if (not (master || serverAdmin)) then |
13712 | 368 |
[Warning $ loc "You're not the room master or a server admin!"] |
13703
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
369 |
else if (isNothing maybeClientId) then |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
370 |
[Warning $ loc "Player is not online."] |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
371 |
else if (Just newAdminId == thisRoomMasterId) then |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
372 |
[Warning $ loc "You're already the room master."] |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
373 |
else if (not sameRoom) then |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
374 |
[Warning $ loc "The player is not in your room."] |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
375 |
else |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
376 |
[ChangeMaster (Just newAdminId)] |
8247 | 377 |
|
4614 | 378 |
handleCmd_inRoom ["TEAMCHAT", msg] = do |
379 |
cl <- thisClient |
|
380 |
chans <- roomSameClanChans |
|
381 |
return [AnswerClients chans ["EM", engineMsg cl]] |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
382 |
where |
13828
76a1d6275cd3
Teach engine to properly display clan message received from the net
Wuzzy <Wuzzy2@mail.ru>
parents:
13729
diff
changeset
|
383 |
-- This is formatted in a way so it can parsed by engine to make it translatable |
76a1d6275cd3
Teach engine to properly display clan message received from the net
Wuzzy <Wuzzy2@mail.ru>
parents:
13729
diff
changeset
|
384 |
-- Format: b<PLAYER NAME>]<MESSAGE> |
13970
f791c46b47a4
Remove double space at end of chat messages from server
Wuzzy <Wuzzy2@mail.ru>
parents:
13846
diff
changeset
|
385 |
engineMsg cl = toEngineMsg $ B.concat ["b", nick cl, "]", msg] |
4568 | 386 |
|
8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8477
diff
changeset
|
387 |
|
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
|
388 |
handleCmd_inRoom ["BAN", banNick] = do |
8002 | 389 |
(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
|
390 |
maybeClientId <- clientByNick banNick |
8002 | 391 |
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
|
392 |
let banId = fromJust maybeClientId |
8002 | 393 |
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc banId |
394 |
if master && isJust maybeClientId && (banId /= thisClientId) && sameRoom then |
|
395 |
return [ |
|
8189 | 396 |
-- ModifyRoom (\r -> r{roomBansList = let h = host $ rnc `client` banId in h `deepseq` h : roomBansList r}) |
397 |
KickRoomClient banId |
|
8002 | 398 |
] |
399 |
else |
|
400 |
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
|
401 |
|
9035
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset
|
402 |
handleCmd_inRoom ("RND":rs) = do |
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset
|
403 |
n <- clientNick |
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset
|
404 |
s <- roomClientsChans |
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8983
diff
changeset
|
405 |
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
|
406 |
|
10882
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
407 |
|
13729
f4c8c6a174e8
Display error when using /maxteams if not room master
Wuzzy <Wuzzy2@mail.ru>
parents:
13712
diff
changeset
|
408 |
handleCmd_inRoom ["MAXTEAMS", n] = do |
10882
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
409 |
cl <- thisClient |
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
410 |
let m = readInt_ n |
13729
f4c8c6a174e8
Display error when using /maxteams if not room master
Wuzzy <Wuzzy2@mail.ru>
parents:
13712
diff
changeset
|
411 |
if not $ isMaster cl then |
f4c8c6a174e8
Display error when using /maxteams if not room master
Wuzzy <Wuzzy2@mail.ru>
parents:
13712
diff
changeset
|
412 |
return [Warning $ loc "You're not the room master!"] |
f4c8c6a174e8
Display error when using /maxteams if not room master
Wuzzy <Wuzzy2@mail.ru>
parents:
13712
diff
changeset
|
413 |
else if m < 2 || m > cMaxTeams then |
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
414 |
return [Warning $ loc "/maxteams: specify number from 2 to 8"] |
10882
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
415 |
else |
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
416 |
return [ModifyRoom (\r -> r{teamsNumberLimit = m})] |
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
417 |
|
14118
589a752c01ca
GameServer: Print syntax help if calling /maxteams without argument
Wuzzy <Wuzzy2@mail.ru>
parents:
14117
diff
changeset
|
418 |
handleCmd_inRoom ["MAXTEAMS"] = handleCmd_inRoom ["MAXTEAMS", ""] |
589a752c01ca
GameServer: Print syntax help if calling /maxteams without argument
Wuzzy <Wuzzy2@mail.ru>
parents:
14117
diff
changeset
|
419 |
|
10194 | 420 |
handleCmd_inRoom ["FIX"] = serverAdminOnly $ |
421 |
return [ModifyRoom (\r -> r{isSpecial = True})] |
|
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
|
422 |
|
13703
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
423 |
handleCmd_inRoom ["UNFIX"] = serverAdminOnly $ do |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
424 |
cl <- thisClient |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
425 |
return $ if not $ isMaster cl then |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
426 |
[Warning $ loc "You're not the room master!"] |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
427 |
else |
2df519242d41
Add a couple of more useful server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
13700
diff
changeset
|
428 |
[ModifyRoom (\r -> r{isSpecial = False})] |
9770 | 429 |
|
13508
da59012fbd7a
Add /help command for lobby and rooms too
Wuzzy <Wuzzy2@mail.ru>
parents:
13504
diff
changeset
|
430 |
handleCmd_inRoom ["HELP"] = do |
da59012fbd7a
Add /help command for lobby and rooms too
Wuzzy <Wuzzy2@mail.ru>
parents:
13504
diff
changeset
|
431 |
cl <- thisClient |
13509
9ba5e4594322
Refactor server chat command help, also add admin commands to help
Wuzzy <Wuzzy2@mail.ru>
parents:
13508
diff
changeset
|
432 |
if isAdministrator cl then |
9ba5e4594322
Refactor server chat command help, also add admin commands to help
Wuzzy <Wuzzy2@mail.ru>
parents:
13508
diff
changeset
|
433 |
return (cmdHelpActionList [sendChan cl] cmdHelpRoomAdmin) |
9ba5e4594322
Refactor server chat command help, also add admin commands to help
Wuzzy <Wuzzy2@mail.ru>
parents:
13508
diff
changeset
|
434 |
else |
9ba5e4594322
Refactor server chat command help, also add admin commands to help
Wuzzy <Wuzzy2@mail.ru>
parents:
13508
diff
changeset
|
435 |
return (cmdHelpActionList [sendChan cl] cmdHelpRoomPlayer) |
13508
da59012fbd7a
Add /help command for lobby and rooms too
Wuzzy <Wuzzy2@mail.ru>
parents:
13504
diff
changeset
|
436 |
|
9787 | 437 |
handleCmd_inRoom ["GREETING", msg] = do |
438 |
cl <- thisClient |
|
439 |
rm <- thisRoom |
|
13704
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
440 |
return $ if (not (isAdministrator cl || (isMaster cl && (not $ isSpecial rm)))) then |
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
441 |
[Warning $ loc "You're not the room master or a server admin!"] |
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
442 |
else |
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
443 |
[ModifyRoom (\r -> r{greeting = msg}), |
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
444 |
AnswerClients [sendChan cl] |
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
445 |
["CHAT", nickServer, |
13705
aa1d71ca6c19
Change empty string check in gameServer
Wuzzy <Wuzzy2@mail.ru>
parents:
13704
diff
changeset
|
446 |
if B.null msg then |
13704
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
447 |
loc "Greeting message cleared." |
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
448 |
else |
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
449 |
loc "Greeting message set." |
54eb4c774ef5
/greeting chat commands now clears greeting if called w/o arguments
Wuzzy <Wuzzy2@mail.ru>
parents:
13703
diff
changeset
|
450 |
]] |
10039 | 451 |
|
452 |
handleCmd_inRoom ["CALLVOTE"] = do |
|
453 |
cl <- thisClient |
|
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
454 |
return [AnswerClients [sendChan cl] |
13696
d732ca5dcab9
GameServer: Refactor fake nick names into Consts
Wuzzy <Wuzzy2@mail.ru>
parents:
13673
diff
changeset
|
455 |
["CHAT", nickServer, loc "Available callvote commands: kick <nickname>, map <name>, pause, newseed, hedgehogs"] |
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
456 |
] |
10039 | 457 |
|
458 |
handleCmd_inRoom ["CALLVOTE", "KICK"] = do |
|
459 |
cl <- thisClient |
|
13991
4ae01eabf611
Tweak error messages of /callvote kick
Wuzzy <Wuzzy2@mail.ru>
parents:
13970
diff
changeset
|
460 |
rm <- thisRoom |
4ae01eabf611
Tweak error messages of /callvote kick
Wuzzy <Wuzzy2@mail.ru>
parents:
13970
diff
changeset
|
461 |
return |
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
462 |
[Warning $ |
13991
4ae01eabf611
Tweak error messages of /callvote kick
Wuzzy <Wuzzy2@mail.ru>
parents:
13970
diff
changeset
|
463 |
if isJust $ masterID rm then |
4ae01eabf611
Tweak error messages of /callvote kick
Wuzzy <Wuzzy2@mail.ru>
parents:
13970
diff
changeset
|
464 |
loc "/callvote kick: This is only allowed in rooms without a room master." |
4ae01eabf611
Tweak error messages of /callvote kick
Wuzzy <Wuzzy2@mail.ru>
parents:
13970
diff
changeset
|
465 |
else |
4ae01eabf611
Tweak error messages of /callvote kick
Wuzzy <Wuzzy2@mail.ru>
parents:
13970
diff
changeset
|
466 |
loc "/callvote kick: You need to specify a nickname." |
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
467 |
] |
10039 | 468 |
|
469 |
handleCmd_inRoom ["CALLVOTE", "KICK", nickname] = do |
|
470 |
(thisClientId, rnc) <- ask |
|
471 |
cl <- thisClient |
|
10058 | 472 |
rm <- thisRoom |
10039 | 473 |
maybeClientId <- clientByNick nickname |
474 |
let kickId = fromJust maybeClientId |
|
475 |
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId |
|
476 |
||
10217 | 477 |
if isJust $ masterID rm then |
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
478 |
return [Warning $ loc "/callvote kick: This is only allowed in rooms without a room master."] |
10039 | 479 |
else |
10058 | 480 |
if isJust maybeClientId && sameRoom then |
481 |
startVote $ VoteKick nickname |
|
482 |
else |
|
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
483 |
return [Warning $ loc "/callvote kick: No such user!"] |
10039 | 484 |
|
10195 | 485 |
|
10212 | 486 |
handleCmd_inRoom ["CALLVOTE", "MAP"] = do |
13700
feda0d1da62c
Add error message for /callvote map if no maps are available
Wuzzy <Wuzzy2@mail.ru>
parents:
13697
diff
changeset
|
487 |
-- Display list of available maps for voting |
10212 | 488 |
cl <- thisClient |
489 |
s <- liftM (Map.keys . roomSaves) thisRoom |
|
13700
feda0d1da62c
Add error message for /callvote map if no maps are available
Wuzzy <Wuzzy2@mail.ru>
parents:
13697
diff
changeset
|
490 |
return [AnswerClients [sendChan cl] |
feda0d1da62c
Add error message for /callvote map if no maps are available
Wuzzy <Wuzzy2@mail.ru>
parents:
13697
diff
changeset
|
491 |
["CHAT", nickServer, |
feda0d1da62c
Add error message for /callvote map if no maps are available
Wuzzy <Wuzzy2@mail.ru>
parents:
13697
diff
changeset
|
492 |
if (not $ null s) then |
feda0d1da62c
Add error message for /callvote map if no maps are available
Wuzzy <Wuzzy2@mail.ru>
parents:
13697
diff
changeset
|
493 |
(B.concat ["/callvote map: ", B.intercalate ", " s]) |
feda0d1da62c
Add error message for /callvote map if no maps are available
Wuzzy <Wuzzy2@mail.ru>
parents:
13697
diff
changeset
|
494 |
else |
feda0d1da62c
Add error message for /callvote map if no maps are available
Wuzzy <Wuzzy2@mail.ru>
parents:
13697
diff
changeset
|
495 |
loc "/callvote map: No maps available." |
feda0d1da62c
Add error message for /callvote map if no maps are available
Wuzzy <Wuzzy2@mail.ru>
parents:
13697
diff
changeset
|
496 |
]] |
10212 | 497 |
|
498 |
||
10195 | 499 |
handleCmd_inRoom ["CALLVOTE", "MAP", roomSave] = do |
500 |
cl <- thisClient |
|
501 |
rm <- thisRoom |
|
502 |
||
503 |
if Map.member roomSave $ roomSaves rm then |
|
504 |
startVote $ VoteMap roomSave |
|
505 |
else |
|
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
506 |
return [Warning $ loc "/callvote map: No such map!"] |
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
507 |
|
10195 | 508 |
|
10392 | 509 |
handleCmd_inRoom ["CALLVOTE", "PAUSE"] = do |
510 |
cl <- thisClient |
|
511 |
rm <- thisRoom |
|
512 |
||
513 |
if isJust $ gameInfo rm then |
|
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
514 |
startVote VotePause |
10392 | 515 |
else |
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
516 |
return [Warning $ loc "/callvote pause: No game in progress!"] |
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
517 |
|
13992
863604736cf5
GameServer: Fix protocol error when receiving CALLVOTE cmd with incorrect mode
Wuzzy <Wuzzy2@mail.ru>
parents:
13991
diff
changeset
|
518 |
handleCmd_inRoom ["CALLVOTE", "PAUSE", _] = handleCmd_inRoom ["CALLVOTE", "PAUSE"] |
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
519 |
|
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
520 |
handleCmd_inRoom ["CALLVOTE", "NEWSEED"] = do |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
521 |
startVote VoteNewSeed |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
522 |
|
13992
863604736cf5
GameServer: Fix protocol error when receiving CALLVOTE cmd with incorrect mode
Wuzzy <Wuzzy2@mail.ru>
parents:
13991
diff
changeset
|
523 |
handleCmd_inRoom ["CALLVOTE", "NEWSEED", _] = handleCmd_inRoom ["CALLVOTE", "NEWSEED"] |
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
524 |
|
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
525 |
handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS"] = do |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
526 |
cl <- thisClient |
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
527 |
return [Warning $ loc "/callvote hedgehogs: Specify number from 1 to 8."] |
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
528 |
|
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
529 |
|
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
530 |
handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS", hhs] = do |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
531 |
cl <- thisClient |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
532 |
let h = readInt_ hhs |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
533 |
|
13504
f747c385b5ba
Server: Replace hardcoded hog-related numbers with consts
Wuzzy <Wuzzy2@mail.ru>
parents:
13079
diff
changeset
|
534 |
if h > 0 && h <= cHogsPerTeam then |
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
535 |
startVote $ VoteHedgehogsPerTeam h |
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
536 |
else |
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
537 |
return [Warning $ loc "/callvote hedgehogs: Specify number from 1 to 8."] |
10786
712283ed86e0
Implement /newseed and /hedgehogs commands. Only tested for building.
unc0rr
parents:
10732
diff
changeset
|
538 |
|
13992
863604736cf5
GameServer: Fix protocol error when receiving CALLVOTE cmd with incorrect mode
Wuzzy <Wuzzy2@mail.ru>
parents:
13991
diff
changeset
|
539 |
handleCmd_inRoom ["CALLVOTE", _] = handleCmd_inRoom ["CALLVOTE"] |
863604736cf5
GameServer: Fix protocol error when receiving CALLVOTE cmd with incorrect mode
Wuzzy <Wuzzy2@mail.ru>
parents:
13991
diff
changeset
|
540 |
handleCmd_inRoom ["CALLVOTE", _, _] = handleCmd_inRoom ["CALLVOTE"] |
10195 | 541 |
|
10881
941b5ab9e5a6
"/force" command for server admin to force voting result
unc0rr
parents:
10786
diff
changeset
|
542 |
handleCmd_inRoom ("VOTE" : m : p) = do |
10039 | 543 |
cl <- thisClient |
544 |
let b = if m == "YES" then Just True else if m == "NO" then Just False else Nothing |
|
545 |
if isJust b then |
|
10881
941b5ab9e5a6
"/force" command for server admin to force voting result
unc0rr
parents:
10786
diff
changeset
|
546 |
voted (p == ["FORCE"]) (fromJust b) |
13510
60bcc20e6ab0
Improve some replies for chat commands on server
Wuzzy <Wuzzy2@mail.ru>
parents:
13509
diff
changeset
|
547 |
else |
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
548 |
return [Warning $ |
13510
60bcc20e6ab0
Improve some replies for chat commands on server
Wuzzy <Wuzzy2@mail.ru>
parents:
13509
diff
changeset
|
549 |
if (p == ["FORCE"]) then |
60bcc20e6ab0
Improve some replies for chat commands on server
Wuzzy <Wuzzy2@mail.ru>
parents:
13509
diff
changeset
|
550 |
loc "/force: Please use 'yes' or 'no'." |
60bcc20e6ab0
Improve some replies for chat commands on server
Wuzzy <Wuzzy2@mail.ru>
parents:
13509
diff
changeset
|
551 |
else |
60bcc20e6ab0
Improve some replies for chat commands on server
Wuzzy <Wuzzy2@mail.ru>
parents:
13509
diff
changeset
|
552 |
loc "/vote: Please use 'yes' or 'no'." |
14117
d6915d15b6de
GameServer: Turn some messages into warnings
Wuzzy <Wuzzy2@mail.ru>
parents:
13992
diff
changeset
|
553 |
] |
10039 | 554 |
|
10194 | 555 |
|
11575 | 556 |
handleCmd_inRoom ["SAVE", stateName, location] = serverAdminOnly $ do |
557 |
return [ModifyRoom $ \r -> r{roomSaves = Map.insert stateName (location, mapParams r, params r) (roomSaves r)}] |
|
10194 | 558 |
|
559 |
handleCmd_inRoom ["DELETE", stateName] = serverAdminOnly $ do |
|
560 |
return [ModifyRoom $ \r -> r{roomSaves = Map.delete stateName (roomSaves r)}] |
|
561 |
||
10195 | 562 |
handleCmd_inRoom ["SAVEROOM", fileName] = serverAdminOnly $ do |
563 |
return [SaveRoom fileName] |
|
10194 | 564 |
|
10195 | 565 |
handleCmd_inRoom ["LOADROOM", fileName] = serverAdminOnly $ do |
566 |
return [LoadRoom fileName] |
|
567 |
||
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
|
568 |
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
|
569 |
|
6721
7dbf8a0c1f5d
- Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset
|
570 |
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
|
571 |
|
7dbf8a0c1f5d
- Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset
|
572 |
handleCmd_inRoom [] = return [ProtocolError "Empty command (state: in room)"] |