gameServer/HWProtoNEState.hs
author unc0rr
Mon, 23 Feb 2009 20:34:29 +0000
changeset 1834 71cb978dc85f
parent 1804 4e78ad846fb6
child 1841 fba7210b438b
permissions -rw-r--r--
Add working check for www account existance
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module HWProtoNEState 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
import Maybe
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import Data.List
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Data.Word
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
handleCmd_NotEntered :: CmdHandler
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
onLoginFinished :: Int -> String -> Word16 -> Clients -> [Action]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
onLoginFinished clID clientNick clProto clients =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
	if (null $ clientNick) || (clProto == 0) then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
		(RoomAddThisClient 0)
1834
71cb978dc85f Add working check for www account existance
unc0rr
parents: 1804
diff changeset
    20
		: CheckRegistered
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
		: answerLobbyNicks
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
		-- ++ (answerServerMessage client clients)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
		lobbyNicks = filter (\n -> (not (null n))) $ map nick $ IntMap.elems clients
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
		answerLobbyNicks = if not $ null lobbyNicks then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
					[AnswerThisClient (["LOBBY:JOINED"] ++ lobbyNicks)]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
				else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
					[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
handleCmd_NotEntered clID clients _ ["NICK", newNick] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
	if not . null $ nick client then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
		[ProtocolError "Nick already chosen"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
	else if haveSameNick then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
		[AnswerThisClient ["WARNING", "Nick collision"]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
		++ [ByeClient ""]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
		[ModifyClient (\c -> c{nick = newNick}),
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
		AnswerThisClient ["NICK", newNick]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
		++ (onLoginFinished clID newNick (clientProto client) clients)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    42
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    43
		haveSameNick = isJust $ find (\cl -> newNick == nick cl) $ IntMap.elems clients
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    45
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
handleCmd_NotEntered clID clients _ ["PROTO", protoNum] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    47
	if clientProto client > 0 then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
		[ProtocolError "Protocol already known"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
	else if parsedProto == 0 then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
		[ProtocolError "Bad number"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
		[ModifyClient (\c -> c{clientProto = parsedProto}),
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
		AnswerThisClient ["PROTO", show parsedProto]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
		++ (onLoginFinished clID (nick client) parsedProto clients)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    57
		parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    58
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    59
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    60
handleCmd_NotEntered _ _ _ ["DUMP"] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    61
	[Dump]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    62
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    63
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    64
handleCmd_NotEntered clID _ _ _ = [ProtocolError "Incorrect command (state: not entered)"]