gameServer/HWProtoInRoomState.hs
author unc0rr
Fri, 01 May 2009 09:01:44 +0000
changeset 2021 a591afb43768
parent 1977 2284d7fefe4f
child 2126 cb249fa8e3da
permissions -rw-r--r--
Some changes in try to fix issue when you enter room with painted map, but frontend shows generated one (most probably bug is triggered by template filters) Untested.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module HWProtoInRoomState where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
     3
import qualified Data.Foldable as Foldable
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
import qualified Data.IntMap as IntMap
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import qualified Data.Map as Map
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Data.Sequence(Seq, (|>), (><), fromList, empty)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Data.List
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Maybe
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
handleCmd_inRoom :: CmdHandler
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
1815
3d62cf9c350e Save some more bytes in protocol
unc0rr
parents: 1814
diff changeset
    17
handleCmd_inRoom clID clients _ ["CHAT", msg] =
3d62cf9c350e Save some more bytes in protocol
unc0rr
parents: 1814
diff changeset
    18
	[AnswerOthersInRoom ["CHAT", clientNick, msg]]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
		clientNick = nick $ clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
1811
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
    22
1814
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1813
diff changeset
    23
handleCmd_inRoom clID clients rooms ["PART"] =
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
	if isMaster client then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
		[RemoveRoom]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
	else
1818
4391c7037281 Fix team removing on PART command
unc0rr
parents: 1815
diff changeset
    27
		[RoomRemoveThisClient]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
