DEADSOFTWARE

Net: Master now supports MOTD and message boxes
[d2df-sdl.git] / src / game / g_netmaster.pas
1 (* Copyright (C) Doom 2D: Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 unit g_netmaster;
19 interface
21 uses ENet;
23 const
24 NET_MCHANS = 2;
26 NET_MCHAN_MAIN = 0;
27 NET_MCHAN_UPD = 1;
29 NET_MMSG_UPD = 200;
30 NET_MMSG_DEL = 201;
31 NET_MMSG_GET = 202;
33 type
34 TNetServer = record
35 Number: Byte;
36 Protocol: Byte;
37 Name: string;
38 IP: string;
39 Port: Word;
40 Map: string;
41 Players, MaxPlayers, LocalPl, Bots: Byte;
42 Ping: Int64;
43 GameMode: Byte;
44 Password: Boolean;
45 PingAddr: ENetAddress;
46 end;
47 pTNetServer = ^TNetServer;
48 TNetServerRow = record
49 Indices: Array of Integer;
50 Current: Integer;
51 end;
53 TNetServerList = array of TNetServer;
54 pTNetServerList = ^TNetServerList;
55 TNetServerTable = array of TNetServerRow;
57 var
58 NetMHost: pENetHost = nil;
59 NetMPeer: pENetPeer = nil;
61 slCurrent: TNetServerList = nil;
62 slTable: TNetServerTable = nil;
63 slWaitStr: string = '';
64 slReturnPressed: Boolean = True;
66 slMOTD: string = '';
67 slUrgent: string = '';
69 procedure g_Net_Slist_Set(IP: string; Port: Word);
70 function g_Net_Slist_Fetch(var SL: TNetServerList): Boolean;
71 procedure g_Net_Slist_Update();
72 procedure g_Net_Slist_Remove();
73 function g_Net_Slist_Connect(): Boolean;
74 procedure g_Net_Slist_Check();
75 procedure g_Net_Slist_Disconnect();
76 procedure g_Net_Slist_WriteInfo();
78 procedure g_Serverlist_GenerateTable(SL: TNetServerList; var ST: TNetServerTable);
79 procedure g_Serverlist_Draw(var SL: TNetServerList; var ST: TNetServerTable);
80 procedure g_Serverlist_Control(var SL: TNetServerList; var ST: TNetServerTable);
82 implementation
84 uses
85 SysUtils, e_msg, e_input, e_graphics, e_log, g_window, g_net, g_console,
86 g_map, g_game, g_sound, g_gui, g_menu, g_options, g_language, g_basic,
87 wadreader;
89 var
90 NetMEvent: ENetEvent;
91 slSelection: Byte = 0;
92 slFetched: Boolean = False;
93 slDirPressed: Boolean = False;
94 slReadUrgent: Boolean = False;
96 function GetTimerMS(): Int64;
97 begin
98 Result := GetTimer() {div 1000};
99 end;
101 procedure PingServer(var S: TNetServer; Sock: ENetSocket);
102 var
103 Buf: ENetBuffer;
104 Ping: array [0..9] of Byte;
105 ClTime: Int64;
106 begin
107 ClTime := GetTimerMS();
109 Buf.data := Addr(Ping[0]);
110 Buf.dataLength := 2+8;
112 Ping[0] := Ord('D');
113 Ping[1] := Ord('F');
114 Int64(Addr(Ping[2])^) := ClTime;
116 enet_socket_send(Sock, Addr(S.PingAddr), @Buf, 1);
117 end;
119 procedure PingBcast(Sock: ENetSocket);
120 var
121 S: TNetServer;
122 begin
123 S.IP := '255.255.255.255';
124 S.Port := NET_PING_PORT;
125 enet_address_set_host(Addr(S.PingAddr), PChar(Addr(S.IP[1])));
126 S.Ping := -1;
127 S.PingAddr.port := S.Port;
128 PingServer(S, Sock);
129 end;
131 function g_Net_Slist_Fetch(var SL: TNetServerList): Boolean;
132 var
133 Cnt: Byte;
134 P: pENetPacket;
135 MID: Byte;
136 I, RX: Integer;
137 T: Int64;
138 Sock: ENetSocket;
139 Buf: ENetBuffer;
140 InMsg: TMsg;
141 SvAddr: ENetAddress;
142 FromSL: Boolean;
143 MyVer, Str: string;
145 procedure ProcessLocal();
146 begin
147 I := Length(SL);
148 SetLength(SL, I + 1);
149 with SL[I] do
150 begin
151 IP := DecodeIPV4(SvAddr.host);
152 Port := InMsg.ReadWord();
153 Ping := InMsg.ReadInt64();
154 Ping := GetTimerMS() - Ping;
155 Name := InMsg.ReadString();
156 Map := InMsg.ReadString();
157 GameMode := InMsg.ReadByte();
158 Players := InMsg.ReadByte();
159 MaxPlayers := InMsg.ReadByte();
160 Protocol := InMsg.ReadByte();
161 Password := InMsg.ReadByte() = 1;
162 LocalPl := InMsg.ReadByte();
163 Bots := InMsg.ReadWord();
164 end;
165 end;
166 procedure CheckLocalServers();
167 begin
168 SetLength(SL, 0);
170 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
171 if Sock = ENET_SOCKET_NULL then Exit;
172 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
173 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
174 PingBcast(Sock);
176 T := GetTimerMS();
178 InMsg.Alloc(NET_BUFSIZE);
179 Buf.data := InMsg.Data;
180 Buf.dataLength := InMsg.MaxSize;
181 while GetTimerMS() - T <= 500 do
182 begin
183 InMsg.Clear();
185 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
186 if RX <= 0 then continue;
187 InMsg.CurSize := RX;
189 InMsg.BeginReading();
191 if InMsg.ReadChar() <> 'D' then continue;
192 if InMsg.ReadChar() <> 'F' then continue;
194 ProcessLocal();
195 end;
197 InMsg.Free();
198 enet_socket_destroy(Sock);
200 if Length(SL) = 0 then SL := nil;
201 end;
202 begin
203 Result := False;
204 SL := nil;
206 if (NetMHost <> nil) or (NetMPeer <> nil) then
207 begin
208 CheckLocalServers();
209 Exit;
210 end;
212 if not g_Net_Slist_Connect then
213 begin
214 CheckLocalServers();
215 Exit;
216 end;
218 e_WriteLog('Fetching serverlist...', TMsgType.Notify);
219 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_FETCH]);
221 NetOut.Clear();
222 NetOut.Write(Byte(NET_MMSG_GET));
224 // TODO: what should we identify the build with?
225 MyVer := GAME_VERSION;
226 NetOut.Write(MyVer);
228 P := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
229 enet_peer_send(NetMPeer, NET_MCHAN_MAIN, P);
230 enet_host_flush(NetMHost);
232 while enet_host_service(NetMHost, @NetMEvent, 5000) > 0 do
233 begin
234 if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
235 begin
236 if not InMsg.Init(NetMEvent.packet^.data, NetMEvent.packet^.dataLength, True) then continue;
238 MID := InMsg.ReadByte();
240 if MID <> NET_MMSG_GET then continue;
242 Cnt := InMsg.ReadByte();
243 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_SLIST_RETRIEVED], [Cnt]), True);
245 if Cnt > 0 then
246 begin
247 SetLength(SL, Cnt);
249 for I := 0 to Cnt - 1 do
250 begin
251 SL[I].Number := I;
252 SL[I].IP := InMsg.ReadString();
253 SL[I].Port := InMsg.ReadWord();
254 SL[I].Name := InMsg.ReadString();
255 SL[I].Map := InMsg.ReadString();
256 SL[I].GameMode := InMsg.ReadByte();
257 SL[I].Players := InMsg.ReadByte();
258 SL[I].MaxPlayers := InMsg.ReadByte();
259 SL[I].Protocol := InMsg.ReadByte();
260 SL[I].Password := InMsg.ReadByte() = 1;
261 enet_address_set_host(Addr(SL[I].PingAddr), PChar(Addr(SL[I].IP[1])));
262 SL[I].Ping := -1;
263 SL[I].PingAddr.port := NET_PING_PORT;
264 end;
265 end;
267 if InMsg.ReadCount < InMsg.CurSize then
268 begin
269 // new master, supports version reports
270 Str := InMsg.ReadString();
271 if (Str <> MyVer) then
272 begin
273 { TODO }
274 g_Console_Add('!!! UpdVer = `' + Str + '`');
275 end;
276 // even newer master, supports extra info
277 if InMsg.ReadCount < InMsg.CurSize then
278 begin
279 slMOTD := b_Text_Format(InMsg.ReadString());
280 Str := b_Text_Format(InMsg.ReadString());
281 // check if the message has updated and the user has to read it again
282 if slUrgent <> Str then slReadUrgent := False;
283 slUrgent := Str;
284 end;
285 end;
287 Result := True;
288 break;
289 end;
290 end;
292 g_Net_Slist_Disconnect;
293 NetOut.Clear();
295 if Length(SL) = 0 then
296 begin
297 CheckLocalServers();
298 Exit;
299 end;
301 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
302 if Sock = ENET_SOCKET_NULL then Exit;
303 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
305 for I := Low(SL) to High(SL) do
306 PingServer(SL[I], Sock);
308 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
309 PingBcast(Sock);
311 T := GetTimerMS();
313 InMsg.Alloc(NET_BUFSIZE);
314 Buf.data := InMsg.Data;
315 Buf.dataLength := InMsg.MaxSize;
316 Cnt := 0;
317 while GetTimerMS() - T <= 500 do
318 begin
319 InMsg.Clear();
321 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
322 if RX <= 0 then continue;
323 InMsg.CurSize := RX;
325 InMsg.BeginReading();
327 if InMsg.ReadChar() <> 'D' then continue;
328 if InMsg.ReadChar() <> 'F' then continue;
330 FromSL := False;
331 for I := Low(SL) to High(SL) do
332 if (SL[I].PingAddr.host = SvAddr.host) and
333 (SL[I].PingAddr.port = SvAddr.port) then
334 begin
335 with SL[I] do
336 begin
337 Port := InMsg.ReadWord();
338 Ping := InMsg.ReadInt64();
339 Ping := GetTimerMS() - Ping;
340 Name := InMsg.ReadString();
341 Map := InMsg.ReadString();
342 GameMode := InMsg.ReadByte();
343 Players := InMsg.ReadByte();
344 MaxPlayers := InMsg.ReadByte();
345 Protocol := InMsg.ReadByte();
346 Password := InMsg.ReadByte() = 1;
347 LocalPl := InMsg.ReadByte();
348 Bots := InMsg.ReadWord();
349 end;
350 FromSL := True;
351 Inc(Cnt);
352 break;
353 end;
354 if not FromSL then
355 ProcessLocal();
356 end;
358 InMsg.Free();
359 enet_socket_destroy(Sock);
360 end;
362 procedure g_Net_Slist_WriteInfo();
363 var
364 Wad, Map: string;
365 Cli: Byte;
366 begin
367 Wad := g_ExtractWadNameNoPath(gMapInfo.Map);
368 Map := g_ExtractFileName(gMapInfo.Map);
370 NetOut.Write(NetServerName);
372 NetOut.Write(Wad + ':\' + Map);
373 NetOut.Write(gGameSettings.GameMode);
375 Cli := NetClientCount;
376 NetOut.Write(Cli);
378 NetOut.Write(NetMaxClients);
380 NetOut.Write(Byte(NET_PROTOCOL_VER));
381 NetOut.Write(Byte(NetPassword <> ''));
382 end;
384 procedure g_Net_Slist_Update;
385 var
387 P: pENetPacket;
389 begin
390 if (NetMHost = nil) or (NetMPeer = nil) then Exit;
392 NetOut.Clear();
393 NetOut.Write(Byte(NET_MMSG_UPD));
394 NetOut.Write(NetAddr.port);
396 g_Net_Slist_WriteInfo();
398 P := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
399 enet_peer_send(NetMPeer, NET_MCHAN_UPD, P);
401 enet_host_flush(NetMHost);
402 NetOut.Clear();
403 end;
405 procedure g_Net_Slist_Remove;
406 var
407 P: pENetPacket;
408 begin
409 if (NetMHost = nil) or (NetMPeer = nil) then Exit;
410 NetOut.Clear();
411 NetOut.Write(Byte(NET_MMSG_DEL));
412 NetOut.Write(NetAddr.port);
414 P := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
415 enet_peer_send(NetMPeer, NET_MCHAN_MAIN, P);
417 enet_host_flush(NetMHost);
418 NetOut.Clear();
419 end;
421 function g_Net_Slist_Connect: Boolean;
422 begin
423 Result := False;
425 NetMHost := enet_host_create(nil, 1, NET_MCHANS, 0, 0);
426 if (NetMHost = nil) then
427 begin
428 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
429 Exit;
430 end;
432 NetMPeer := enet_host_connect(NetMHost, @NetSlistAddr, NET_MCHANS, 0);
433 if (NetMPeer = nil) then
434 begin
435 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
436 enet_host_destroy(NetMHost);
437 NetMHost := nil;
438 Exit;
439 end;
441 if (enet_host_service(NetMHost, @NetMEvent, 3000) > 0) then
442 if NetMEvent.kind = ENET_EVENT_TYPE_CONNECT then
443 begin
444 Result := True;
445 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_CONN]);
446 Exit;
447 end
448 else
449 if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
450 enet_packet_destroy(NetMEvent.packet);
452 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
454 NetMHost := nil;
455 NetMPeer := nil;
456 end;
458 procedure g_Net_Slist_Disconnect;
459 begin
460 if (NetMHost = nil) and (NetMPeer = nil) then Exit;
462 if NetMode = NET_SERVER then g_Net_Slist_Remove;
464 enet_peer_disconnect(NetMPeer, 0);
465 enet_host_flush(NetMHost);
467 enet_peer_reset(NetMPeer);
468 enet_host_destroy(NetMHost);
470 NetMPeer := nil;
471 NetMHost := nil;
473 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
474 end;
476 procedure g_Net_Slist_Check;
477 begin
478 if (NetMHost = nil) or (NetMPeer = nil) then Exit;
480 while (enet_host_service(NetMHost, @NetMEvent, 0) > 0) do
481 begin
482 if NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT then
483 begin
484 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_LOST], True);
485 if NetMPeer <> nil then enet_peer_reset(NetMPeer);
486 if NetMHost <> nil then enet_host_destroy(NetMHost);
487 NetMPeer := nil;
488 NetMHost := nil;
489 Break;
490 end
491 else
492 if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
493 enet_packet_destroy(NetMEvent.packet);
494 end;
495 end;
497 procedure g_Net_Slist_Set(IP: string; Port: Word);
498 begin
499 if NetInitDone then
500 begin
501 enet_address_set_host(@NetSlistAddr, PChar(Addr(IP[1])));
502 NetSlistAddr.Port := Port;
503 e_WriteLog('Masterserver address set to ' + IP + ':' + IntToStr(Port), TMsgType.Notify);
504 end;
505 end;
507 function GetServerFromTable(Index: Integer; SL: TNetServerList; ST: TNetServerTable): TNetServer;
508 begin
509 Result.Number := 0;
510 Result.Protocol := 0;
511 Result.Name := '';
512 Result.IP := '';
513 Result.Port := 0;
514 Result.Map := '';
515 Result.Players := 0;
516 Result.MaxPlayers := 0;
517 Result.LocalPl := 0;
518 Result.Bots := 0;
519 Result.Ping := 0;
520 Result.GameMode := 0;
521 Result.Password := false;
522 FillChar(Result.PingAddr, SizeOf(ENetAddress), 0);
523 if ST = nil then
524 Exit;
525 if (Index < 0) or (Index >= Length(ST)) then
526 Exit;
527 Result := SL[ST[Index].Indices[ST[Index].Current]];
528 end;
530 procedure g_Serverlist_Draw(var SL: TNetServerList; var ST: TNetServerTable);
531 var
532 Srv: TNetServer;
533 sy, i, y, mw, mx, l: Integer;
534 cw: Byte = 0;
535 ch: Byte = 0;
536 ww: Word = 0;
537 hh: Word = 0;
538 ip: string;
539 begin
540 ip := '';
541 sy := 0;
543 e_CharFont_GetSize(gMenuFont, _lc[I_NET_SLIST], ww, hh);
544 e_CharFont_Print(gMenuFont, (gScreenWidth div 2) - (ww div 2), 16, _lc[I_NET_SLIST]);
546 e_TextureFontGetSize(gStdFont, cw, ch);
548 ip := _lc[I_NET_SLIST_HELP];
549 mw := (Length(ip) * cw) div 2;
551 e_DrawFillQuad(16, 64, gScreenWidth-16, gScreenHeight-84, 64, 64, 64, 110);
552 e_DrawQuad(16, 64, gScreenWidth-16, gScreenHeight-84, 255, 127, 0);
554 e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
556 // MOTD
557 if slMOTD <> '' then
558 begin
559 e_DrawFillQuad(16, gScreenHeight-84, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
560 e_DrawQuad(16, gScreenHeight-84, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
561 e_TextureFontPrintFmt(20, gScreenHeight-81, slMOTD, gStdFont, False, True);
562 end;
564 // Urgent message
565 if not slReadUrgent and (slUrgent <> '') then
566 begin
567 e_DrawFillQuad(17, 65, gScreenWidth-17, gScreenHeight-85, 64, 64, 64, 128);
568 e_DrawFillQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
569 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 64, 64, 64, 128);
570 e_DrawQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
571 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 255, 127, 0);
572 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 - 40,
573 gScreenWidth div 2 + 256, gScreenHeight div 2 - 40, 255, 127, 0);
574 l := Length(_lc[I_NET_SLIST_URGENT]) div 2;
575 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - 58,
576 _lc[I_NET_SLIST_URGENT], gStdFont);
577 l := Length(slUrgent) div 2;
578 e_TextureFontPrintFmt(gScreenWidth div 2 - 253, gScreenHeight div 2 - 38,
579 slUrgent, gStdFont, False, True);
580 l := Length(_lc[I_NET_SLIST_URGENT_CONT]) div 2;
581 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 + 41,
582 _lc[I_NET_SLIST_URGENT_CONT], gStdFont);
583 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 + 40,
584 gScreenWidth div 2 + 256, gScreenHeight div 2 + 40, 255, 127, 0);
585 Exit;
586 end;
588 if SL = nil then
589 begin
590 l := Length(slWaitStr) div 2;
591 e_DrawFillQuad(17, 65, gScreenWidth-17, gScreenHeight-85, 64, 64, 64, 128);
592 e_DrawQuad(gScreenWidth div 2 - 192, gScreenHeight div 2 - 10,
593 gScreenWidth div 2 + 192, gScreenHeight div 2 + 11, 255, 127, 0);
594 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - ch div 2,
595 slWaitStr, gStdFont);
596 Exit;
597 end;
599 y := 90;
600 if (slSelection < Length(ST)) then
601 begin
602 I := slSelection;
603 sy := y + 42 * I - 4;
604 Srv := GetServerFromTable(I, SL, ST);
605 ip := _lc[I_NET_ADDRESS] + ' ' + Srv.IP + ':' + IntToStr(Srv.Port);
606 if Srv.Password then
607 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_YES]
608 else
609 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_NO];
610 end else
611 if Length(ST) > 0 then
612 slSelection := 0;
614 mw := (gScreenWidth - 188);
615 mx := 16 + mw;
617 e_DrawFillQuad(16 + 1, sy, gScreenWidth - 16 - 1, sy + 40, 64, 64, 64, 0);
618 e_DrawLine(1, 16 + 1, sy, gScreenWidth - 16 - 1, sy, 205, 205, 205);
619 e_DrawLine(1, 16 + 1, sy + 41, gScreenWidth - 16 - 1, sy + 41, 255, 255, 255);
621 e_DrawLine(1, 16, 85, gScreenWidth - 16, 85, 255, 127, 0);
622 e_DrawLine(1, 16, gScreenHeight-104, gScreenWidth-16, gScreenHeight-104, 255, 127, 0);
624 e_DrawLine(1, mx - 70, 64, mx - 70, gScreenHeight-84, 255, 127, 0);
625 e_DrawLine(1, mx, 64, mx, gScreenHeight-104, 255, 127, 0);
626 e_DrawLine(1, mx + 52, 64, mx + 52, gScreenHeight-104, 255, 127, 0);
627 e_DrawLine(1, mx + 104, 64, mx + 104, gScreenHeight-104, 255, 127, 0);
629 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
630 e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
631 e_TextureFontPrintEx(mx + 2, 68, 'MODE', gStdFont, 255, 127, 0, 1);
632 e_TextureFontPrintEx(mx + 54, 68, 'PLRS', gStdFont, 255, 127, 0, 1);
633 e_TextureFontPrintEx(mx + 106, 68, 'VER', gStdFont, 255, 127, 0, 1);
635 y := 90;
636 for I := 0 to High(ST) do
637 begin
638 Srv := GetServerFromTable(I, SL, ST);
639 // Name and map
640 e_TextureFontPrintEx(18, y, Srv.Name, gStdFont, 255, 255, 255, 1);
641 e_TextureFontPrintEx(18, y + 16, Srv.Map, gStdFont, 210, 210, 210, 1);
643 // Ping and similar count
644 if (Srv.Ping < 0) or (Srv.Ping > 999) then
645 e_TextureFontPrintEx(mx - 68, y, _lc[I_NET_SLIST_NO_ACCESS], gStdFont, 255, 0, 0, 1)
646 else
647 if Srv.Ping = 0 then
648 e_TextureFontPrintEx(mx - 68, y, '<1' + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1)
649 else
650 e_TextureFontPrintEx(mx - 68, y, IntToStr(Srv.Ping) + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1);
652 if Length(ST[I].Indices) > 1 then
653 e_TextureFontPrintEx(mx - 68, y + 16, '< ' + IntToStr(Length(ST[I].Indices)) + ' >', gStdFont, 210, 210, 210, 1);
655 // Game mode
656 e_TextureFontPrintEx(mx + 2, y, g_Game_ModeToText(Srv.GameMode), gStdFont, 255, 255, 255, 1);
658 // Players
659 e_TextureFontPrintEx(mx + 54, y, IntToStr(Srv.Players) + '/' + IntToStr(Srv.MaxPlayers), gStdFont, 255, 255, 255, 1);
660 e_TextureFontPrintEx(mx + 54, y + 16, IntToStr(Srv.LocalPl) + '+' + IntToStr(Srv.Bots), gStdFont, 210, 210, 210, 1);
662 // Version
663 e_TextureFontPrintEx(mx + 106, y, IntToStr(Srv.Protocol), gStdFont, 255, 255, 255, 1);
665 y := y + 42;
666 end;
668 e_TextureFontPrintEx(20, gScreenHeight-101, ip, gStdFont, 205, 205, 205, 1);
669 ip := IntToStr(Length(ST)) + _lc[I_NET_SLIST_SERVERS];
670 e_TextureFontPrintEx(gScreenWidth - 48 - (Length(ip) + 1)*cw,
671 gScreenHeight-101, ip, gStdFont, 205, 205, 205, 1);
672 end;
674 procedure g_Serverlist_GenerateTable(SL: TNetServerList; var ST: TNetServerTable);
675 var
676 i, j: Integer;
678 function FindServerInTable(Name: string): Integer;
679 var
680 i: Integer;
681 begin
682 Result := -1;
683 if ST = nil then
684 Exit;
685 for i := Low(ST) to High(ST) do
686 begin
687 if Length(ST[i].Indices) = 0 then
688 continue;
689 if SL[ST[i].Indices[0]].Name = Name then
690 begin
691 Result := i;
692 Exit;
693 end;
694 end;
695 end;
696 function ComparePing(i1, i2: Integer): Boolean;
697 var
698 p1, p2: Int64;
699 begin
700 p1 := SL[i1].Ping;
701 p2 := SL[i2].Ping;
702 if (p1 < 0) then p1 := 999;
703 if (p2 < 0) then p2 := 999;
704 Result := p1 > p2;
705 end;
706 procedure SortIndices(var ind: Array of Integer);
707 var
708 I, J: Integer;
709 T: Integer;
710 begin
711 for I := High(ind) downto Low(ind) do
712 for J := Low(ind) to High(ind) - 1 do
713 if ComparePing(ind[j], ind[j+1]) then
714 begin
715 T := ind[j];
716 ind[j] := ind[j+1];
717 ind[j+1] := T;
718 end;
719 end;
720 procedure SortRows();
721 var
722 I, J: Integer;
723 T: TNetServerRow;
724 begin
725 for I := High(ST) downto Low(ST) do
726 for J := Low(ST) to High(ST) - 1 do
727 if ComparePing(ST[j].Indices[0], ST[j+1].Indices[0]) then
728 begin
729 T := ST[j];
730 ST[j] := ST[j+1];
731 ST[j+1] := T;
732 end;
733 end;
734 begin
735 ST := nil;
736 if SL = nil then
737 Exit;
738 for i := Low(SL) to High(SL) do
739 begin
740 j := FindServerInTable(SL[i].Name);
741 if j = -1 then
742 begin
743 j := Length(ST);
744 SetLength(ST, j + 1);
745 ST[j].Current := 0;
746 SetLength(ST[j].Indices, 1);
747 ST[j].Indices[0] := i;
748 end
749 else
750 begin
751 SetLength(ST[j].Indices, Length(ST[j].Indices) + 1);
752 ST[j].Indices[High(ST[j].Indices)] := i;
753 end;
754 end;
756 for i := Low(ST) to High(ST) do
757 SortIndices(ST[i].Indices);
759 SortRows();
760 end;
762 procedure g_Serverlist_Control(var SL: TNetServerList; var ST: TNetServerTable);
763 var
764 qm: Boolean;
765 Srv: TNetServer;
766 begin
767 if gConsoleShow or gChatShow then
768 Exit;
770 qm := g_ProcessMessages(); // this updates kbd
772 if qm or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
773 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or
774 e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
775 begin
776 SL := nil;
777 ST := nil;
778 gState := STATE_MENU;
779 g_GUI_ShowWindow('MainMenu');
780 g_GUI_ShowWindow('NetGameMenu');
781 g_GUI_ShowWindow('NetClientMenu');
782 g_Sound_PlayEx(WINDOW_CLOSESOUND);
783 Exit;
784 end;
786 // if there's a message on the screen,
787 if not slReadUrgent and (slUrgent <> '') then
788 begin
789 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
790 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
791 slReadUrgent := True;
792 Exit;
793 end;
795 if e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_JUMP) or
796 e_KeyPressed(JOY0_ACTIVATE) or e_KeyPressed(JOY1_ACTIVATE) or e_KeyPressed(JOY2_ACTIVATE) or e_KeyPressed(JOY3_ACTIVATE) then
797 begin
798 if not slFetched then
799 begin
800 slWaitStr := _lc[I_NET_SLIST_WAIT];
802 g_Game_Draw;
803 g_window.ReDrawWindow;
805 if g_Net_Slist_Fetch(SL) then
806 begin
807 if SL = nil then
808 slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
809 end
810 else
811 if SL = nil then
812 slWaitStr := _lc[I_NET_SLIST_ERROR];
813 slFetched := True;
814 slSelection := 0;
815 g_Serverlist_GenerateTable(SL, ST);
816 end;
817 end
818 else
819 slFetched := False;
821 if SL = nil then Exit;
823 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
824 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
825 begin
826 if not slReturnPressed then
827 begin
828 Srv := GetServerFromTable(slSelection, SL, ST);
829 if Srv.Password then
830 begin
831 PromptIP := Srv.IP;
832 PromptPort := Srv.Port;
833 gState := STATE_MENU;
834 g_GUI_ShowWindow('ClientPasswordMenu');
835 SL := nil;
836 ST := nil;
837 slReturnPressed := True;
838 Exit;
839 end
840 else
841 g_Game_StartClient(Srv.IP, Srv.Port, '');
842 SL := nil;
843 ST := nil;
844 slReturnPressed := True;
845 Exit;
846 end;
847 end
848 else
849 slReturnPressed := False;
851 if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) or e_KeyPressed(VK_DOWN) or
852 e_KeyPressed(JOY0_DOWN) or e_KeyPressed(JOY1_DOWN) or e_KeyPressed(JOY2_DOWN) or e_KeyPressed(JOY3_DOWN) then
853 begin
854 if not slDirPressed then
855 begin
856 Inc(slSelection);
857 if slSelection > High(ST) then slSelection := 0;
858 slDirPressed := True;
859 end;
860 end;
862 if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) or e_KeyPressed(VK_UP) or
863 e_KeyPressed(JOY0_UP) or e_KeyPressed(JOY1_UP) or e_KeyPressed(JOY2_UP) or e_KeyPressed(JOY3_UP) then
864 begin
865 if not slDirPressed then
866 begin
867 if slSelection = 0 then slSelection := Length(ST);
868 Dec(slSelection);
870 slDirPressed := True;
871 end;
872 end;
874 if e_KeyPressed(IK_RIGHT) or e_KeyPressed(IK_KPRIGHT) or e_KeyPressed(VK_RIGHT) or
875 e_KeyPressed(JOY0_RIGHT) or e_KeyPressed(JOY1_RIGHT) or e_KeyPressed(JOY2_RIGHT) or e_KeyPressed(JOY3_RIGHT) then
876 begin
877 if not slDirPressed then
878 begin
879 Inc(ST[slSelection].Current);
880 if ST[slSelection].Current > High(ST[slSelection].Indices) then ST[slSelection].Current := 0;
881 slDirPressed := True;
882 end;
883 end;
885 if e_KeyPressed(IK_LEFT) or e_KeyPressed(IK_KPLEFT) or e_KeyPressed(VK_LEFT) or
886 e_KeyPressed(JOY0_LEFT) or e_KeyPressed(JOY1_LEFT) or e_KeyPressed(JOY2_LEFT) or e_KeyPressed(JOY3_LEFT) then
887 begin
888 if not slDirPressed then
889 begin
890 if ST[slSelection].Current = 0 then ST[slSelection].Current := Length(ST[slSelection].Indices);
891 Dec(ST[slSelection].Current);
893 slDirPressed := True;
894 end;
895 end;
897 if (not e_KeyPressed(IK_DOWN)) and
898 (not e_KeyPressed(IK_UP)) and
899 (not e_KeyPressed(IK_RIGHT)) and
900 (not e_KeyPressed(IK_LEFT)) and
901 (not e_KeyPressed(IK_KPDOWN)) and
902 (not e_KeyPressed(IK_KPUP)) and
903 (not e_KeyPressed(IK_KPRIGHT)) and
904 (not e_KeyPressed(IK_KPLEFT)) and
905 (not e_KeyPressed(VK_DOWN)) and
906 (not e_KeyPressed(VK_UP)) and
907 (not e_KeyPressed(VK_RIGHT)) and
908 (not e_KeyPressed(VK_LEFT)) and
909 (not e_KeyPressed(JOY0_UP)) and (not e_KeyPressed(JOY1_UP)) and (not e_KeyPressed(JOY2_UP)) and (not e_KeyPressed(JOY3_UP)) and
910 (not e_KeyPressed(JOY0_DOWN)) and (not e_KeyPressed(JOY1_DOWN)) and (not e_KeyPressed(JOY2_DOWN)) and (not e_KeyPressed(JOY3_DOWN)) and
911 (not e_KeyPressed(JOY0_LEFT)) and (not e_KeyPressed(JOY1_LEFT)) and (not e_KeyPressed(JOY2_LEFT)) and (not e_KeyPressed(JOY3_LEFT)) and
912 (not e_KeyPressed(JOY0_RIGHT)) and (not e_KeyPressed(JOY1_RIGHT)) and (not e_KeyPressed(JOY2_RIGHT)) and (not e_KeyPressed(JOY3_RIGHT))
913 then
914 slDirPressed := False;
915 end;
917 end.