gameServer/HWProtoCore.hs
branchserver_refactor
changeset 4612 e82758d6f924
parent 4337 85e02b1a8e8f
child 4614 26661bf28dd5
equal deleted inserted replaced
4610:9541b2a76067 4612:e82758d6f924
     1 {-# LANGUAGE OverloadedStrings #-}
     1 {-# LANGUAGE OverloadedStrings #-}
     2 module HWProtoCore where
     2 module HWProtoCore where
     3 
     3 
     4 import qualified Data.IntMap as IntMap
     4 import Control.Monad.Reader
     5 import Data.Foldable
       
     6 import Data.Maybe
     5 import Data.Maybe
     7 import Control.Monad.Reader
     6 import Data.List
       
     7 import qualified Data.ByteString.Char8 as B
     8 --------------------------------------
     8 --------------------------------------
     9 import CoreTypes
     9 import CoreTypes
    10 import Actions
    10 import Actions
    11 import Utils
       
    12 import HWProtoNEState
    11 import HWProtoNEState
    13 import HWProtoLobbyState
    12 import HWProtoLobbyState
    14 import HWProtoInRoomState
    13 import HWProtoInRoomState
    15 import HandlerUtils
    14 import HandlerUtils
    16 import RoomsAndClients
    15 import RoomsAndClients
       
    16 import Utils
    17 
    17 
    18 handleCmd, handleCmd_loggedin :: CmdHandler
    18 handleCmd, handleCmd_loggedin :: CmdHandler
    19 
    19 
    20 
    20 
    21 handleCmd ["PING"] = answerClient ["PONG"]
    21 handleCmd ["PING"] = answerClient ["PONG"]
    22 
    22 
    23 
    23 
    24 handleCmd ("QUIT" : xs) = return [ByeClient msg]
    24 handleCmd ("QUIT" : xs) = return [ByeClient msg]
    25     where
    25     where
    26         msg = if not $ null xs then head xs else ""
    26         msg = if not $ null xs then head xs else "bye"
    27 
    27 
    28 {-
    28 
    29 handleCmd ["PONG"] =
    29 handleCmd ["PONG"] = do
    30     if pingsQueue client == 0 then
    30     cl <- thisClient
    31         [ProtocolError "Protocol violation"]
    31     if pingsQueue cl == 0 then
    32     else
    32         return [ProtocolError "Protocol violation"]
    33         [ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})]
    33         else
    34     where
    34         return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})]
    35         client = clients IntMap.! clID
       
    36 -}
       
    37 
    35 
    38 handleCmd cmd = do
    36 handleCmd cmd = do
    39     (ci, irnc) <- ask
    37     (ci, irnc) <- ask
    40     if logonPassed (irnc `client` ci) then
    38     if logonPassed (irnc `client` ci) then
    41         handleCmd_loggedin cmd
    39         handleCmd_loggedin cmd
    42         else
    40         else
    43         handleCmd_NotEntered cmd
    41         handleCmd_NotEntered cmd
    44 
    42 
    45 {-
    43 
    46 handleCmd_loggedin clID clients rooms ["INFO", asknick] =
    44 handleCmd_loggedin ["INFO", asknick] = do
       
    45     (_, rnc) <- ask
       
    46     let allClientIDs = allClients rnc
       
    47     let maybeClientId = find (\clId -> asknick == nick (client rnc clId)) allClientIDs
       
    48     let noSuchClient = isNothing maybeClientId
       
    49     let clientId = fromJust maybeClientId
       
    50     let cl = rnc `client` fromJust maybeClientId
       
    51     let roomId = clientRoom rnc clientId
       
    52     let clRoom = room rnc roomId
       
    53     let roomMasterSign = if isMaster cl then "@" else ""
       
    54     let adminSign = if isAdministrator cl then "@" else ""
       
    55     let roomInfo = if roomId /= lobbyId then roomMasterSign `B.append` "room " `B.append` (name clRoom) else adminSign `B.append` "lobby"
       
    56     let roomStatus = if gameinprogress clRoom then
       
    57             if teamsInGame cl > 0 then "(playing)" else "(spectating)"
       
    58             else
       
    59             ""
    47     if noSuchClient then
    60     if noSuchClient then
    48         []
    61         return []
    49     else
    62         else
    50         [AnswerThisClient
    63         answerClient [
    51             ["INFO",
    64             "INFO",
    52             nick client,
    65             nick cl,
    53             "[" ++ host client ++ "]",
    66             "[" `B.append` host cl `B.append` "]",
    54             protoNumber2ver $ clientProto client,
    67             protoNumber2ver $ clientProto cl,
    55             "[" ++ roomInfo ++ "]" ++ roomStatus]]
    68             "[" `B.append` roomInfo `B.append` "]" `B.append` roomStatus
    56     where
    69             ]
    57         maybeClient = find (\cl -> asknick == nick cl) clients
       
    58         noSuchClient = isNothing maybeClient
       
    59         client = fromJust maybeClient
       
    60         room = rooms IntMap.! roomID client
       
    61         roomInfo = if roomID client /= 0 then roomMasterSign ++ "room " ++ (name room) else adminSign ++ "lobby"
       
    62         roomMasterSign = if isMaster client then "@" else ""
       
    63         adminSign = if isAdministrator client then "@" else ""
       
    64         roomStatus =
       
    65             if gameinprogress room
       
    66             then if teamsInGame client > 0 then "(playing)" else "(spectating)"
       
    67             else ""
       
    68 
       
    69 -}
       
    70 
    70 
    71 
    71 
    72 handleCmd_loggedin cmd = do
    72 handleCmd_loggedin cmd = do
    73     (ci, rnc) <- ask
    73     (ci, rnc) <- ask
    74     if clientRoom rnc ci == lobbyId then
    74     if clientRoom rnc ci == lobbyId then