gameServer/HWProtoLobbyState.hs
branchui-scaling
changeset 15288 c4fd2813b127
parent 14386 32e8c81ca35c
equal deleted inserted replaced
13395:0135e64c6c66 15288:c4fd2813b127
    24 import Control.Monad.Reader
    24 import Control.Monad.Reader
    25 import qualified Data.ByteString.Char8 as B
    25 import qualified Data.ByteString.Char8 as B
    26 --------------------------------------
    26 --------------------------------------
    27 import CoreTypes
    27 import CoreTypes
    28 import Utils
    28 import Utils
       
    29 import Consts
    29 import HandlerUtils
    30 import HandlerUtils
    30 import RoomsAndClients
    31 import RoomsAndClients
    31 import EngineInteraction
    32 import EngineInteraction
       
    33 import CommandHelp
    32 
    34 
    33 
    35 
    34 handleCmd_lobby :: CmdHandler
    36 handleCmd_lobby :: CmdHandler
    35 
    37 
    36 
    38 
   114             ++ [AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+h", nick $ fromJust owner] | isJust owner]
   116             ++ [AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+h", nick $ fromJust owner] | isJust owner]
   115             ++ [sendStateFlags cl jRoomClients | not $ null jRoomClients]
   117             ++ [sendStateFlags cl jRoomClients | not $ null jRoomClients]
   116             ++ answerFullConfig cl jRoom
   118             ++ answerFullConfig cl jRoom
   117             ++ answerTeams cl jRoom
   119             ++ answerTeams cl jRoom
   118             ++ watchRound cl jRoom chans
   120             ++ watchRound cl jRoom chans
   119             ++ [AnswerClients [sendChan cl] ["CHAT", "[greeting]", greeting jRoom] | greeting jRoom /= ""]
   121             ++ [AnswerClients [sendChan cl] ["CHAT", nickGreeting, greeting jRoom] | greeting jRoom /= ""]
   120             ++ map (\t -> AnswerClients chans ["EM", toEngineMsg $ 'G' `B.cons` t]) clTeamsNames
   122             ++ map (\t -> AnswerClients chans ["EM", toEngineMsg $ 'G' `B.cons` t]) clTeamsNames
   121             ++ [AnswerClients [sendChan cl] ["EM", toEngineMsg "I"] | isPaused `fmap` gameInfo jRoom == Just True]
   123             ++ [AnswerClients [sendChan cl] ["EM", toEngineMsg "I"] | isPaused `fmap` gameInfo jRoom == Just True]
   122 
   124 
   123         where
   125         where
   124         moveTeams :: [B.ByteString] -> GameInfo -> ([TeamInfo], GameInfo)
   126         moveTeams :: [B.ByteString] -> GameInfo -> ([TeamInfo], GameInfo)
   164 
   166 
   165 handleCmd_lobby ("RND":rs) = do
   167 handleCmd_lobby ("RND":rs) = do
   166     c <- liftM sendChan thisClient
   168     c <- liftM sendChan thisClient
   167     return [Random [c] rs]
   169     return [Random [c] rs]
   168 
   170 
       
   171 handleCmd_lobby ["HELP"] = do
       
   172     cl <- thisClient
       
   173     if isAdministrator cl then
       
   174         return (cmdHelpActionList [sendChan cl] cmdHelpLobbyAdmin)
       
   175     else
       
   176         return (cmdHelpActionList [sendChan cl] cmdHelpLobbyPlayer)
       
   177 
   169     ---------------------------
   178     ---------------------------
   170     -- Administrator's stuff --
   179     -- Administrator's stuff --
   171 
   180 
   172 handleCmd_lobby ["KICK", kickNick] = serverAdminOnly $ do
   181 handleCmd_lobby ["KICK", kickNick] = serverAdminOnly $ do
   173     (ci, _) <- ask
   182     (ci, _) <- ask
   209     return [SendServerVars]
   218     return [SendServerVars]
   210 
   219 
   211 handleCmd_lobby ["CLEAR_ACCOUNTS_CACHE"] = serverAdminOnly $
   220 handleCmd_lobby ["CLEAR_ACCOUNTS_CACHE"] = serverAdminOnly $
   212     return [ClearAccountsCache]
   221     return [ClearAccountsCache]
   213 
   222 
       
   223 handleCmd_lobby ["RESTART_SERVER", "YES"] = serverAdminOnly $
       
   224     return [RestartServer]
       
   225 
   214 handleCmd_lobby ["RESTART_SERVER"] = serverAdminOnly $
   226 handleCmd_lobby ["RESTART_SERVER"] = serverAdminOnly $
   215     return [RestartServer]
   227     return [Warning $ loc "Please confirm server restart with '/restart_server yes'."]
       
   228 
       
   229 handleCmd_lobby ["RESTART_SERVER", _] = handleCmd_lobby ["RESTART_SERVER"]
       
   230 
   216 
   231 
   217 handleCmd_lobby ["STATS"] = serverAdminOnly $
   232 handleCmd_lobby ["STATS"] = serverAdminOnly $
   218     return [Stats]
   233     return [Stats]
   219 
   234 
   220 handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"]
   235 handleCmd_lobby (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: in lobby)"]
       
   236 
       
   237 handleCmd_lobby [] = return [ProtocolError "Empty command (state: in lobby)"]