gameServer/HWProtoCore.hs
author koda
Thu, 24 Mar 2011 17:28:36 +0100
changeset 5046 fc6639d56799
parent 5030 42746c5d4a80
child 5060 7d0f6e5b1c1c
permissions -rw-r--r--
this brings compatibility up with SDL HEAD (5504), but maybe breaks compatibility with sdl 1.2 so please test! still has problems with keyboard input and rendered ttf textures
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
     1
{-# LANGUAGE OverloadedStrings #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
module HWProtoCore where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
     4
import Control.Monad.Reader
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
     5
import Data.Maybe
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
     6
import qualified Data.ByteString.Char8 as B
1804
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 HWProtoNEState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import HWProtoLobbyState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import HWProtoInRoomState
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    13
import HandlerUtils
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    14
import RoomsAndClients
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    15
import Utils
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4975
diff changeset
    17
handleCmd, handleCmd_loggedin :: CmdHandler
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    19
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    20
handleCmd ["PING"] = answerClient ["PONG"]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    23
handleCmd ("QUIT" : xs) = return [ByeClient msg]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    24
    where
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    25
        msg = if not $ null xs then head xs else "bye"
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    27
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    28
handleCmd ["PONG"] = do
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    29
    cl <- thisClient
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    30
    if pingsQueue cl == 0 then
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    31
        return [ProtocolError "Protocol violation"]
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    32
        else
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    33
        return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})]
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    34
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    35
handleCmd cmd = do
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    36
    (ci, irnc) <- ask
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    37
    if logonPassed (irnc `client` ci) then
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    38
        handleCmd_loggedin cmd
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    39
        else
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    40
        handleCmd_NotEntered cmd
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    41
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    42
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    43
handleCmd_loggedin ["INFO", asknick] = do
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    44
    (_, rnc) <- ask
4614
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 4612
diff changeset
    45
    maybeClientId <- clientByNick asknick
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    46
    let noSuchClient = isNothing maybeClientId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    47
    let clientId = fromJust maybeClientId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    48
    let cl = rnc `client` fromJust maybeClientId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    49
    let roomId = clientRoom rnc clientId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    50
    let clRoom = room rnc roomId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    51
    let roomMasterSign = if isMaster cl then "@" else ""
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    52
    let adminSign = if isAdministrator cl then "@" else ""
5030
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4989
diff changeset
    53
    let roomInfo = if roomId /= lobbyId then B.concat [roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby"
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    54
    let roomStatus = if gameinprogress clRoom then
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    55
            if teamsInGame cl > 0 then "(playing)" else "(spectating)"
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    56
            else
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    57
            ""
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    58
    if noSuchClient then
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    59
        return []
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    60
        else
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    61
        answerClient [
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    62
            "INFO",
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    63
            nick cl,
5030
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4989
diff changeset
    64
            B.concat ["[", host cl, "]"],
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    65
            protoNumber2ver $ clientProto cl,
5030
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4989
diff changeset
    66
            B.concat ["[", roomInfo, "]", roomStatus]
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    67
            ]
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    68
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    69
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    70
handleCmd_loggedin cmd = do
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    71
    (ci, rnc) <- ask
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    72
    if clientRoom rnc ci == lobbyId then
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    73
        handleCmd_lobby cmd
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    74
        else
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    75
        handleCmd_inRoom cmd