gameServer/HWProtoCore.hs
author nemo
Tue, 08 Sep 2009 19:44:49 +0000
changeset 2357 babe1a55e284
parent 2318 f3407513dc42
child 2706 935b7d618cf0
permissions -rw-r--r--
Add an empty weapon to avoid selection of weapons which aren't yet ready. Might all be useful to switch to amNothing in certain situations, like after using up all ropes, instead of bazooka.
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
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    66
handleCmd_loggedin clID clients rooms cmd =
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    67
	if roomID client == 0 then
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    68
		handleCmd_lobby clID clients rooms cmd
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    69
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    70
		handleCmd_inRoom clID clients rooms cmd
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    71
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    72
		client = clients IntMap.! clID