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;
  18
  19 interface
  20
  21 uses ENet;
  22
  23 const
  24   NET_MCHANS = 2;
  25
  26   NET_MCHAN_MAIN = 0;
  27   NET_MCHAN_UPD  = 1;
  28
  29   NET_MMSG_UPD = 200;
  30   NET_MMSG_DEL = 201;
  31   NET_MMSG_GET = 202;
  32
  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;
  52
  53   TNetServerList = array of TNetServer;
  54   pTNetServerList = ^TNetServerList;
  55   TNetServerTable = array of TNetServerRow;
  56
  57 var
  58   NetMHost:       pENetHost = nil;
  59   NetMPeer:       pENetPeer = nil;
  60
  61   slCurrent:       TNetServerList = nil;
  62   slTable:         TNetServerTable = nil;
  63   slWaitStr:       string = '';
  64   slReturnPressed: Boolean = True;
  65
  66 procedure g_Net_Slist_Set(IP: string; Port: Word);
  67 function  g_Net_Slist_Fetch(var SL: TNetServerList): Boolean;
  68 procedure g_Net_Slist_Update();
  69 procedure g_Net_Slist_Remove();
  70 function  g_Net_Slist_Connect(): Boolean;
  71 procedure g_Net_Slist_Check();
  72 procedure g_Net_Slist_Disconnect();
  73 procedure g_Net_Slist_WriteInfo();
  74
  75 procedure g_Serverlist_GenerateTable(SL: TNetServerList; var ST: TNetServerTable);
  76 procedure g_Serverlist_Draw(var SL: TNetServerList; var ST: TNetServerTable);
  77 procedure g_Serverlist_Control(var SL: TNetServerList; var ST: TNetServerTable);
  78
  79 implementation
  80
  81 uses
  82   SysUtils, e_msg, e_input, e_graphics, e_log, g_window, g_net, g_console,
  83   g_map, g_game, g_sound, g_gui, g_menu, g_options, g_language, wadreader;
  84
  85 var
  86   NetMEvent:      ENetEvent;
  87   slSelection:    Byte = 0;
  88   slFetched:      Boolean = False;
  89   slDirPressed:   Boolean = False;
  90
  91 function GetTimerMS(): Int64;
  92 begin
  93   Result := GetTimer() {div 1000};
  94 end;
  95
  96 procedure PingServer(var S: TNetServer; Sock: ENetSocket);
  97 var
  98   Buf: ENetBuffer;
  99   Ping: array [0..9] of Byte;
 100   ClTime: Int64;
 101 begin
 102   ClTime := GetTimerMS();
 103
 104   Buf.data := Addr(Ping[0]);
 105   Buf.dataLength := 2+8;
 106
 107   Ping[0] := Ord('D');
 108   Ping[1] := Ord('F');
 109   Int64(Addr(Ping[2])^) := ClTime;
 110
 111   enet_socket_send(Sock, Addr(S.PingAddr), @Buf, 1);
 112 end;
 113
 114 procedure PingBcast(Sock: ENetSocket);
 115 var
 116   S: TNetServer;
 117 begin
 118   S.IP := '255.255.255.255';
 119   S.Port := NET_PING_PORT;
 120   enet_address_set_host(Addr(S.PingAddr), PChar(Addr(S.IP[1])));
 121   S.Ping := -1;
 122   S.PingAddr.port := S.Port;
 123   PingServer(S, Sock);
 124 end;
 125
 126 function g_Net_Slist_Fetch(var SL: TNetServerList): Boolean;
 127 var
 128   Cnt: Byte;
 129   P: pENetPacket;
 130   MID: Byte;
 131   I, RX: Integer;
 132   T: Int64;
 133   Sock: ENetSocket;
 134   Buf: ENetBuffer;
 135   InMsg: TMsg;
 136   SvAddr: ENetAddress;
 137   FromSL: Boolean;
 138
 139   procedure ProcessLocal();
 140   begin
 141     I := Length(SL);
 142     SetLength(SL, I + 1);
 143     with SL[I] do
 144     begin
 145       IP := DecodeIPV4(SvAddr.host);
 146       Port := InMsg.ReadWord();
 147       Ping := InMsg.ReadInt64();
 148       Ping := GetTimerMS() - Ping;
 149       Name := InMsg.ReadString();
 150       Map := InMsg.ReadString();
 151       GameMode := InMsg.ReadByte();
 152       Players := InMsg.ReadByte();
 153       MaxPlayers := InMsg.ReadByte();
 154       Protocol := InMsg.ReadByte();
 155       Password := InMsg.ReadByte() = 1;
 156       LocalPl := InMsg.ReadByte();
 157       Bots := InMsg.ReadWord();
 158     end;
 159   end;
 160   procedure CheckLocalServers();
 161   begin
 162     SetLength(SL, 0);
 163
 164     Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
 165     if Sock = ENET_SOCKET_NULL then Exit;
 166     enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
 167     enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
 168     PingBcast(Sock);
 169
 170     T := GetTimerMS();
 171
 172     InMsg.Alloc(NET_BUFSIZE);
 173     Buf.data := InMsg.Data;
 174     Buf.dataLength := InMsg.MaxSize;
 175     while GetTimerMS() - T <= 500 do
 176     begin
 177       InMsg.Clear();
 178
 179       RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
 180       if RX <= 0 then continue;
 181       InMsg.CurSize := RX;
 182
 183       InMsg.BeginReading();
 184
 185       if InMsg.ReadChar() <> 'D' then continue;
 186       if InMsg.ReadChar() <> 'F' then continue;
 187
 188       ProcessLocal();
 189     end;
 190
 191     InMsg.Free();
 192     enet_socket_destroy(Sock);
 193
 194     if Length(SL) = 0 then SL := nil;
 195   end;
 196 begin
 197   Result := False;
 198   SL := nil;
 199
 200   if (NetMHost <> nil) or (NetMPeer <> nil) then
 201   begin
 202     CheckLocalServers();
 203     Exit;
 204   end;
 205
 206   if not g_Net_Slist_Connect then
 207   begin
 208     CheckLocalServers();
 209     Exit;
 210   end;
 211
 212   e_WriteLog('Fetching serverlist...', TMsgType.Notify);
 213   g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_FETCH]);
 214
 215   NetOut.Clear();
 216   NetOut.Write(Byte(NET_MMSG_GET));
 217
 218   P := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
 219   enet_peer_send(NetMPeer, NET_MCHAN_MAIN, P);
 220   enet_host_flush(NetMHost);
 221
 222   while enet_host_service(NetMHost, @NetMEvent, 5000) > 0 do
 223   begin
 224     if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
 225     begin
 226       if not InMsg.Init(NetMEvent.packet^.data, NetMEvent.packet^.dataLength, True) then continue;
 227
 228       MID := InMsg.ReadByte();
 229
 230       if MID <> NET_MMSG_GET then continue;
 231
 232       Cnt := InMsg.ReadByte();
 233       g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_SLIST_RETRIEVED], [Cnt]), True);
 234
 235       if Cnt > 0 then
 236       begin
 237         SetLength(SL, Cnt);
 238
 239         for I := 0 to Cnt - 1 do
 240         begin
 241           SL[I].Number := I;
 242           SL[I].IP := InMsg.ReadString();
 243           SL[I].Port := InMsg.ReadWord();
 244           SL[I].Name := InMsg.ReadString();
 245           SL[I].Map := InMsg.ReadString();
 246           SL[I].GameMode := InMsg.ReadByte();
 247           SL[I].Players := InMsg.ReadByte();
 248           SL[I].MaxPlayers := InMsg.ReadByte();
 249           SL[I].Protocol := InMsg.ReadByte();
 250           SL[I].Password := InMsg.ReadByte() = 1;
 251           enet_address_set_host(Addr(SL[I].PingAddr), PChar(Addr(SL[I].IP[1])));
 252           SL[I].Ping := -1;
 253           SL[I].PingAddr.port := NET_PING_PORT;
 254         end;
 255       end;
 256
 257       Result := True;
 258       break;
 259     end;
 260   end;
 261
 262   g_Net_Slist_Disconnect;
 263   NetOut.Clear();
 264
 265   if Length(SL) = 0 then
 266   begin
 267     CheckLocalServers();
 268     Exit;
 269   end;
 270
 271   Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
 272   if Sock = ENET_SOCKET_NULL then Exit;
 273   enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
 274
 275   for I := Low(SL) to High(SL) do
 276     PingServer(SL[I], Sock);
 277
 278   enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
 279   PingBcast(Sock);
 280
 281   T := GetTimerMS();
 282
 283   InMsg.Alloc(NET_BUFSIZE);
 284   Buf.data := InMsg.Data;
 285   Buf.dataLength := InMsg.MaxSize;
 286   Cnt := 0;
 287   while GetTimerMS() - T <= 500 do
 288   begin
 289     InMsg.Clear();
 290
 291     RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
 292     if RX <= 0 then continue;
 293     InMsg.CurSize := RX;
 294
 295     InMsg.BeginReading();
 296
 297     if InMsg.ReadChar() <> 'D' then continue;
 298     if InMsg.ReadChar() <> 'F' then continue;
 299
 300     FromSL := False;
 301     for I := Low(SL) to High(SL) do
 302       if (SL[I].PingAddr.host = SvAddr.host) and
 303          (SL[I].PingAddr.port = SvAddr.port) then
 304       begin
 305         with SL[I] do
 306         begin
 307           Port := InMsg.ReadWord();
 308           Ping := InMsg.ReadInt64();
 309           Ping := GetTimerMS() - Ping;
 310           Name := InMsg.ReadString();
 311           Map := InMsg.ReadString();
 312           GameMode := InMsg.ReadByte();
 313           Players := InMsg.ReadByte();
 314           MaxPlayers := InMsg.ReadByte();
 315           Protocol := InMsg.ReadByte();
 316           Password := InMsg.ReadByte() = 1;
 317           LocalPl := InMsg.ReadByte();
 318           Bots := InMsg.ReadWord();
 319         end;
 320         FromSL := True;
 321         Inc(Cnt);
 322         break;
 323       end;
 324     if not FromSL then
 325       ProcessLocal();
 326   end;
 327
 328   InMsg.Free();
 329   enet_socket_destroy(Sock);
 330 end;
 331
 332 procedure g_Net_Slist_WriteInfo();
 333 var
 334   Wad, Map: string;
 335   Cli: Byte;
 336 begin
 337   Wad := g_ExtractWadNameNoPath(gMapInfo.Map);
 338   Map := g_ExtractFileName(gMapInfo.Map);
 339
 340   NetOut.Write(NetServerName);
 341
 342   NetOut.Write(Wad + ':\' + Map);
 343   NetOut.Write(gGameSettings.GameMode);
 344
 345   Cli := NetClientCount;
 346   NetOut.Write(Cli);
 347
 348   NetOut.Write(NetMaxClients);
 349
 350   NetOut.Write(Byte(NET_PROTOCOL_VER));
 351   NetOut.Write(Byte(NetPassword <> ''));
 352 end;
 353
 354 procedure g_Net_Slist_Update;
 355 var
 356
 357   P: pENetPacket;
 358
 359 begin
 360   if (NetMHost = nil) or (NetMPeer = nil) then Exit;
 361
 362   NetOut.Clear();
 363   NetOut.Write(Byte(NET_MMSG_UPD));
 364   NetOut.Write(NetAddr.port);
 365
 366   g_Net_Slist_WriteInfo();
 367
 368   P := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
 369   enet_peer_send(NetMPeer, NET_MCHAN_UPD, P);
 370
 371   enet_host_flush(NetMHost);
 372   NetOut.Clear();
 373 end;
 374
 375 procedure g_Net_Slist_Remove;
 376 var
 377   P: pENetPacket;
 378 begin
 379   if (NetMHost = nil) or (NetMPeer = nil) then Exit;
 380   NetOut.Clear();
 381   NetOut.Write(Byte(NET_MMSG_DEL));
 382   NetOut.Write(NetAddr.port);
 383
 384   P := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
 385   enet_peer_send(NetMPeer, NET_MCHAN_MAIN, P);
 386
 387   enet_host_flush(NetMHost);
 388   NetOut.Clear();
 389 end;
 390
 391 function g_Net_Slist_Connect: Boolean;
 392 begin
 393   Result := False;
 394
 395   NetMHost := enet_host_create(nil, 1, NET_MCHANS, 0, 0);
 396   if (NetMHost = nil) then
 397   begin
 398     g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
 399     Exit;
 400   end;
 401
 402   NetMPeer := enet_host_connect(NetMHost, @NetSlistAddr, NET_MCHANS, 0);
 403   if (NetMPeer = nil) then
 404   begin
 405     g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
 406     enet_host_destroy(NetMHost);
 407     NetMHost := nil;
 408     Exit;
 409   end;
 410
 411   if (enet_host_service(NetMHost, @NetMEvent, 3000) > 0) then
 412     if NetMEvent.kind = ENET_EVENT_TYPE_CONNECT then
 413     begin
 414       Result := True;
 415       g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_CONN]);
 416       Exit;
 417     end
 418     else
 419       if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
 420         enet_packet_destroy(NetMEvent.packet);
 421
 422   g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
 423
 424   NetMHost := nil;
 425   NetMPeer := nil;
 426 end;
 427
 428 procedure g_Net_Slist_Disconnect;
 429 begin
 430   if (NetMHost = nil) and (NetMPeer = nil) then Exit;
 431
 432   if NetMode = NET_SERVER then g_Net_Slist_Remove;
 433
 434   enet_peer_disconnect(NetMPeer, 0);
 435   enet_host_flush(NetMHost);
 436
 437   enet_peer_reset(NetMPeer);
 438   enet_host_destroy(NetMHost);
 439
 440   NetMPeer := nil;
 441   NetMHost := nil;
 442
 443   g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
 444 end;
 445
 446 procedure g_Net_Slist_Check;
 447 begin
 448   if (NetMHost = nil) or (NetMPeer = nil) then Exit;
 449
 450   while (enet_host_service(NetMHost, @NetMEvent, 0) > 0) do
 451   begin
 452     if NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT then
 453     begin
 454       g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_LOST], True);
 455       if NetMPeer <> nil then enet_peer_reset(NetMPeer);
 456       if NetMHost <> nil then enet_host_destroy(NetMHost);
 457       NetMPeer := nil;
 458       NetMHost := nil;
 459       Break;
 460     end
 461     else
 462       if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
 463         enet_packet_destroy(NetMEvent.packet);
 464   end;
 465 end;
 466
 467 procedure g_Net_Slist_Set(IP: string; Port: Word);
 468 begin
 469   if NetInitDone then
 470   begin
 471     enet_address_set_host(@NetSlistAddr, PChar(Addr(IP[1])));
 472     NetSlistAddr.Port := Port;
 473     e_WriteLog('Masterserver address set to ' + IP + ':' + IntToStr(Port), TMsgType.Notify);
 474   end;
 475 end;
 476
 477 function GetServerFromTable(Index: Integer; SL: TNetServerList; ST: TNetServerTable): TNetServer;
 478 begin
 479   if ST = nil then
 480     Exit;
 481   if (Index < 0) or (Index >= Length(ST)) then
 482     Exit;
 483   Result := SL[ST[Index].Indices[ST[Index].Current]];
 484 end;
 485
 486 procedure g_Serverlist_Draw(var SL: TNetServerList; var ST: TNetServerTable);
 487 var
 488   Srv: TNetServer;
 489   sy, i, y, mw, mx, l: Integer;
 490   cw: Byte = 0;
 491   ch: Byte = 0;
 492   ww: Word = 0;
 493   hh: Word = 0;
 494   ip: string;
 495 begin
 496   ip := '';
 497   sy := 0;
 498
 499   e_CharFont_GetSize(gMenuFont, _lc[I_NET_SLIST], ww, hh);
 500   e_CharFont_Print(gMenuFont, (gScreenWidth div 2) - (ww div 2), 16, _lc[I_NET_SLIST]);
 501
 502   e_TextureFontGetSize(gStdFont, cw, ch);
 503
 504   ip := _lc[I_NET_SLIST_HELP];
 505   mw := (Length(ip) * cw) div 2;
 506
 507   e_DrawFillQuad(16, 64, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
 508   e_DrawQuad(16, 64, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
 509
 510   e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
 511
 512   if SL = nil then
 513   begin
 514     l := Length(slWaitStr) div 2;
 515     e_DrawFillQuad(16, 64, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 128);
 516     e_DrawQuad(gScreenWidth div 2 - 192, gScreenHeight div 2 - 10,
 517       gScreenWidth div 2 + 192, gScreenHeight div 2 + 11, 255, 127, 0);
 518     e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - ch div 2,
 519       slWaitStr, gStdFont);
 520     Exit;
 521   end;
 522
 523   y := 90;
 524   if (slSelection < Length(ST)) then
 525   begin
 526     I := slSelection;
 527     sy := y + 42 * I - 4;
 528     Srv := GetServerFromTable(I, SL, ST);
 529     ip := _lc[I_NET_ADDRESS] + ' ' + Srv.IP + ':' + IntToStr(Srv.Port);
 530     if Srv.Password then
 531       ip := ip + '  ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_YES]
 532     else
 533       ip := ip + '  ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_NO];
 534   end else
 535     if Length(ST) > 0 then
 536       slSelection := 0;
 537
 538   mw := (gScreenWidth - 188);
 539   mx := 16 + mw;
 540
 541   e_DrawFillQuad(16 + 1, sy, gScreenWidth - 16 - 1, sy + 40, 64, 64, 64, 0);
 542   e_DrawLine(1, 16 + 1, sy, gScreenWidth - 16 - 1, sy, 205, 205, 205);
 543   e_DrawLine(1, 16 + 1, sy + 41, gScreenWidth - 16 - 1, sy + 41, 255, 255, 255);
 544
 545   e_DrawLine(1, 16, 85, gScreenWidth - 16, 85, 255, 127, 0);
 546   e_DrawLine(1, 16, gScreenHeight-64, gScreenWidth-16, gScreenHeight-64, 255, 127, 0);
 547
 548   e_DrawLine(1, mx - 70, 64, mx - 70, gScreenHeight-44, 255, 127, 0);
 549   e_DrawLine(1, mx, 64, mx, gScreenHeight-64, 255, 127, 0);
 550   e_DrawLine(1, mx + 52, 64, mx + 52, gScreenHeight-64, 255, 127, 0);
 551   e_DrawLine(1, mx + 104, 64, mx + 104, gScreenHeight-64, 255, 127, 0);
 552
 553   e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
 554
 555   y := 90;
 556   for I := 0 to High(ST) do
 557   begin
 558     Srv := GetServerFromTable(I, SL, ST);
 559     e_TextureFontPrintEx(18, y, Srv.Name, gStdFont, 255, 255, 255, 1);
 560     e_TextureFontPrintEx(18, y + 16, Srv.Map, gStdFont, 210, 210, 210, 1);
 561
 562     y := y + 42;
 563   end;
 564
 565   e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
 566   y := 90;
 567   for I := 0 to High(ST) do
 568   begin
 569     Srv := GetServerFromTable(I, SL, ST);
 570     if (Srv.Ping < 0) or (Srv.Ping > 999) then
 571       e_TextureFontPrintEx(mx - 68, y, _lc[I_NET_SLIST_NO_ACCESS], gStdFont, 255, 0, 0, 1)
 572     else
 573       if Srv.Ping = 0 then
 574         e_TextureFontPrintEx(mx - 68, y, '<1' + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1)
 575       else
 576         e_TextureFontPrintEx(mx - 68, y, IntToStr(Srv.Ping) + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1);
 577
 578     if Length(ST[I].Indices) > 1 then
 579       e_TextureFontPrintEx(mx - 68, y + 16, '< ' + IntToStr(Length(ST[I].Indices)) + ' >', gStdFont, 210, 210, 210, 1);
 580
 581     y := y + 42;
 582   end;
 583
 584   e_TextureFontPrintEx(mx + 2, 68, 'MODE', gStdFont, 255, 127, 0, 1);
 585   y := 90;
 586   for I := 0 to High(ST) do
 587   begin
 588     Srv := GetServerFromTable(I, SL, ST);
 589     e_TextureFontPrintEx(mx + 2, y, g_Game_ModeToText(Srv.GameMode), gStdFont, 255, 255, 255, 1);
 590
 591     y := y + 42;
 592   end;
 593
 594   e_TextureFontPrintEx(mx + 54, 68, 'PLRS', gStdFont, 255, 127, 0, 1);
 595   y := 90;
 596   for I := 0 to High(ST) do
 597   begin
 598     Srv := GetServerFromTable(I, SL, ST);
 599     e_TextureFontPrintEx(mx + 54, y, IntToStr(Srv.Players) + '/' + IntToStr(Srv.MaxPlayers), gStdFont, 255, 255, 255, 1);
 600     e_TextureFontPrintEx(mx + 54, y + 16, IntToStr(Srv.LocalPl) + '+' + IntToStr(Srv.Bots), gStdFont, 210, 210, 210, 1);
 601     y := y + 42;
 602   end;
 603
 604   e_TextureFontPrintEx(mx + 106, 68, 'VER', gStdFont, 255, 127, 0, 1);
 605   y := 90;
 606   for I := 0 to High(ST) do
 607   begin
 608     Srv := GetServerFromTable(I, SL, ST);
 609     e_TextureFontPrintEx(mx + 106, y, IntToStr(Srv.Protocol), gStdFont, 255, 255, 255, 1);
 610
 611     y := y + 42;
 612   end;
 613
 614   e_TextureFontPrintEx(20, gScreenHeight-61, ip, gStdFont, 205, 205, 205, 1);
 615   ip := IntToStr(Length(ST)) + _lc[I_NET_SLIST_SERVERS];
 616   e_TextureFontPrintEx(gScreenWidth - 48 - (Length(ip) + 1)*cw,
 617     gScreenHeight-61, ip, gStdFont, 205, 205, 205, 1);
 618 end;
 619
 620 procedure g_Serverlist_GenerateTable(SL: TNetServerList; var ST: TNetServerTable);
 621 var
 622   i, j: Integer;
 623
 624   function FindServerInTable(Name: string): Integer;
 625   var
 626     i: Integer;
 627   begin
 628     Result := -1;
 629     if ST = nil then
 630       Exit;
 631     for i := Low(ST) to High(ST) do
 632     begin
 633       if Length(ST[i].Indices) = 0 then
 634         continue;
 635       if SL[ST[i].Indices[0]].Name = Name then
 636       begin
 637         Result := i;
 638         Exit;
 639       end;
 640     end;
 641   end;
 642   function ComparePing(i1, i2: Integer): Boolean;
 643   var
 644     p1, p2: Int64;
 645   begin
 646     p1 := SL[i1].Ping;
 647     p2 := SL[i2].Ping;
 648     if (p1 < 0) then p1 := 999;
 649     if (p2 < 0) then p2 := 999;
 650     Result := p1 > p2;
 651   end;
 652   procedure SortIndices(var ind: Array of Integer);
 653   var
 654     I, J: Integer;
 655     T: Integer;
 656   begin
 657     for I := High(ind) downto Low(ind) do
 658       for J := Low(ind) to High(ind) - 1 do
 659         if ComparePing(ind[j], ind[j+1]) then
 660         begin
 661           T := ind[j];
 662           ind[j] := ind[j+1];
 663           ind[j+1] := T;
 664         end;
 665   end;
 666   procedure SortRows();
 667   var
 668     I, J: Integer;
 669     T: TNetServerRow;
 670   begin
 671     for I := High(ST) downto Low(ST) do
 672       for J := Low(ST) to High(ST) - 1 do
 673         if ComparePing(ST[j].Indices[0], ST[j+1].Indices[0]) then
 674         begin
 675           T := ST[j];
 676           ST[j] := ST[j+1];
 677           ST[j+1] := T;
 678         end;
 679   end;
 680 begin
 681   ST := nil;
 682   if SL = nil then
 683     Exit;
 684   for i := Low(SL) to High(SL) do
 685   begin
 686     j := FindServerInTable(SL[i].Name);
 687     if j = -1 then
 688     begin
 689       j := Length(ST);
 690       SetLength(ST, j + 1);
 691       ST[j].Current := 0;
 692       SetLength(ST[j].Indices, 1);
 693       ST[j].Indices[0] := i;
 694     end
 695     else
 696     begin
 697       SetLength(ST[j].Indices, Length(ST[j].Indices) + 1);
 698       ST[j].Indices[High(ST[j].Indices)] := i;
 699     end;
 700   end;
 701
 702   for i := Low(ST) to High(ST) do
 703     SortIndices(ST[i].Indices);
 704
 705   SortRows();
 706 end;
 707
 708 procedure g_Serverlist_Control(var SL: TNetServerList; var ST: TNetServerTable);
 709 var
 710   qm: Boolean;
 711   Srv: TNetServer;
 712 begin
 713   if gConsoleShow or gChatShow then
 714     Exit;
 715
 716   qm := g_ProcessMessages(); // this updates kbd
 717
 718   if qm or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) then
 719   begin
 720     SL := nil;
 721     ST := nil;
 722     gState := STATE_MENU;
 723     g_GUI_ShowWindow('MainMenu');
 724     g_GUI_ShowWindow('NetGameMenu');
 725     g_GUI_ShowWindow('NetClientMenu');
 726     g_Sound_PlayEx(WINDOW_CLOSESOUND);
 727     Exit;
 728   end;
 729
 730   if e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_JUMP) then
 731   begin
 732     if not slFetched then
 733     begin
 734       slWaitStr := _lc[I_NET_SLIST_WAIT];
 735
 736       g_Game_Draw;
 737       g_window.ReDrawWindow;
 738
 739       if g_Net_Slist_Fetch(SL) then
 740       begin
 741         if SL = nil then
 742           slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
 743       end
 744       else
 745         if SL = nil then
 746           slWaitStr := _lc[I_NET_SLIST_ERROR];
 747       slFetched := True;
 748       slSelection := 0;
 749       g_Serverlist_GenerateTable(SL, ST);
 750     end;
 751   end
 752   else
 753     slFetched := False;
 754
 755   if SL = nil then Exit;
 756
 757   if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) then
 758   begin
 759     if not slReturnPressed then
 760     begin
 761       Srv := GetServerFromTable(slSelection, SL, ST);
 762       if Srv.Password then
 763       begin
 764         PromptIP := Srv.IP;
 765         PromptPort := Srv.Port;
 766         gState := STATE_MENU;
 767         g_GUI_ShowWindow('ClientPasswordMenu');
 768         SL := nil;
 769         ST := nil;
 770         slReturnPressed := True;
 771         Exit;
 772       end
 773       else
 774         g_Game_StartClient(Srv.IP, Srv.Port, '');
 775       SL := nil;
 776       ST := nil;
 777       slReturnPressed := True;
 778       Exit;
 779     end;
 780   end
 781   else
 782     slReturnPressed := False;
 783
 784   if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) or e_KeyPressed(VK_DOWN) then
 785   begin
 786     if not slDirPressed then
 787     begin
 788       Inc(slSelection);
 789       if slSelection > High(ST) then slSelection := 0;
 790       slDirPressed := True;
 791     end;
 792   end;
 793
 794   if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) or e_KeyPressed(VK_UP) then
 795   begin
 796     if not slDirPressed then
 797     begin
 798       if slSelection = 0 then slSelection := Length(ST);
 799       Dec(slSelection);
 800
 801       slDirPressed := True;
 802     end;
 803   end;
 804
 805   if e_KeyPressed(IK_RIGHT) or e_KeyPressed(IK_KPRIGHT) or e_KeyPressed(VK_RIGHT) then
 806   begin
 807     if not slDirPressed then
 808     begin
 809       Inc(ST[slSelection].Current);
 810       if ST[slSelection].Current > High(ST[slSelection].Indices) then ST[slSelection].Current := 0;
 811       slDirPressed := True;
 812     end;
 813   end;
 814
 815   if e_KeyPressed(IK_LEFT) or e_KeyPressed(IK_KPLEFT) or e_KeyPressed(VK_LEFT) then
 816   begin
 817     if not slDirPressed then
 818     begin
 819       if ST[slSelection].Current = 0 then ST[slSelection].Current := Length(ST[slSelection].Indices);
 820       Dec(ST[slSelection].Current);
 821
 822       slDirPressed := True;
 823     end;
 824   end;
 825
 826   if (not e_KeyPressed(IK_DOWN)) and
 827      (not e_KeyPressed(IK_UP)) and
 828      (not e_KeyPressed(IK_RIGHT)) and
 829      (not e_KeyPressed(IK_LEFT)) and
 830      (not e_KeyPressed(IK_KPDOWN)) and
 831      (not e_KeyPressed(IK_KPUP)) and
 832      (not e_KeyPressed(IK_KPRIGHT)) and
 833      (not e_KeyPressed(IK_KPLEFT)) and
 834      (not e_KeyPressed(VK_DOWN)) and
 835      (not e_KeyPressed(VK_UP)) and
 836      (not e_KeyPressed(VK_RIGHT)) and
 837      (not e_KeyPressed(VK_LEFT)) then
 838     slDirPressed := False;
 839 end;
 840
 841 end.