1 {-# LANGUAGE OverloadedStrings #-} |
1 {-# LANGUAGE OverloadedStrings #-} |
2 module HWProtoLobbyState where |
2 module HWProtoLobbyState where |
3 |
3 |
4 import qualified Data.Map as Map |
|
5 import Data.Maybe |
4 import Data.Maybe |
6 import Data.List |
5 import Data.List |
7 import Control.Monad.Reader |
6 import Control.Monad.Reader |
8 -------------------------------------- |
7 -------------------------------------- |
9 import CoreTypes |
8 import CoreTypes |
49 [Warning "Room exists"] |
48 [Warning "Room exists"] |
50 else |
49 else |
51 [ |
50 [ |
52 AddRoom rName roomPassword |
51 AddRoom rName roomPassword |
53 , AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+hr", nick cl] |
52 , AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+hr", nick cl] |
54 , ModifyClient (\c -> c{isMaster = True, isReady = True}) |
53 , ModifyClient (\c -> c{isMaster = True, isReady = True, isJoinedMidGame = False}) |
55 , ModifyRoom (\r -> r{readyPlayers = 1}) |
54 , ModifyRoom (\r -> r{readyPlayers = 1}) |
56 ] |
55 ] |
57 |
56 |
58 |
57 |
59 handleCmd_lobby ["CREATE_ROOM", rName] = |
58 handleCmd_lobby ["CREATE_ROOM", rName] = |
85 else if roomPassword /= password jRoom then |
84 else if roomPassword /= password jRoom then |
86 [NoticeMessage WrongPassword] |
85 [NoticeMessage WrongPassword] |
87 else |
86 else |
88 [ |
87 [ |
89 MoveToRoom jRI |
88 MoveToRoom jRI |
|
89 , ModifyClient (\c -> c{isJoinedMidGame = isJust $ gameInfo jRoom}) |
90 , AnswerClients [sendChan cl] $ "JOINED" : nicks |
90 , AnswerClients [sendChan cl] $ "JOINED" : nicks |
91 , AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl] |
91 , AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl] |
92 , AnswerClients [sendChan cl] $ ["CLIENT_FLAGS", "+h", ownerNick] |
92 , AnswerClients [sendChan cl] $ ["CLIENT_FLAGS", "+h", ownerNick] |
93 ] |
93 ] |
94 ++ (if clientProto cl < 38 then map (readynessMessage cl) jRoomClients else [sendStateFlags cl jRoomClients]) |
94 ++ (if clientProto cl < 38 then map (readynessMessage cl) jRoomClients else [sendStateFlags cl jRoomClients]) |
95 ++ answerFullConfig cl (mapParams jRoom) (params jRoom) |
95 ++ answerFullConfig cl jRoom |
96 ++ answerTeams cl jRoom |
96 ++ answerTeams cl jRoom |
97 ++ watchRound cl jRoom chans |
97 ++ watchRound cl jRoom chans |
98 |
98 |
99 where |
99 where |
100 readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c] |
100 readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c] |
103 where |
103 where |
104 (ready, unready) = partition isReady clients |
104 (ready, unready) = partition isReady clients |
105 (ingame, inroomlobby) = partition isInGame clients |
105 (ingame, inroomlobby) = partition isInGame clients |
106 f fl lst = ["CLIENT_FLAGS" : fl : map nick lst | not $ null lst] |
106 f fl lst = ["CLIENT_FLAGS" : fl : map nick lst | not $ null lst] |
107 |
107 |
108 toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs |
108 -- get config from gameInfo if possible, otherwise from room |
109 |
109 answerFullConfig cl jRoom = let f r g = (if isJust $ gameInfo jRoom then g . fromJust . gameInfo else r) jRoom |
110 answerFullConfig cl mpr pr |
110 in answerFullConfigParams cl (f mapParams giMapParams) (f params giParams) |
111 | clientProto cl < 38 = map (toAnswer cl) $ |
|
112 (reverse . map (\(a, b) -> (a, [b])) $ Map.toList mpr) |
|
113 ++ (("SCHEME", pr Map.! "SCHEME") |
|
114 : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr)) |
|
115 |
|
116 | otherwise = map (toAnswer cl) $ |
|
117 ("FULLMAPCONFIG", Map.elems mpr) |
|
118 : ("SCHEME", pr Map.! "SCHEME") |
|
119 : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr) |
|
120 |
111 |
121 answerTeams cl jRoom = let f = if isJust $ gameInfo jRoom then teamsAtStart . fromJust . gameInfo else teams in answerAllTeams cl $ f jRoom |
112 answerTeams cl jRoom = let f = if isJust $ gameInfo jRoom then teamsAtStart . fromJust . gameInfo else teams in answerAllTeams cl $ f jRoom |
122 |
113 |
123 watchRound cl jRoom chans = if isNothing $ gameInfo jRoom then |
114 watchRound cl jRoom chans = if isNothing $ gameInfo jRoom then |
124 [] |
115 [] |