gameServer/HWProtoLobbyState.hs
branchwebgl
changeset 8444 75db7bb8dce8
parent 8403 fbc6e7602e05
child 8486 9a65baafd7d7
equal deleted inserted replaced
8340:46a9fde631f4 8444:75db7bb8dce8
     1 {-# LANGUAGE OverloadedStrings #-}
     1 {-# LANGUAGE OverloadedStrings #-}
     2 module HWProtoLobbyState where
     2 module HWProtoLobbyState where
     3 
     3 
     4 import qualified Data.Map as Map
     4 import qualified Data.Map as Map
     5 import qualified Data.Foldable as Foldable
       
     6 import Data.Maybe
     5 import Data.Maybe
     7 import Data.List
     6 import Data.List
     8 import Control.Monad.Reader
     7 import Control.Monad.Reader
     9 import qualified Data.ByteString.Char8 as B
       
    10 --------------------------------------
     8 --------------------------------------
    11 import CoreTypes
     9 import CoreTypes
    12 import Actions
    10 import Actions
    13 import Utils
    11 import Utils
    14 import HandlerUtils
    12 import HandlerUtils
    41     n <- clientNick
    39     n <- clientNick
    42     s <- roomOthersChans
    40     s <- roomOthersChans
    43     return [AnswerClients s ["CHAT", n, msg]]
    41     return [AnswerClients s ["CHAT", n, msg]]
    44 
    42 
    45 handleCmd_lobby ["CREATE_ROOM", rName, roomPassword]
    43 handleCmd_lobby ["CREATE_ROOM", rName, roomPassword]
    46     | illegalName rName = return [Warning "Illegal room name"]
    44     | illegalName rName = return [Warning $ loc "Illegal room name"]
    47     | otherwise = do
    45     | otherwise = do
    48         rs <- allRoomInfos
    46         rs <- allRoomInfos
    49         cl <- thisClient
    47         cl <- thisClient
    50         return $ if isJust $ find (\r -> rName == name r) rs then
    48         return $ if isJust $ find (\r -> rName == name r) rs then
    51             [Warning "Room exists"]
    49             [Warning "Room exists"]
    75     let ownerNick = nick . fromJust $ find isMaster jRoomClients
    73     let ownerNick = nick . fromJust $ find isMaster jRoomClients
    76     let chans = map sendChan (cl : jRoomClients)
    74     let chans = map sendChan (cl : jRoomClients)
    77     let isBanned = host cl `elem` roomBansList jRoom
    75     let isBanned = host cl `elem` roomBansList jRoom
    78     return $
    76     return $
    79         if isNothing maybeRI || not sameProto then
    77         if isNothing maybeRI || not sameProto then
    80             [Warning "No such room"]
    78             [Warning $ loc "No such room"]
    81             else if isRestrictedJoins jRoom then
    79             else if isRestrictedJoins jRoom then
    82             [Warning "Joining restricted"]
    80             [Warning $ loc "Joining restricted"]
    83             else if isRegisteredOnly jRoom then
    81             else if isRegisteredOnly jRoom then
    84             [Warning "Registered users only"]
    82             [Warning $ loc "Registered users only"]
    85             else if isBanned then
    83             else if isBanned then
    86             [Warning "You are banned in this room"]
    84             [Warning $ loc "You are banned in this room"]
    87             else if roomPassword /= password jRoom then
    85             else if roomPassword /= password jRoom then
    88             [NoticeMessage WrongPassword]
    86             [NoticeMessage WrongPassword]
    89             else
    87             else
    90             [
    88             [
    91                 MoveToRoom jRI
    89                 MoveToRoom jRI
   126                     []
   124                     []
   127                 else
   125                 else
   128                     [AnswerClients [sendChan cl]  ["RUN_GAME"]
   126                     [AnswerClients [sendChan cl]  ["RUN_GAME"]
   129                     , AnswerClients chans ["CLIENT_FLAGS", "+g", nick cl]
   127                     , AnswerClients chans ["CLIENT_FLAGS", "+g", nick cl]
   130                     , ModifyClient (\c -> c{isInGame = True})
   128                     , ModifyClient (\c -> c{isInGame = True})
   131                     , AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs . fromJust . gameInfo $ jRoom)]
   129                     , AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : (reverse . roundMsgs . fromJust . gameInfo $ jRoom)]
   132 
   130 
   133 
   131 
   134 handleCmd_lobby ["JOIN_ROOM", roomName] =
   132 handleCmd_lobby ["JOIN_ROOM", roomName] =
   135     handleCmd_lobby ["JOIN_ROOM", roomName, ""]
   133     handleCmd_lobby ["JOIN_ROOM", roomName, ""]
   136 
   134 
   203 
   201 
   204 handleCmd_lobby ["RESTART_SERVER"] = do
   202 handleCmd_lobby ["RESTART_SERVER"] = do
   205     cl <- thisClient
   203     cl <- thisClient
   206     return [RestartServer | isAdministrator cl]
   204     return [RestartServer | isAdministrator cl]
   207 
   205 
       
   206 handleCmd_lobby ["STATS"] = do
       
   207     cl <- thisClient
       
   208     return [Stats | isAdministrator cl]
   208 
   209 
   209 handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"]
   210 handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"]