14 teamToNet team = ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo |
14 teamToNet team = ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo |
15 where |
15 where |
16 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
16 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
17 |
17 |
18 makeAnswer :: HandlesSelector -> [String] -> [Answer] |
18 makeAnswer :: HandlesSelector -> [String] -> [Answer] |
19 makeAnswer func msg = [(func, msg)]-- [\_ -> (func, msg)] |
19 makeAnswer func msg = [\_ -> (func, msg)] |
20 answerClientOnly, answerOthersRoom, answerSameRoom :: [String] -> [Answer] |
20 answerClientOnly, answerOthersRoom, answerSameRoom :: [String] -> [Answer] |
21 answerClientOnly = makeAnswer clientOnly |
21 answerClientOnly = makeAnswer clientOnly |
22 answerOthersRoom = makeAnswer othersInRoom |
22 answerOthersRoom = makeAnswer othersInRoom |
23 answerSameRoom = makeAnswer sameRoom |
23 answerSameRoom = makeAnswer sameRoom |
24 |
24 |
70 toAnswer team = |
70 toAnswer team = |
71 (answerClientOnly $ teamToNet team) ++ |
71 (answerClientOnly $ teamToNet team) ++ |
72 (answerClientOnly ["TEAM_COLOR", teamname team, teamcolor team]) ++ |
72 (answerClientOnly ["TEAM_COLOR", teamname team, teamcolor team]) ++ |
73 (answerClientOnly ["HH_NUM", teamname team, show $ hhnum team]) |
73 (answerClientOnly ["HH_NUM", teamname team, show $ hhnum team]) |
74 |
74 |
75 answerServerMessage clients = answerClientOnly $ "SERVER_MESSAGE" : [mainbody ++ clientsIn] |
75 answerServerMessage clients = [\serverInfo -> (clientOnly, "SERVER_MESSAGE" : [(mainbody serverInfo) ++ clientsIn])] |
76 where |
76 where |
77 mainbody = serverMessage globalOptions ++ if isDedicated globalOptions then "<p align=center>Dedicated server</p>" else "<p align=center>Private server</p>" |
77 mainbody serverInfo = serverMessage serverInfo ++ |
|
78 if isDedicated serverInfo then |
|
79 "<p align=center>Dedicated server</p>" |
|
80 else |
|
81 "<p align=center>Private server</p>" |
|
82 |
78 clientsIn = "<p align=left>" ++ (show $ length nicks) ++ " clients in: " ++ clientslist ++ "</p>" |
83 clientsIn = "<p align=left>" ++ (show $ length nicks) ++ " clients in: " ++ clientslist ++ "</p>" |
79 clientslist = if not $ null nicks then foldr1 (\a b -> a ++ ", " ++ b) nicks else "" |
84 clientslist = if not $ null nicks then foldr1 (\a b -> a ++ ", " ++ b) nicks else "" |
80 nicks = filter (not . null) $ map nick clients |
85 nicks = filter (not . null) $ map nick clients |
|
86 |
81 answerPing = makeAnswer allClients ["PING"] |
87 answerPing = makeAnswer allClients ["PING"] |
82 |
88 |
83 |
89 |
84 -- Main state-independent cmd handler |
90 -- Main state-independent cmd handler |
85 handleCmd :: CmdHandler |
91 handleCmd :: CmdHandler |
155 show $ gameinprogress room |
161 show $ gameinprogress room |
156 ] |
162 ] |
157 sameProtoRooms = filter (\r -> (roomProto r == protocol client) && (not $ isRestrictedJoins r)) rooms |
163 sameProtoRooms = filter (\r -> (roomProto r == protocol client) && (not $ isRestrictedJoins r)) rooms |
158 |
164 |
159 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
165 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
160 if (not $ isDedicated globalOptions) && (not $ null rooms) then |
166 if haveSameRoom then |
161 (noChangeClients, noChangeRooms, answerCannotCreateRoom) |
167 (noChangeClients, noChangeRooms, answerRoomExists) |
162 else |
168 else |
163 if haveSameRoom then |
169 (modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, (answerJoined $ nick client) ++ (answerNotReady $ nick client)) |
164 (noChangeClients, noChangeRooms, answerRoomExists) |
|
165 else |
|
166 (modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, (answerJoined $ nick client) ++ (answerNotReady $ nick client)) |
|
167 where |
170 where |
168 haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms |
171 haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms |
169 |
172 |
170 handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
173 handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
171 handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
174 handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |