DEADSOFTWARE

GUI: MOTD field now has automatic height
[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, motdh: 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 motdh := gScreenHeight - 49 - ch * b_Text_LineCount(slMOTD);
553 e_DrawFillQuad(16, 64, gScreenWidth-16, motdh, 64, 64, 64, 110);
554 e_DrawQuad(16, 64, gScreenWidth-16, motdh, 255, 127, 0);
556 e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
558 // MOTD
559 if slMOTD <> '' then
560 begin
561 e_DrawFillQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
562 e_DrawQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
563 e_TextureFontPrintFmt(20, motdh + 3, slMOTD, gStdFont, False, True);
564 end;
566 // Urgent message
567 if not slReadUrgent and (slUrgent <> '') then
568 begin
569 e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
570 e_DrawFillQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
571 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 64, 64, 64, 128);
572 e_DrawQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
573 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 255, 127, 0);
574 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 - 40,
575 gScreenWidth div 2 + 256, gScreenHeight div 2 - 40, 255, 127, 0);
576 l := Length(_lc[I_NET_SLIST_URGENT]) div 2;
577 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - 58,
578 _lc[I_NET_SLIST_URGENT], gStdFont);
579 l := Length(slUrgent) div 2;
580 e_TextureFontPrintFmt(gScreenWidth div 2 - 253, gScreenHeight div 2 - 38,
581 slUrgent, gStdFont, False, True);
582 l := Length(_lc[I_NET_SLIST_URGENT_CONT]) div 2;
583 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 + 41,
584 _lc[I_NET_SLIST_URGENT_CONT], gStdFont);
585 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 + 40,
586 gScreenWidth div 2 + 256, gScreenHeight div 2 + 40, 255, 127, 0);
587 Exit;
588 end;
590 if SL = nil then
591 begin
592 l := Length(slWaitStr) div 2;
593 e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
594 e_DrawQuad(gScreenWidth div 2 - 192, gScreenHeight div 2 - 10,
595 gScreenWidth div 2 + 192, gScreenHeight div 2 + 11, 255, 127, 0);
596 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - ch div 2,
597 slWaitStr, gStdFont);
598 Exit;
599 end;
601 y := 90;
602 if (slSelection < Length(ST)) then
603 begin
604 I := slSelection;
605 sy := y + 42 * I - 4;
606 Srv := GetServerFromTable(I, SL, ST);
607 ip := _lc[I_NET_ADDRESS] + ' ' + Srv.IP + ':' + IntToStr(Srv.Port);
608 if Srv.Password then
609 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_YES]
610 else
611 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_NO];
612 end else
613 if Length(ST) > 0 then
614 slSelection := 0;
616 mw := (gScreenWidth - 188);
617 mx := 16 + mw;
619 e_DrawFillQuad(16 + 1, sy, gScreenWidth - 16 - 1, sy + 40, 64, 64, 64, 0);
620 e_DrawLine(1, 16 + 1, sy, gScreenWidth - 16 - 1, sy, 205, 205, 205);
621 e_DrawLine(1, 16 + 1, sy + 41, gScreenWidth - 16 - 1, sy + 41, 255, 255, 255);
623 e_DrawLine(1, 16, 85, gScreenWidth - 16, 85, 255, 127, 0);
624 e_DrawLine(1, 16, motdh-20, gScreenWidth-16, motdh-20, 255, 127, 0);
626 e_DrawLine(1, mx - 70, 64, mx - 70, motdh, 255, 127, 0);
627 e_DrawLine(1, mx, 64, mx, motdh-20, 255, 127, 0);
628 e_DrawLine(1, mx + 52, 64, mx + 52, motdh-20, 255, 127, 0);
629 e_DrawLine(1, mx + 104, 64, mx + 104, motdh-20, 255, 127, 0);
631 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
632 e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
633 e_TextureFontPrintEx(mx + 2, 68, 'MODE', gStdFont, 255, 127, 0, 1);
634 e_TextureFontPrintEx(mx + 54, 68, 'PLRS', gStdFont, 255, 127, 0, 1);
635 e_TextureFontPrintEx(mx + 106, 68, 'VER', gStdFont, 255, 127, 0, 1);
637 y := 90;
638 for I := 0 to High(ST) do
639 begin
640 Srv := GetServerFromTable(I, SL, ST);
641 // Name and map
642 e_TextureFontPrintEx(18, y, Srv.Name, gStdFont, 255, 255, 255, 1);
643 e_TextureFontPrintEx(18, y + 16, Srv.Map, gStdFont, 210, 210, 210, 1);
645 // Ping and similar count
646 if (Srv.Ping < 0) or (Srv.Ping > 999) then
647 e_TextureFontPrintEx(mx - 68, y, _lc[I_NET_SLIST_NO_ACCESS], gStdFont, 255, 0, 0, 1)
648 else
649 if Srv.Ping = 0 then
650 e_TextureFontPrintEx(mx - 68, y, '<1' + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1)
651 else
652 e_TextureFontPrintEx(mx - 68, y, IntToStr(Srv.Ping) + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1);
654 if Length(ST[I].Indices) > 1 then
655 e_TextureFontPrintEx(mx - 68, y + 16, '< ' + IntToStr(Length(ST[I].Indices)) + ' >', gStdFont, 210, 210, 210, 1);
657 // Game mode
658 e_TextureFontPrintEx(mx + 2, y, g_Game_ModeToText(Srv.GameMode), gStdFont, 255, 255, 255, 1);
660 // Players
661 e_TextureFontPrintEx(mx + 54, y, IntToStr(Srv.Players) + '/' + IntToStr(Srv.MaxPlayers), gStdFont, 255, 255, 255, 1);
662 e_TextureFontPrintEx(mx + 54, y + 16, IntToStr(Srv.LocalPl) + '+' + IntToStr(Srv.Bots), gStdFont, 210, 210, 210, 1);
664 // Version
665 e_TextureFontPrintEx(mx + 106, y, IntToStr(Srv.Protocol), gStdFont, 255, 255, 255, 1);
667 y := y + 42;
668 end;
670 e_TextureFontPrintEx(20, motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
671 ip := IntToStr(Length(ST)) + _lc[I_NET_SLIST_SERVERS];
672 e_TextureFontPrintEx(gScreenWidth - 48 - (Length(ip) + 1)*cw,
673 motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
674 end;
676 procedure g_Serverlist_GenerateTable(SL: TNetServerList; var ST: TNetServerTable);
677 var
678 i, j: Integer;
680 function FindServerInTable(Name: string): Integer;
681 var
682 i: Integer;
683 begin
684 Result := -1;
685 if ST = nil then
686 Exit;
687 for i := Low(ST) to High(ST) do
688 begin
689 if Length(ST[i].Indices) = 0 then
690 continue;
691 if SL[ST[i].Indices[0]].Name = Name then
692 begin
693 Result := i;
694 Exit;
695 end;
696 end;
697 end;
698 function ComparePing(i1, i2: Integer): Boolean;
699 var
700 p1, p2: Int64;
701 begin
702 p1 := SL[i1].Ping;
703 p2 := SL[i2].Ping;
704 if (p1 < 0) then p1 := 999;
705 if (p2 < 0) then p2 := 999;
706 Result := p1 > p2;
707 end;
708 procedure SortIndices(var ind: Array of Integer);
709 var
710 I, J: Integer;
711 T: Integer;
712 begin
713 for I := High(ind) downto Low(ind) do
714 for J := Low(ind) to High(ind) - 1 do
715 if ComparePing(ind[j], ind[j+1]) then
716 begin
717 T := ind[j];
718 ind[j] := ind[j+1];
719 ind[j+1] := T;
720 end;
721 end;
722 procedure SortRows();
723 var
724 I, J: Integer;
725 T: TNetServerRow;
726 begin
727 for I := High(ST) downto Low(ST) do
728 for J := Low(ST) to High(ST) - 1 do
729 if ComparePing(ST[j].Indices[0], ST[j+1].Indices[0]) then
730 begin
731 T := ST[j];
732 ST[j] := ST[j+1];
733 ST[j+1] := T;
734 end;
735 end;
736 begin
737 ST := nil;
738 if SL = nil then
739 Exit;
740 for i := Low(SL) to High(SL) do
741 begin
742 j := FindServerInTable(SL[i].Name);
743 if j = -1 then
744 begin
745 j := Length(ST);
746 SetLength(ST, j + 1);
747 ST[j].Current := 0;
748 SetLength(ST[j].Indices, 1);
749 ST[j].Indices[0] := i;
750 end
751 else
752 begin
753 SetLength(ST[j].Indices, Length(ST[j].Indices) + 1);
754 ST[j].Indices[High(ST[j].Indices)] := i;
755 end;
756 end;
758 for i := Low(ST) to High(ST) do
759 SortIndices(ST[i].Indices);
761 SortRows();
762 end;
764 procedure g_Serverlist_Control(var SL: TNetServerList; var ST: TNetServerTable);
765 var
766 qm: Boolean;
767 Srv: TNetServer;
768 begin
769 if gConsoleShow or gChatShow then
770 Exit;
772 qm := g_ProcessMessages(); // this updates kbd
774 if qm or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
775 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or
776 e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
777 begin
778 SL := nil;
779 ST := nil;
780 gState := STATE_MENU;
781 g_GUI_ShowWindow('MainMenu');
782 g_GUI_ShowWindow('NetGameMenu');
783 g_GUI_ShowWindow('NetClientMenu');
784 g_Sound_PlayEx(WINDOW_CLOSESOUND);
785 Exit;
786 end;
788 // if there's a message on the screen,
789 if not slReadUrgent and (slUrgent <> '') then
790 begin
791 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
792 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
793 slReadUrgent := True;
794 Exit;
795 end;
797 if e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_JUMP) or
798 e_KeyPressed(JOY0_ACTIVATE) or e_KeyPressed(JOY1_ACTIVATE) or e_KeyPressed(JOY2_ACTIVATE) or e_KeyPressed(JOY3_ACTIVATE) then
799 begin
800 if not slFetched then
801 begin
802 slWaitStr := _lc[I_NET_SLIST_WAIT];
804 g_Game_Draw;
805 g_window.ReDrawWindow;
807 if g_Net_Slist_Fetch(SL) then
808 begin
809 if SL = nil then
810 slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
811 end
812 else
813 if SL = nil then
814 slWaitStr := _lc[I_NET_SLIST_ERROR];
815 slFetched := True;
816 slSelection := 0;
817 g_Serverlist_GenerateTable(SL, ST);
818 end;
819 end
820 else
821 slFetched := False;
823 if SL = nil then Exit;
825 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
826 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
827 begin
828 if not slReturnPressed then
829 begin
830 Srv := GetServerFromTable(slSelection, SL, ST);
831 if Srv.Password then
832 begin
833 PromptIP := Srv.IP;
834 PromptPort := Srv.Port;
835 gState := STATE_MENU;
836 g_GUI_ShowWindow('ClientPasswordMenu');
837 SL := nil;
838 ST := nil;
839 slReturnPressed := True;
840 Exit;
841 end
842 else
843 g_Game_StartClient(Srv.IP, Srv.Port, '');
844 SL := nil;
845 ST := nil;
846 slReturnPressed := True;
847 Exit;
848 end;
849 end
850 else
851 slReturnPressed := False;
853 if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) or e_KeyPressed(VK_DOWN) or
854 e_KeyPressed(JOY0_DOWN) or e_KeyPressed(JOY1_DOWN) or e_KeyPressed(JOY2_DOWN) or e_KeyPressed(JOY3_DOWN) then
855 begin
856 if not slDirPressed then
857 begin
858 Inc(slSelection);
859 if slSelection > High(ST) then slSelection := 0;
860 slDirPressed := True;
861 end;
862 end;
864 if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) or e_KeyPressed(VK_UP) or
865 e_KeyPressed(JOY0_UP) or e_KeyPressed(JOY1_UP) or e_KeyPressed(JOY2_UP) or e_KeyPressed(JOY3_UP) then
866 begin
867 if not slDirPressed then
868 begin
869 if slSelection = 0 then slSelection := Length(ST);
870 Dec(slSelection);
872 slDirPressed := True;
873 end;
874 end;
876 if e_KeyPressed(IK_RIGHT) or e_KeyPressed(IK_KPRIGHT) or e_KeyPressed(VK_RIGHT) or
877 e_KeyPressed(JOY0_RIGHT) or e_KeyPressed(JOY1_RIGHT) or e_KeyPressed(JOY2_RIGHT) or e_KeyPressed(JOY3_RIGHT) then
878 begin
879 if not slDirPressed then
880 begin
881 Inc(ST[slSelection].Current);
882 if ST[slSelection].Current > High(ST[slSelection].Indices) then ST[slSelection].Current := 0;
883 slDirPressed := True;
884 end;
885 end;
887 if e_KeyPressed(IK_LEFT) or e_KeyPressed(IK_KPLEFT) or e_KeyPressed(VK_LEFT) or
888 e_KeyPressed(JOY0_LEFT) or e_KeyPressed(JOY1_LEFT) or e_KeyPressed(JOY2_LEFT) or e_KeyPressed(JOY3_LEFT) then
889 begin
890 if not slDirPressed then
891 begin
892 if ST[slSelection].Current = 0 then ST[slSelection].Current := Length(ST[slSelection].Indices);
893 Dec(ST[slSelection].Current);
895 slDirPressed := True;
896 end;
897 end;
899 if (not e_KeyPressed(IK_DOWN)) and
900 (not e_KeyPressed(IK_UP)) and
901 (not e_KeyPressed(IK_RIGHT)) and
902 (not e_KeyPressed(IK_LEFT)) and
903 (not e_KeyPressed(IK_KPDOWN)) and
904 (not e_KeyPressed(IK_KPUP)) and
905 (not e_KeyPressed(IK_KPRIGHT)) and
906 (not e_KeyPressed(IK_KPLEFT)) and
907 (not e_KeyPressed(VK_DOWN)) and
908 (not e_KeyPressed(VK_UP)) and
909 (not e_KeyPressed(VK_RIGHT)) and
910 (not e_KeyPressed(VK_LEFT)) and
911 (not e_KeyPressed(JOY0_UP)) and (not e_KeyPressed(JOY1_UP)) and (not e_KeyPressed(JOY2_UP)) and (not e_KeyPressed(JOY3_UP)) and
912 (not e_KeyPressed(JOY0_DOWN)) and (not e_KeyPressed(JOY1_DOWN)) and (not e_KeyPressed(JOY2_DOWN)) and (not e_KeyPressed(JOY3_DOWN)) and
913 (not e_KeyPressed(JOY0_LEFT)) and (not e_KeyPressed(JOY1_LEFT)) and (not e_KeyPressed(JOY2_LEFT)) and (not e_KeyPressed(JOY3_LEFT)) and
914 (not e_KeyPressed(JOY0_RIGHT)) and (not e_KeyPressed(JOY1_RIGHT)) and (not e_KeyPressed(JOY2_RIGHT)) and (not e_KeyPressed(JOY3_RIGHT))
915 then
916 slDirPressed := False;
917 end;
919 end.