gameServer/HWProtoCore.hs
author koda
Sat, 20 Mar 2010 15:16:59 +0000
changeset 3025 01682ec58eb0
parent 2961 3e057dfa601f
child 3435 4e4f88a7bdf2
permissions -rw-r--r--
update project for ipad target relocate objects (windbar, fps, timer) so that window size doesn't matter move touch input in its custom controller rather than hack sdl one
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) =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    19
    [ByeClient msg]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    20
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    21
        msg = if not $ null xs then head xs else ""
1804
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"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    25
    if pingsQueue client == 0 then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    26
        [ProtocolError "Protocol violation"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    27
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    28
        [ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    29
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    30
        client = clients IntMap.! clID
1928
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 =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    34
    if not $ logonPassed client then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    35
        handleCmd_NotEntered clID clients rooms cmd
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    36
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    37
        handleCmd_loggedin clID clients rooms cmd
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    38
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    39
        client = clients IntMap.! clID
1862
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] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    43
    if noSuchClient then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    44
        []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    45
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    46
        [AnswerThisClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    47
            ["INFO",
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    48
            nick client,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    49
            "[" ++ host client ++ "]",
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    50
            protoNumber2ver $ clientProto client,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    51
            "[" ++ roomInfo ++ "]" ++ roomStatus]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    52
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    53
        maybeClient = find (\cl -> asknick == nick cl) clients
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    54
        noSuchClient = isNothing maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    55
        client = fromJust maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    56
        room = rooms IntMap.! roomID client
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    57
        roomInfo = if roomID client /= 0 then roomMasterSign ++ "room " ++ (name room) else adminSign ++ "lobby"
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    58
        roomMasterSign = if isMaster client then "@" else ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    59
        adminSign = if isAdministrator client then "@" else ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    60
        roomStatus =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    61
            if gameinprogress room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    62
            then if teamsInGame client > 0 then "(playing)" else "(spectating)"
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
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 =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    67
    if roomID client == 0 then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    68
        handleCmd_lobby clID clients rooms cmd
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    69
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    70
        handleCmd_inRoom clID clients rooms cmd
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    71
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    72
        client = clients IntMap.! clID