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.IntSet as IntSet |
|
6 import qualified Data.Foldable as Foldable |
5 import qualified Data.Foldable as Foldable |
7 import Data.Maybe |
6 import Data.Maybe |
8 import Data.List |
7 import Data.List |
9 import Data.Word |
|
10 import Control.Monad.Reader |
8 import Control.Monad.Reader |
11 import qualified Data.ByteString.Char8 as B |
9 import qualified Data.ByteString.Char8 as B |
12 import Control.DeepSeq |
|
13 -------------------------------------- |
10 -------------------------------------- |
14 import CoreTypes |
11 import CoreTypes |
15 import Actions |
12 import Actions |
16 import Utils |
13 import Utils |
17 import HandlerUtils |
14 import HandlerUtils |
18 import RoomsAndClients |
15 import RoomsAndClients |
19 |
16 |
|
17 |
|
18 answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action] |
20 answerAllTeams cl = concatMap toAnswer |
19 answerAllTeams cl = concatMap toAnswer |
21 where |
20 where |
22 clChan = sendChan cl |
21 clChan = sendChan cl |
23 toAnswer team = |
22 toAnswer team = |
24 [AnswerClients [clChan] $ teamToNet team, |
23 [AnswerClients [clChan] $ teamToNet team, |
33 let cl = irnc `client` ci |
32 let cl = irnc `client` ci |
34 rooms <- allRoomInfos |
33 rooms <- allRoomInfos |
35 let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r)) |
34 let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r)) |
36 return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)] |
35 return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)] |
37 where |
36 where |
38 roomInfo irnc room = [ |
37 roomInfo irnc r = [ |
39 showB $ gameinprogress room, |
38 showB $ gameinprogress r, |
40 name room, |
39 name r, |
41 showB $ playersIn room, |
40 showB $ playersIn r, |
42 showB $ length $ teams room, |
41 showB $ length $ teams r, |
43 nick $ irnc `client` masterID room, |
42 nick $ irnc `client` masterID r, |
44 head (Map.findWithDefault ["+gen+"] "MAP" (params room)), |
43 head (Map.findWithDefault ["+gen+"] "MAP" (params r)), |
45 head (Map.findWithDefault ["Default"] "SCHEME" (params room)), |
44 head (Map.findWithDefault ["Default"] "SCHEME" (params r)), |
46 head (Map.findWithDefault ["Default"] "AMMO" (params room)) |
45 head (Map.findWithDefault ["Default"] "AMMO" (params r)) |
47 ] |
46 ] |
48 |
47 |
49 |
48 |
50 handleCmd_lobby ["CHAT", msg] = do |
49 handleCmd_lobby ["CHAT", msg] = do |
51 n <- clientNick |
50 n <- clientNick |
52 s <- roomOthersChans |
51 s <- roomOthersChans |
53 return [AnswerClients s ["CHAT", n, msg]] |
52 return [AnswerClients s ["CHAT", n, msg]] |
54 |
53 |
55 handleCmd_lobby ["CREATE_ROOM", newRoom, roomPassword] |
54 handleCmd_lobby ["CREATE_ROOM", rName, roomPassword] |
56 | illegalName newRoom = return [Warning "Illegal room name"] |
55 | illegalName rName = return [Warning "Illegal room name"] |
57 | otherwise = do |
56 | otherwise = do |
58 rs <- allRoomInfos |
57 rs <- allRoomInfos |
59 cl <- thisClient |
58 cl <- thisClient |
60 return $ if isJust $ find (\room -> newRoom == name room) rs then |
59 return $ if isJust $ find (\r -> rName == name r) rs then |
61 [Warning "Room exists"] |
60 [Warning "Room exists"] |
62 else |
61 else |
63 [ |
62 [ |
64 AddRoom newRoom roomPassword, |
63 AddRoom rName roomPassword, |
65 AnswerClients [sendChan cl] ["CLIENT_FLAGS", "-r", nick cl] |
64 AnswerClients [sendChan cl] ["CLIENT_FLAGS", "-r", nick cl] |
66 ] |
65 ] |
67 |
66 |
68 |
67 |
69 handleCmd_lobby ["CREATE_ROOM", newRoom] = |
68 handleCmd_lobby ["CREATE_ROOM", rName] = |
70 handleCmd_lobby ["CREATE_ROOM", newRoom, ""] |
69 handleCmd_lobby ["CREATE_ROOM", rName, ""] |
71 |
70 |
72 |
71 |
73 handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do |
72 handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do |
74 (ci, irnc) <- ask |
73 (_, irnc) <- ask |
75 let ris = allRooms irnc |
74 let ris = allRooms irnc |
76 cl <- thisClient |
75 cl <- thisClient |
77 let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris |
76 let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris |
78 let jRI = fromJust maybeRI |
77 let jRI = fromJust maybeRI |
79 let jRoom = irnc `room` jRI |
78 let jRoom = irnc `room` jRI |
91 [ |
90 [ |
92 MoveToRoom jRI, |
91 MoveToRoom jRI, |
93 AnswerClients [sendChan cl] $ "JOINED" : nicks, |
92 AnswerClients [sendChan cl] $ "JOINED" : nicks, |
94 AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl] |
93 AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl] |
95 ] |
94 ] |
96 ++ (map (readynessMessage cl) jRoomClients) |
95 ++ map (readynessMessage cl) jRoomClients |
97 ++ (answerFullConfig cl $ params jRoom) |
96 ++ answerFullConfig cl (params jRoom) |
98 ++ (answerTeams cl jRoom) |
97 ++ answerTeams cl jRoom |
99 ++ (watchRound cl jRoom) |
98 ++ watchRound cl jRoom |
100 |
99 |
101 where |
100 where |
102 readynessMessage cl c = AnswerClients [sendChan cl] ["CLIENT_FLAGS", if isReady c then "+r" else "-r", nick c] |
101 readynessMessage cl c = AnswerClients [sendChan cl] ["CLIENT_FLAGS", if isReady c then "+r" else "-r", nick c] |
103 |
102 |
104 toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs |
103 toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs |
105 |
104 |
106 answerFullConfig cl params = map (toAnswer cl) (leftConfigPart ++ rightConfigPart) |
105 answerFullConfig cl pr = map (toAnswer cl) (leftConfigPart ++ rightConfigPart) |
107 where |
106 where |
108 (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") $ Map.toList params |
107 (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") $ Map.toList pr |
109 |
108 |
110 answerTeams cl jRoom = let f = if gameinprogress jRoom then teamsAtStart else teams in answerAllTeams cl $ f jRoom |
109 answerTeams cl jRoom = let f = if gameinprogress jRoom then teamsAtStart else teams in answerAllTeams cl $ f jRoom |
111 |
110 |
112 watchRound cl jRoom = if not $ gameinprogress jRoom then |
111 watchRound cl jRoom = if not $ gameinprogress jRoom then |
113 [] |
112 [] |