1 {-# LANGUAGE OverloadedStrings #-} |
|
2 module HWProtoLobbyState where |
1 module HWProtoLobbyState where |
3 |
2 |
4 import qualified Data.Map as Map |
3 import qualified Data.Map as Map |
|
4 import qualified Data.IntMap as IntMap |
5 import qualified Data.IntSet as IntSet |
5 import qualified Data.IntSet as IntSet |
6 import qualified Data.Foldable as Foldable |
6 import qualified Data.Foldable as Foldable |
7 import Data.Maybe |
7 import Data.Maybe |
8 import Data.List |
8 import Data.List |
9 import Data.Word |
9 import Data.Word |
10 import Control.Monad.Reader |
|
11 import qualified Data.ByteString.Char8 as B |
|
12 -------------------------------------- |
10 -------------------------------------- |
13 import CoreTypes |
11 import CoreTypes |
14 import Actions |
12 import Actions |
15 import Utils |
13 import Utils |
16 import HandlerUtils |
|
17 import RoomsAndClients |
|
18 |
14 |
19 {-answerAllTeams protocol teams = concatMap toAnswer teams |
15 answerAllTeams protocol teams = concatMap toAnswer teams |
20 where |
16 where |
21 toAnswer team = |
17 toAnswer team = |
22 [AnswerThisClient $ teamToNet protocol team, |
18 [AnswerThisClient $ teamToNet protocol team, |
23 AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team], |
19 AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team], |
24 AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]] |
20 AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]] |
25 -} |
21 |
26 handleCmd_lobby :: CmdHandler |
22 handleCmd_lobby :: CmdHandler |
27 |
23 |
28 |
24 handleCmd_lobby clID clients rooms ["LIST"] = |
29 handleCmd_lobby ["LIST"] = do |
25 [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)] |
|
35 where |
26 where |
36 roomInfo irnc room = [ |
27 roomsInfoList = concatMap roomInfo sameProtoRooms |
37 showB $ gameinprogress room, |
28 sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList |
|
29 roomsList = IntMap.elems rooms |
|
30 protocol = clientProto client |
|
31 client = clients IntMap.! clID |
|
32 roomInfo room |
|
33 | clientProto client < 28 = [ |
38 name room, |
34 name room, |
39 showB $ playersIn room, |
35 show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")", |
40 showB $ length $ teams room, |
36 show $ gameinprogress room |
41 nick $ irnc `client` masterID room, |
37 ] |
|
38 | otherwise = [ |
|
39 show $ gameinprogress room, |
|
40 name room, |
|
41 show $ playersIn room, |
|
42 show $ length $ teams room, |
|
43 nick $ clients IntMap.! (masterID room), |
42 head (Map.findWithDefault ["+gen+"] "MAP" (params room)), |
44 head (Map.findWithDefault ["+gen+"] "MAP" (params room)), |
43 head (Map.findWithDefault ["Default"] "SCHEME" (params room)), |
45 head (Map.findWithDefault ["Default"] "SCHEME" (params room)), |
44 head (Map.findWithDefault ["Default"] "AMMO" (params room)) |
46 head (Map.findWithDefault ["Default"] "AMMO" (params room)) |
45 ] |
47 ] |
46 |
48 |
47 |
49 handleCmd_lobby clID clients _ ["CHAT", msg] = |
48 handleCmd_lobby ["CHAT", msg] = do |
50 [AnswerOthersInRoom ["CHAT", clientNick, msg]] |
49 n <- clientNick |
51 where |
50 s <- roomOthersChans |
52 clientNick = nick $ clients IntMap.! clID |
51 return [AnswerClients s ["CHAT", n, msg]] |
|
52 |
|
53 handleCmd_lobby ["CREATE_ROOM", newRoom, roomPassword] |
|
54 | illegalName newRoom = return [Warning "Illegal room name"] |
|
55 | otherwise = do |
|
56 rs <- allRoomInfos |
|
57 cl <- thisClient |
|
58 return $ if isJust $ find (\room -> newRoom == name room) rs then |
|
59 [Warning "Room exists"] |
|
60 else |
|
61 [ |
|
62 AddRoom newRoom roomPassword, |
|
63 AnswerClients [sendChan cl] ["NOT_READY", nick cl] |
|
64 ] |
|
65 |
53 |
66 |
54 |
67 handleCmd_lobby ["CREATE_ROOM", newRoom] = |
55 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword] |
68 handleCmd_lobby ["CREATE_ROOM", newRoom, ""] |
56 | haveSameRoom = [Warning "Room exists"] |
|
57 | illegalName newRoom = [Warning "Illegal room name"] |
|
58 | otherwise = |
|
59 [RoomRemoveThisClient "", -- leave lobby |
|
60 AddRoom newRoom roomPassword, |
|
61 AnswerThisClient ["NOT_READY", clientNick] |
|
62 ] |
|
63 where |
|
64 clientNick = nick $ clients IntMap.! clID |
|
65 haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms |
69 |
66 |
70 |
67 |
71 handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do |
68 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom] = |
72 (ci, irnc) <- ask |
69 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""] |
73 let ris = allRooms irnc |
|
74 cl <- thisClient |
|
75 let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris |
|
76 let jRI = fromJust maybeRI |
|
77 let jRoom = irnc `room` jRI |
|
78 let jRoomClients = map (client irnc) $! roomClients irnc jRI -- no lazyness here! |
|
79 return $ |
|
80 if isNothing maybeRI then |
|
81 [Warning "No such rooms"] |
|
82 else if isRestrictedJoins jRoom then |
|
83 [Warning "Joining restricted"] |
|
84 else if roomPassword /= password jRoom then |
|
85 [Warning "Wrong password"] |
|
86 else |
|
87 [ |
|
88 MoveToRoom jRI, |
|
89 AnswerClients (map sendChan $ cl : jRoomClients) ["NOT_READY", nick cl] |
|
90 ] |
|
91 ++ [ AnswerClients [sendChan cl] $ "JOINED" : map nick jRoomClients | playersIn jRoom /= 0] |
|
92 ++ (map (readynessMessage cl) jRoomClients) |
|
93 |
70 |
94 where |
|
95 readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c] |
|
96 |
|
97 |
|
98 |
|
99 {- |
|
100 |
71 |
101 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword] |
72 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword] |
102 | noSuchRoom = [Warning "No such room"] |
73 | noSuchRoom = [Warning "No such room"] |
103 | isRestrictedJoins jRoom = [Warning "Joining restricted"] |
74 | isRestrictedJoins jRoom = [Warning "Joining restricted"] |
104 | roomPassword /= password jRoom = [Warning "Wrong password"] |
75 | roomPassword /= password jRoom = [Warning "Wrong password"] |