2 module HWProtoCore where |
2 module HWProtoCore where |
3 |
3 |
4 import Control.Monad.Reader |
4 import Control.Monad.Reader |
5 import Data.Maybe |
5 import Data.Maybe |
6 import qualified Data.ByteString.Char8 as B |
6 import qualified Data.ByteString.Char8 as B |
7 import qualified Data.List as L |
|
8 -------------------------------------- |
7 -------------------------------------- |
9 import CoreTypes |
8 import CoreTypes |
10 import Actions |
9 import Actions |
11 import HWProtoNEState |
10 import HWProtoNEState |
12 import HWProtoLobbyState |
11 import HWProtoLobbyState |
28 |
27 |
29 |
28 |
30 handleCmd ["PONG"] = do |
29 handleCmd ["PONG"] = do |
31 cl <- thisClient |
30 cl <- thisClient |
32 if pingsQueue cl == 0 then |
31 if pingsQueue cl == 0 then |
33 return $ actionsPending cl ++ [ModifyClient (\c -> c{actionsPending = []})] |
32 return [ProtocolError "Protocol violation"] |
34 else |
33 else |
35 return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})] |
34 return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})] |
36 |
35 |
37 handleCmd ("CMD" : parameters) = |
36 handleCmd ["CMD", parameters] = do |
38 let c = concatMap B.words parameters in |
37 let (cmd, plist) = B.break (== ' ') parameters |
39 if not $ null c then |
38 let param = B.dropWhile (== ' ') plist |
40 h $ (upperCase . head $ c) : tail c |
39 h (upperCase cmd) param |
41 else |
|
42 return [] |
|
43 where |
40 where |
44 h ["DELEGATE", n] = handleCmd ["DELEGATE", n] |
41 h "DELEGATE" n | not $ B.null n = handleCmd ["DELEGATE", n] |
45 h ["STATS"] = handleCmd ["STATS"] |
42 h "STATS" _ = handleCmd ["STATS"] |
46 h ["PART", msg] = handleCmd ["PART", msg] |
43 h "PART" m | not $ B.null m = handleCmd ["PART", m] |
47 h ["QUIT", msg] = handleCmd ["QUIT", msg] |
44 | otherwise = handleCmd ["PART"] |
48 h ["GLOBAL", msg] = do |
45 h "QUIT" m | not $ B.null m = handleCmd ["QUIT", m] |
|
46 | otherwise = handleCmd ["QUIT"] |
|
47 h "RND" p = handleCmd ("RND" : B.words p) |
|
48 h "GLOBAL" p = do |
|
49 cl <- thisClient |
49 rnc <- liftM snd ask |
50 rnc <- liftM snd ask |
50 let chans = map (sendChan . client rnc) $ allClients rnc |
51 let chans = map (sendChan . client rnc) $ allClients rnc |
51 return [AnswerClients chans ["CHAT", "[global notice]", msg]] |
52 return [AnswerClients chans ["CHAT", "[global notice]", p] | isAdministrator cl] |
52 h c = return [Warning . B.concat . L.intersperse " " $ "Unknown cmd" : c] |
53 h c p = return [Warning $ B.concat ["Unknown cmd: /", c, p]] |
53 |
54 |
54 handleCmd cmd = do |
55 handleCmd cmd = do |
55 (ci, irnc) <- ask |
56 (ci, irnc) <- ask |
56 let cl = irnc `client` ci |
57 let cl = irnc `client` ci |
57 if logonPassed cl then |
58 if logonPassed cl then |
70 let noSuchClient = isNothing maybeClientId |
71 let noSuchClient = isNothing maybeClientId |
71 let clientId = fromJust maybeClientId |
72 let clientId = fromJust maybeClientId |
72 let cl = rnc `client` fromJust maybeClientId |
73 let cl = rnc `client` fromJust maybeClientId |
73 let roomId = clientRoom rnc clientId |
74 let roomId = clientRoom rnc clientId |
74 let clRoom = room rnc roomId |
75 let clRoom = room rnc roomId |
75 let roomMasterSign = if isMaster cl then "@" else "" |
76 let roomMasterSign = if isMaster cl then "+" else "" |
76 let adminSign = if isAdministrator cl then "@" else "" |
77 let adminSign = if isAdministrator cl then "@" else "" |
77 let rInfo = if roomId /= lobbyId then B.concat [roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby" |
78 let rInfo = if roomId /= lobbyId then B.concat [adminSign, roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby" |
78 let roomStatus = if isJust $ gameInfo clRoom then |
79 let roomStatus = if isJust $ gameInfo clRoom then |
79 if teamsInGame cl > 0 then "(playing)" else "(spectating)" |
80 if teamsInGame cl > 0 then "(playing)" else "(spectating)" |
80 else |
81 else |
81 "" |
82 "" |
82 let hostStr = if isAdminAsking then host cl else cutHost $ host cl |
83 let hostStr = if isAdminAsking then host cl else cutHost $ host cl |