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.IntMap as IntMap |
|
6 import qualified Data.IntSet as IntSet |
5 import qualified Data.IntSet as IntSet |
7 import qualified Data.Foldable as Foldable |
6 import qualified Data.Foldable as Foldable |
8 import Maybe |
7 import Maybe |
9 import Data.List |
8 import Data.List |
10 import Data.Word |
9 import Data.Word |
|
10 import Control.Monad.Reader |
|
11 import qualified Data.ByteString.Char8 as B |
11 -------------------------------------- |
12 -------------------------------------- |
12 import CoreTypes |
13 import CoreTypes |
13 import Actions |
14 import Actions |
14 import Utils |
15 import Utils |
15 import HandlerUtils |
16 import HandlerUtils |
|
17 import RoomsAndClients |
16 |
18 |
17 {-answerAllTeams protocol teams = concatMap toAnswer teams |
19 {-answerAllTeams protocol teams = concatMap toAnswer teams |
18 where |
20 where |
19 toAnswer team = |
21 toAnswer team = |
20 [AnswerThisClient $ teamToNet protocol team, |
22 [AnswerThisClient $ teamToNet protocol team, |
21 AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team], |
23 AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team], |
22 AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]] |
24 AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]] |
23 -} |
25 -} |
24 handleCmd_lobby :: CmdHandler |
26 handleCmd_lobby :: CmdHandler |
25 |
27 |
26 {- |
28 |
27 handleCmd_lobby clID clients rooms ["LIST"] = |
29 handleCmd_lobby ["LIST"] = do |
28 [AnswerThisClient ("ROOMS" : roomsInfoList)] |
30 (ci, irnc) <- ask |
|
31 let cl = irnc `client` ci |
|
32 rooms <- allRoomInfos |
|
33 let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r)) |
|
34 return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)] |
29 where |
35 where |
30 roomsInfoList = concatMap roomInfo sameProtoRooms |
36 roomInfo irnc room |
31 sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList |
37 | roomProto room < 28 = [ |
32 roomsList = IntMap.elems rooms |
|
33 protocol = clientProto client |
|
34 client = clients IntMap.! clID |
|
35 roomInfo room |
|
36 | clientProto client < 28 = [ |
|
37 name room, |
38 name room, |
38 show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")", |
39 B.pack $ show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")", |
39 show $ gameinprogress room |
40 B.pack $ show $ gameinprogress room |
40 ] |
41 ] |
41 | otherwise = [ |
42 | otherwise = [ |
42 show $ gameinprogress room, |
43 showB $ gameinprogress room, |
43 name room, |
44 name room, |
44 show $ playersIn room, |
45 showB $ playersIn room, |
45 show $ length $ teams room, |
46 showB $ length $ teams room, |
46 nick $ clients IntMap.! (masterID room), |
47 nick $ irnc `client` (masterID room), |
47 head (Map.findWithDefault ["+gen+"] "MAP" (params room)), |
48 head (Map.findWithDefault ["+gen+"] "MAP" (params room)), |
48 head (Map.findWithDefault ["Default"] "SCHEME" (params room)), |
49 head (Map.findWithDefault ["Default"] "SCHEME" (params room)), |
49 head (Map.findWithDefault ["Default"] "AMMO" (params room)) |
50 head (Map.findWithDefault ["Default"] "AMMO" (params room)) |
50 ] |
51 ] |
51 -} |
52 |
52 |
53 |
53 handleCmd_lobby ["CHAT", msg] = do |
54 handleCmd_lobby ["CHAT", msg] = do |
54 n <- clientNick |
55 n <- clientNick |
55 s <- roomOthersChans |
56 s <- roomOthersChans |
56 return [AnswerClients s ["CHAT", n, msg]] |
57 return [AnswerClients s ["CHAT", n, msg]] |