netserver/HWProto.hs
changeset 1751 b67a124afe53
parent 1748 27dd2967fc65
child 1757 3aa7d21baca1
equal deleted inserted replaced
1750:36023de30dac 1751:b67a124afe53
     4 ) where
     4 ) where
     5 
     5 
     6 import IO
     6 import IO
     7 import Data.List
     7 import Data.List
     8 import Data.Word
     8 import Data.Word
     9 import Data.Sequence(Seq, (|>), empty)
     9 import Data.Sequence(Seq, (|>), (><), fromList, empty)
    10 import Data.Foldable(toList)
    10 import Data.Foldable(toList)
    11 import Miscutils
    11 import Miscutils
    12 import Maybe
    12 import Maybe
    13 import qualified Data.Map as Map
    13 import qualified Data.Map as Map
    14 import Opts
    14 import Opts
   133 	if null (room client) then
   133 	if null (room client) then
   134 		(noChangeClients, noChangeRooms, answerQuit msg ++ (answerQuitLobby (nick client) msg) )
   134 		(noChangeClients, noChangeRooms, answerQuit msg ++ (answerQuitLobby (nick client) msg) )
   135 	else if isMaster client then
   135 	else if isMaster client then
   136 		(modifyRoomClients clRoom (\cl -> cl{isReady = False, partRoom = True}), removeRoom (room client), (answerQuit msg) ++ (answerQuitLobby (nick client) msg) ++ (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client)) -- core disconnects clients on ROOMABANDONED answer
   136 		(modifyRoomClients clRoom (\cl -> cl{isReady = False, partRoom = True}), removeRoom (room client), (answerQuit msg) ++ (answerQuitLobby (nick client) msg) ++ (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client)) -- core disconnects clients on ROOMABANDONED answer
   137 	else
   137 	else
   138 		(noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform (nick client) msg) ++ (answerQuitLobby (nick client) msg) ++ answerRemoveClientTeams)
   138 		if not $ gameinprogress clRoom then
       
   139 			(noChangeClients,
       
   140 			modifyRoom clRoom{
       
   141 				teams = othersTeams,
       
   142 				playersIn = (playersIn clRoom) - 1,
       
   143 				readyPlayers = newReadyPlayers
       
   144 				},
       
   145 			(answerQuit msg) ++
       
   146 			(answerQuitInform (nick client) msg) ++
       
   147 			(answerQuitLobby (nick client) msg) ++
       
   148 			answerRemoveClientTeams)
       
   149 		else
       
   150 			(noChangeClients,
       
   151 			modifyRoom clRoom{
       
   152 				teams = othersTeams,
       
   153 				leftTeams = (map teamname clientTeams) ++ (leftTeams clRoom),
       
   154 				roundMsgs = (roundMsgs clRoom) >< (fromList rmTeamsMsgs),
       
   155 				playersIn = (playersIn clRoom) - 1,
       
   156 				readyPlayers = newReadyPlayers
       
   157 				},
       
   158 			(answerQuit msg) ++
       
   159 			(answerQuitInform (nick client) msg) ++
       
   160 			(answerQuitLobby (nick client) msg) ++
       
   161 			answerRemoveClientTeams ++
       
   162 			answerEngineTeamsRemoveMsg)
   139 	where
   163 	where
   140 		clRoom = roomByName (room client) rooms
   164 		clRoom = roomByName (room client) rooms
   141 		answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams
   165 		answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams
   142 		(clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom
   166 		(clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom
   143 		newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom
   167 		newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom
   144 		msg = if not $ null xs then head xs else ""
   168 		msg = if not $ null xs then head xs else ""
       
   169 		rmTeamsMsgs = map (\team -> toEngineMsg $ 'F' : teamname team) clientTeams
       
   170 		answerEngineTeamsRemoveMsg =
       
   171 			if not $ null rmTeamsMsgs then
       
   172 				answerOthersRoom $ "GAMEMSG" : rmTeamsMsgs
       
   173 			else
       
   174 				[]
   145 
   175 
   146 handleCmd _ _ _ ["PING"] = -- core requsted
   176 handleCmd _ _ _ ["PING"] = -- core requsted
   147 	(noChangeClients, noChangeRooms, answerPing)
   177 	(noChangeClients, noChangeRooms, answerPing)
   148 
   178 
   149 handleCmd _ _ _ ["ASKME"] = -- core requsted
   179 handleCmd _ _ _ ["ASKME"] = -- core requsted
   290 
   320 
   291 handleCmd_inRoom client _ rooms ["PART"] =
   321 handleCmd_inRoom client _ rooms ["PART"] =
   292 	if isMaster client then
   322 	if isMaster client then
   293 		(modifyRoomClients clRoom (\cl -> cl{isReady = False, isMaster = False, partRoom = True}), removeRoom (room client), (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client))
   323 		(modifyRoomClients clRoom (\cl -> cl{isReady = False, isMaster = False, partRoom = True}), removeRoom (room client), (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client))
   294 	else
   324 	else
   295 		(modifyClient client{isReady = False, partRoom = True}, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerPartInform (nick client)) ++ answerRemoveClientTeams)
   325 			if not $ gameinprogress clRoom then
       
   326 				(modifyClient client{
       
   327 					isReady = False,
       
   328 					partRoom = True
       
   329 					},
       
   330 				 modifyRoom clRoom{
       
   331 				 	teams = othersTeams,
       
   332 				 	playersIn = (playersIn clRoom) - 1,
       
   333 				 	readyPlayers = newReadyPlayers
       
   334 				 	},
       
   335 				 (answerPartInform (nick client)) ++ answerRemoveClientTeams)
       
   336 			else
       
   337 				(modifyClient client{
       
   338 					isReady = False,
       
   339 					partRoom = True
       
   340 					},
       
   341 				modifyRoom clRoom{
       
   342 					teams = othersTeams,
       
   343 					leftTeams = (map teamname clientTeams) ++ (leftTeams clRoom),
       
   344 					roundMsgs = (roundMsgs clRoom) >< (fromList rmTeamsMsgs),
       
   345 				 	playersIn = (playersIn clRoom) - 1,
       
   346 				 	readyPlayers = newReadyPlayers
       
   347 					},
       
   348 				answerEngineTeamsRemoveMsg ++
       
   349 				(answerPartInform (nick client)) ++
       
   350 				answerRemoveClientTeams)
   296 	where
   351 	where
   297 		clRoom = roomByName (room client) rooms
   352 		clRoom = roomByName (room client) rooms
   298 		answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams
   353 		answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams
   299 		(clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom
   354 		(clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom
   300 		newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom
   355 		newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom
       
   356 		rmTeamsMsgs = map (\team -> toEngineMsg $ 'F' : teamname team) clientTeams
       
   357 		answerEngineTeamsRemoveMsg =
       
   358 			if not $ null rmTeamsMsgs then
       
   359 				answerOthersRoom $ "GAMEMSG" : rmTeamsMsgs
       
   360 			else
       
   361 				[]
       
   362 
   301 
   363 
   302 handleCmd_inRoom client _ rooms ["MAP", mapName] =
   364 handleCmd_inRoom client _ rooms ["MAP", mapName] =
   303 	if isMaster client then
   365 	if isMaster client then
   304 		(noChangeClients, modifyRoom clRoom{gamemap = mapName}, answerMap mapName)
   366 		(noChangeClients, modifyRoom clRoom{gamemap = mapName}, answerMap mapName)
   305 	else
   367 	else
   435 		(noChangeClients, noChangeRooms, [])
   497 		(noChangeClients, noChangeRooms, [])
   436 	where
   498 	where
   437 		clRoom = roomByName (room client) rooms
   499 		clRoom = roomByName (room client) rooms
   438 		sameRoomClients = filter (\ci -> room ci == name clRoom) clients
   500 		sameRoomClients = filter (\ci -> room ci == name clRoom) clients
   439 		answerAllNotReady = concatMap (\cl -> answerSameRoom ["NOT_READY", nick cl]) sameRoomClients
   501 		answerAllNotReady = concatMap (\cl -> answerSameRoom ["NOT_READY", nick cl]) sameRoomClients
   440 		answerRemovedTeams = concatMap answerRemoveTeam $ leftTeams clRoom
   502 		answerRemovedTeams = concatMap (\t -> answerSameRoom ["REMOVE_TEAM", t]) $ leftTeams clRoom
   441 
   503 
   442 handleCmd_inRoom client _ rooms ["GAMEMSG", msg] =
   504 handleCmd_inRoom client _ rooms ["GAMEMSG", msg] =
   443 	(noChangeClients, addMsg, answerOthersRoom ["GAMEMSG", msg])
   505 	(noChangeClients, addMsg, answerOthersRoom ["GAMEMSG", msg])
   444 	where
   506 	where
   445 		addMsg = if roomProto clRoom < 20 then
   507 		addMsg = if roomProto clRoom < 20 then