1811
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
    31
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs) =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
	if isMaster client then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
		[ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)})
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
		, AnswerOthersInRoom ("CFG" : paramName : paramStrs)]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
		[ProtocolError "Not room master"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : difStr : hhsInfo)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    42
	| length hhsInfo == 16 =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    43
	if length (teams room) == 6 then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
		[Warning "too many teams"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    45
	else if canAddNumber <= 0 then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
		[Warning "too many hedgehogs"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    47
	else if isJust findTeam then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
		[Warning "already have a team with same name"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
	else if gameinprogress room then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
		[Warning "round in progress"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
	else if isRestrictedTeams room then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
		[Warning "restricted"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
		[ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}),
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
		AnswerThisClient ["TEAM_ACCEPTED", name],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
		AnswerOthersInRoom $ teamToNet newTeam,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    57
		AnswerOthersInRoom ["TEAM_COLOR", name, color]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    58
		]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    59
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    60
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    61
		room = rooms IntMap.! (roomID client)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    62
		canAddNumber = 48 - (sum . map hhnum $ teams room)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    63
		findTeam = find (\t -> name == teamname t) $ teams room
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    64
		newTeam = (TeamInfo (nick client) name color grave fort voicepack difficulty newTeamHHNum (hhsList hhsInfo))
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    65
		difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    66
		hhsList [] = []
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    67
		hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    68
		newTeamHHNum = min 4 canAddNumber
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    69
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    70
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    71
handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    72
	if noSuchTeam then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    73
		[Warning "REMOVE_TEAM: no such team"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    74
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    75
		if not $ nick client == teamowner team then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    76
			[ProtocolError "Not team owner!"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    77
		else
1813
cfe1481e0247 Removeteam action
unc0rr
parents: 1811
diff changeset
    78
			[RemoveTeam teamName]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    79
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    80
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    81
		room = rooms IntMap.! (roomID client)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    82
		noSuchTeam = isNothing findTeam
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    83
		team = fromJust findTeam
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    84
		findTeam = find (\t -> teamName == teamname t) $ teams room
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    85
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    86
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    87
handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    88
	if not $ isMaster client then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    89
		[ProtocolError "Not room master"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    90
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    91
		if hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    92
			[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    93
		else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    94
			[ModifyRoom $ modifyTeam team{hhnum = hhNumber},
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    95
			AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    96
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    97
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    98
		room = rooms IntMap.! (roomID client)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    99
		hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   100
		noSuchTeam = isNothing findTeam
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   101
		team = fromJust findTeam
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   102
		findTeam = find (\t -> teamName == teamname t) $ teams room
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   103
		canAddNumber = 48 - (sum . map hhnum $ teams room)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   104
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   105
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   106
handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   107
	if not $ isMaster client then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   108
		[ProtocolError "Not room master"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   109
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   110
		if noSuchTeam then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   111
			[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   112
		else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   113
			[ModifyRoom $ modifyTeam team{teamcolor = newColor},
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   114
			AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   115
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   116
		noSuchTeam = isNothing findTeam
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   117
		team = fromJust findTeam
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   118
		findTeam = find (\t -> teamName == teamname t) $ teams room
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   119
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   120
		room = rooms IntMap.! (roomID client)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   121
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   122
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   123
handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   124
	[ModifyClient (\c -> c{isReady = not $ isReady client}),
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   125
	ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}),
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   126
	AnswerThisRoom $ [if isReady client then "NOT_READY" else "READY", nick client]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   127
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   128
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   129
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   130
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   131
handleCmd_inRoom clID clients rooms ["START_GAME"] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   132
	if isMaster client && (playersIn room == readyPlayers room) && (not $ gameinprogress room) then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   133
		if enoughClans then
1811
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   134
			[ModifyRoom
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   135
					(\r -> r{
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   136
						gameinprogress = True,
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   137
						roundMsgs = empty,
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   138
						leftTeams = [],
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   139
						teamsAtStart = teams r}
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   140
					),
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   141
			AnswerThisRoom ["RUN_GAME"]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   142
		else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   143
			[Warning "Less than two clans!"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   144
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   145
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   146
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   147
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   148
		room = rooms IntMap.! (roomID client)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   149
		enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   150
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   151
1866
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1831
diff changeset
   152
handleCmd_inRoom _ _ rooms ["EM", msg] =
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   153
	[ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}),
1866
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1831
diff changeset
   154
	AnswerOthersInRoom ["EM", msg]]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   155
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   156
1811
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   157
handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] =
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   158
	if isMaster client then
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   159
		[ModifyRoom
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   160
				(\r -> r{
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   161
					gameinprogress = False,
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   162
					readyPlayers = 0,
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   163
					roundMsgs = empty,
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   164
					leftTeams = [],
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   165
					teamsAtStart = []}
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   166
				),
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   167
		UnreadyRoomClients
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   168
		] ++ answerRemovedTeams
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   169
	else
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   170
		[]
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   171
	where
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   172
		client = clients IntMap.! clID
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   173
		room = rooms IntMap.! (roomID client)
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   174
		answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   175
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   176
1831
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   177
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_JOINS"] =
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   178
	if isMaster client then
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   179
		[ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})]
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   180
	else
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   181
		[ProtocolError "Not room master"]
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   182
	where
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   183
		client = clients IntMap.! clID
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   184
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   185
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   186
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_TEAMS"] =
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   187
	if isMaster client then
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   188
		[ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})]
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   189
	else
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   190
		[ProtocolError "Not room master"]
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   191
	where
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   192
		client = clients IntMap.! clID
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   193
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   194
handleCmd_inRoom clID clients rooms ["KICK", kickNick] =
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   195
	if not $ isMaster client then
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   196
		[]
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   197
	else
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   198
		if noSuchClient then
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   199
			[]
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   200
		else
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   201
			if (kickID == clID) || (roomID client /= roomID kickClient) then
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   202
				[]
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   203
			else
1929
7e6cc8da1c58 - Fix bug with kicking players
unc0rr
parents: 1879
diff changeset
   204
				[KickRoomClient kickID]
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   205
	where
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   206
		client = clients IntMap.! clID
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   207
		maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   208
		noSuchClient = isNothing maybeClient
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   209
		kickClient = fromJust maybeClient
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   210
		kickID = clientUID kickClient
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   211
1831
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   212
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   213
handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]