gameServer/HWProtoCore.hs
author smxx
Thu, 04 Feb 2010 20:49:23 +0000
changeset 2749 0d24a4a9a82a
parent 2706 935b7d618cf0
child 2867 9be6693c78cb
permissions -rw-r--r--
Frontend: * Updated graphics by Tiyuri
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module HWProtoCore where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
import qualified Data.IntMap as IntMap
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
     4
import Data.Foldable
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
     5
import Maybe
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import HWProtoNEState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import HWProtoLobbyState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import HWProtoInRoomState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    14
handleCmd, handleCmd_loggedin :: CmdHandler
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
handleCmd clID _ _ ["PING"] = [AnswerThisClient ["PONG"]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
1814
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    18
handleCmd clID clients rooms ("QUIT" : xs) =
1929
7e6cc8da1c58 - Fix bug with kicking players
unc0rr
parents: 1928
diff changeset
    19
	[ByeClient msg]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
		msg = if not $ null xs then head xs else ""
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    23
1928
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    24
handleCmd clID clients _ ["PONG"] =
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    25
	if pingsQueue client == 0 then
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    26
		[ProtocolError "Protocol violation"]
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    27
	else
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    28
		[ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})]
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    29
	where
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    30
		client = clients IntMap.! clID
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    31
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    32
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
handleCmd clID clients rooms cmd =
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1814
diff changeset
    34
	if not $ logonPassed client then
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
		handleCmd_NotEntered clID clients rooms cmd
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    36
	else
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    37
		handleCmd_loggedin clID clients rooms cmd
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    38
	where
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    39
		client = clients IntMap.! clID
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    40
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    41
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    42
handleCmd_loggedin clID clients rooms ["INFO", asknick] =
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    43
	if noSuchClient then
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    44
		[]
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    45
	else
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    46
		[AnswerThisClient
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    47
			["INFO",
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    48
			nick client,
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    49
			"[" ++ host client ++ "]",
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    50
			protoNumber2ver $ clientProto client,
2311
977ee15c3c1f Show player's room status (plays/spectates)
unc0rr
parents: 2126
diff changeset
    51
			"[" ++ roomInfo ++ "]" ++ roomStatus]]
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    52
	where
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    53
		maybeClient = find (\cl -> asknick == nick cl) clients
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    54
		noSuchClient = isNothing maybeClient
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    55
		client = fromJust maybeClient
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    56
		room = rooms IntMap.! roomID client
2126
cb249fa8e3da - Prevent server from producing zombies
unc0rr
parents: 1929
diff changeset
    57
		roomInfo = if roomID client /= 0 then roomMasterSign ++ "room " ++ (name room) else adminSign ++ "lobby"
cb249fa8e3da - Prevent server from producing zombies
unc0rr
parents: 1929
diff changeset
    58
		roomMasterSign = if isMaster client then "@" else ""
cb249fa8e3da - Prevent server from producing zombies
unc0rr
parents: 1929
diff changeset
    59
		adminSign = if isAdministrator client then "@" else ""
2311
977ee15c3c1f Show player's room status (plays/spectates)
unc0rr
parents: 2126
diff changeset
    60
		roomStatus =
977ee15c3c1f Show player's room status (plays/spectates)
unc0rr
parents: 2126
diff changeset
    61
			if gameinprogress room
2318
f3407513dc42 Fix my bad English
unc0rr
parents: 2311
diff changeset
    62
			then if teamsInGame client > 0 then "(playing)" else "(spectating)"
2311
977ee15c3c1f Show player's room status (plays/spectates)
unc0rr
parents: 2126
diff changeset
    63
			else ""
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    64
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    65
2706
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    66
handleCmd_loggedin clID clients rooms ["FOLLOW", asknick] =
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    67
	if inLobby || noSuchClient then
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    68
		[]
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    69
	else
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    70
		handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomname]
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    71
	where
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    72
		maybeClient = find (\cl -> asknick == nick cl) clients
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    73
		noSuchClient = isNothing maybeClient
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    74
		client = fromJust maybeClient
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    75
		room = rooms IntMap.! roomID client
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    76
		roomname = (name room)
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    77
		inLobby = roomname == ""
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    78
935b7d618cf0 sheepluva's patch to add a "follow" command to server and frontend, in order to stalk people and join them in their rooms
koda
parents: 2318
diff changeset
    79
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    80
handleCmd_loggedin clID clients rooms cmd =
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    81
	if roomID client == 0 then
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    82
		handleCmd_lobby clID clients rooms cmd
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    83
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    84
		handleCmd_inRoom clID clients rooms cmd
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    85
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    86
		client = clients IntMap.! clID