gameServer/HWProtoCore.hs
changeset 4568 f85243bf890e
parent 4337 85e02b1a8e8f
child 4904 0eab727d4717
equal deleted inserted replaced
4566:87ee1be17d27 4568:f85243bf890e
     1 {-# LANGUAGE OverloadedStrings #-}
       
     2 module HWProtoCore where
     1 module HWProtoCore where
     3 
     2 
     4 import qualified Data.IntMap as IntMap
     3 import qualified Data.IntMap as IntMap
     5 import Data.Foldable
     4 import Data.Foldable
     6 import Data.Maybe
     5 import Data.Maybe
     7 import Control.Monad.Reader
       
     8 --------------------------------------
     6 --------------------------------------
     9 import CoreTypes
     7 import CoreTypes
    10 import Actions
     8 import Actions
    11 import Utils
     9 import Utils
    12 import HWProtoNEState
    10 import HWProtoNEState
    13 import HWProtoLobbyState
    11 import HWProtoLobbyState
    14 import HWProtoInRoomState
    12 import HWProtoInRoomState
    15 import HandlerUtils
       
    16 import RoomsAndClients
       
    17 
    13 
    18 handleCmd, handleCmd_loggedin :: CmdHandler
    14 handleCmd, handleCmd_loggedin :: CmdHandler
    19 
    15 
       
    16 handleCmd clID _ _ ["PING"] = [AnswerThisClient ["PONG"]]
    20 
    17 
    21 handleCmd ["PING"] = answerClient ["PONG"]
    18 handleCmd clID clients rooms ("QUIT" : xs) =
    22 
    19     [ByeClient msg]
    23 
       
    24 handleCmd ("QUIT" : xs) = return [ByeClient msg]
       
    25     where
    20     where
    26         msg = if not $ null xs then head xs else ""
    21         msg = if not $ null xs then head xs else ""
    27 
    22 
    28 {-
    23 
    29 handleCmd ["PONG"] =
    24 handleCmd clID clients _ ["PONG"] =
    30     if pingsQueue client == 0 then
    25     if pingsQueue client == 0 then
    31         [ProtocolError "Protocol violation"]
    26         [ProtocolError "Protocol violation"]
    32     else
    27     else
    33         [ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})]
    28         [ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})]
    34     where
    29     where
    35         client = clients IntMap.! clID
    30         client = clients IntMap.! clID
    36 -}
       
    37 
    31 
    38 handleCmd cmd = do
       
    39     (ci, irnc) <- ask
       
    40     if logonPassed (irnc `client` ci) then
       
    41         handleCmd_loggedin cmd
       
    42         else
       
    43         handleCmd_NotEntered cmd
       
    44 
    32 
    45 {-
    33 handleCmd clID clients rooms cmd =
       
    34     if not $ logonPassed client then
       
    35         handleCmd_NotEntered clID clients rooms cmd
       
    36     else
       
    37         handleCmd_loggedin clID clients rooms cmd
       
    38     where
       
    39         client = clients IntMap.! clID
       
    40 
       
    41 
    46 handleCmd_loggedin clID clients rooms ["INFO", asknick] =
    42 handleCmd_loggedin clID clients rooms ["INFO", asknick] =
    47     if noSuchClient then
    43     if noSuchClient then
    48         []
    44         []
    49     else
    45     else
    50         [AnswerThisClient
    46         [AnswerThisClient
    64         roomStatus =
    60         roomStatus =
    65             if gameinprogress room
    61             if gameinprogress room
    66             then if teamsInGame client > 0 then "(playing)" else "(spectating)"
    62             then if teamsInGame client > 0 then "(playing)" else "(spectating)"
    67             else ""
    63             else ""
    68 
    64 
    69 -}
       
    70 
    65 
    71 
    66 handleCmd_loggedin clID clients rooms cmd =
    72 handleCmd_loggedin cmd = do
    67     if roomID client == 0 then
    73     (ci, rnc) <- ask
    68         handleCmd_lobby clID clients rooms cmd
    74     if clientRoom rnc ci == lobbyId then
    69     else
    75         handleCmd_lobby cmd
    70         handleCmd_inRoom clID clients rooms cmd
    76         else
    71     where
    77         handleCmd_inRoom cmd
    72         client = clients IntMap.! clID