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