gameServer/HWProtoCore.hs
author unc0rr
Mon, 23 Feb 2009 20:15:02 +0000
changeset 1832 1fb61a53a2c2
parent 1814 e5391d901cff
child 1841 fba7210b438b
permissions -rw-r--r--
Add options for database access
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import HWProtoNEState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import HWProtoLobbyState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import HWProtoInRoomState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
handleCmd:: CmdHandler
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
handleCmd clID _ _ ["PING"] = [AnswerThisClient ["PONG"]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
1814
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    16
handleCmd clID clients rooms ("QUIT" : xs) =
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    17
	(if isMaster client then [RemoveRoom] else removeClientTeams)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
	++ [ByeClient msg]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
		clientNick = nick client
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
		msg = if not $ null xs then head xs else ""
1814
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    23
		room = rooms IntMap.! (roomID client)
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    24
		clientTeams = filter (\t -> teamowner t == nick client) $ teams room
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    25
		removeClientTeams = map (RemoveTeam . teamname) clientTeams
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
handleCmd clID clients rooms cmd =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
	if null (nick client) || clientProto client == 0 then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
		handleCmd_NotEntered clID clients rooms cmd
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
	else if roomID client == 0 then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
		handleCmd_lobby clID clients rooms cmd
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
		handleCmd_inRoom clID clients rooms cmd
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36