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
  21   ENet, SysUtils, e_msg;
  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: AnsiString;
  38     IP: AnsiString;
  39     Port: Word;
  40     Map: AnsiString;
  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 type
  58   TMasterHost = record
  59   public
  60     hostName: AnsiString;
  61     hostPort: Word;
  62
  63   public
  64     peer: pENetPeer;
  65     enetAddr: ENetAddress;
  66     // inside the game, calling `connect()` is disasterous, as it is blocking.
  67     // so we'll use this variable to indicate if "connected" event is received.
  68     NetHostConnected: Boolean;
  69     NetHostConReqTime: Int64; // to timeout `connect`; -1 means "waiting for shutdown"
  70     NetUpdatePending: Boolean; // should we send an update after connection completes?
  71     lastConnectTime: Int64;
  72     updateSent: Boolean;
  73     lastUpdateTime: Int64;
  74     // server list request working flags
  75     srvAnswered: Integer;
  76     srvAnswer: array of TNetServer;
  77     slMOTD: AnsiString;
  78     slUrgent: AnsiString;
  79     slReadUrgent: Boolean;
  80
  81   private
  82     netmsg: TMsg;
  83
  84   public
  85     constructor Create (hostandport: AnsiString);
  86
  87     procedure clear ();
  88
  89     function setAddress (hostandport: AnsiString): Boolean;
  90
  91     function isSameAddress (hostandport: AnsiString): Boolean;
  92
  93     function isValid (): Boolean;
  94     function isAlive (): Boolean; // not disconnected
  95     function isConnecting (): Boolean; // is connection in progress?
  96     function isConnected (): Boolean;
  97
  98     // call as often as you want, the object will do the rest
  99     // but try to call this at least once in 100 msecs
 100     procedure pulse ();
 101
 102     procedure disconnect (forced: Boolean);
 103     function connect (): Boolean;
 104
 105     procedure update ();
 106     procedure remove ();
 107
 108     class procedure writeInfo (var msg: TMsg); static;
 109
 110     procedure connectedEvent ();
 111     procedure disconnectedEvent ();
 112     procedure receivedEvent (pkt: pENetPacket); // `pkt` is never `nil`
 113   end;
 114
 115
 116 var
 117   slCurrent:       TNetServerList = nil;
 118   slTable:         TNetServerTable = nil;
 119   slWaitStr:       AnsiString = '';
 120   slReturnPressed: Boolean = True;
 121
 122   slMOTD: AnsiString = '';
 123   slUrgent: AnsiString = '';
 124
 125
 126 procedure g_Net_Slist_Set (IP: AnsiString; Port: Word);
 127 function g_Net_Slist_Fetch (var SL: TNetServerList): Boolean;
 128
 129 // make this server private
 130 procedure g_Net_Slist_Private ();
 131 // make this server public
 132 procedure g_Net_Slist_Public ();
 133
 134 // called while the server is running
 135 procedure g_Net_Slist_ServerUpdate ();
 136 // called when the server is started
 137 procedure g_Net_Slist_ServerStarted ();
 138 // called when the server is stopped
 139 procedure g_Net_Slist_ServerClosed ();
 140
 141 // called when new netword player comes
 142 procedure g_Net_Slist_ServerPlayerComes ();
 143 // called when new netword player comes
 144 procedure g_Net_Slist_ServerPlayerLeaves ();
 145 // started new map
 146 procedure g_Net_Slist_ServerMapStarted ();
 147 // this server renamed (or password mode changed, or other params changed)
 148 procedure g_Net_Slist_ServerRenamed ();
 149
 150 procedure g_Net_Slist_Pulse (timeout: Integer=0);
 151
 152 procedure g_Net_Slist_ShutdownAll ();
 153
 154 procedure g_Serverlist_GenerateTable (SL: TNetServerList; var ST: TNetServerTable);
 155 procedure g_Serverlist_Draw (var SL: TNetServerList; var ST: TNetServerTable);
 156 procedure g_Serverlist_Control (var SL: TNetServerList; var ST: TNetServerTable);
 157
 158 function GetTimerMS (): Int64;
 159
 160
 161 implementation
 162
 163 uses
 164   e_input, e_graphics, e_log, g_window, g_net, g_console,
 165   g_map, g_game, g_sound, g_gui, g_menu, g_options, g_language, g_basic,
 166   wadreader, g_system, utils;
 167
 168 // ////////////////////////////////////////////////////////////////////////// //
 169 var
 170   NetMHost: pENetHost = nil;
 171   NetMEvent: ENetEvent;
 172   mlist: array of TMasterHost = nil;
 173
 174   slSelection: Byte = 0;
 175   slFetched: Boolean = False;
 176   slDirPressed: Boolean = False;
 177   slReadUrgent: Boolean = False;
 178
 179   reportsEnabled: Boolean = true;
 180
 181
 182 //==========================================================================
 183 //
 184 //  GetTimerMS
 185 //
 186 //==========================================================================
 187 function GetTimerMS (): Int64;
 188 begin
 189   Result := sys_GetTicks() {div 1000};
 190 end;
 191
 192
 193 //==========================================================================
 194 //
 195 //  findByPeer
 196 //
 197 //==========================================================================
 198 function findByPeer (peer: pENetPeer): Integer;
 199 var
 200   f: Integer;
 201 begin
 202   for f := 0 to High(mlist) do if (mlist[f].peer = peer) then begin result := f; exit; end;
 203   result := -1;
 204 end;
 205
 206
 207 //==========================================================================
 208 //
 209 //  ShutdownAll
 210 //
 211 //==========================================================================
 212 procedure g_Net_Slist_ShutdownAll ();
 213 var
 214   f, sres, idx: Integer;
 215   stt, ct: Int64;
 216   activeCount: Integer = 0;
 217 begin
 218   if (NetMHost = nil) then exit;
 219   for f := 0 to High(mlist) do
 220   begin
 221     if (mlist[f].isAlive()) then
 222     begin
 223       Inc(activeCount);
 224       if (mlist[f].isConnected() and mlist[f].updateSent) then
 225       begin
 226         writeln('unregistering from ', f);
 227         mlist[f].remove();
 228       end;
 229       //mlist[f].disconnect(false);
 230       enet_peer_disconnect_later(mlist[f].peer, 0);
 231     end;
 232   end;
 233   if (activeCount = 0) then exit;
 234   stt := GetTimerMS();
 235   while (activeCount > 0) do
 236   begin
 237     ct := GetTimerMS();
 238     if (ct < stt) or (ct-stt >= 1500) then break;
 239
 240     sres := enet_host_service(NetMHost, @NetMEvent, 100);
 241     if (sres < 0) then break;
 242     if (sres = 0) then continue;
 243
 244     idx := findByPeer(NetMEvent.peer);
 245     if (idx < 0) then
 246     begin
 247       if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then enet_packet_destroy(NetMEvent.packet);
 248       continue;
 249     end;
 250
 251     if (NetMEvent.kind = ENET_EVENT_TYPE_CONNECT) then
 252     begin
 253       mlist[idx].connectedEvent();
 254       //mlist[idx].disconnect(false);
 255       enet_peer_disconnect(mlist[f].peer, 0);
 256     end
 257     else if (NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
 258     begin
 259       mlist[idx].disconnectedEvent();
 260       Dec(activeCount);
 261     end
 262     else if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
 263     begin
 264       mlist[idx].receivedEvent(NetMEvent.packet);
 265       enet_packet_destroy(NetMEvent.packet);
 266     end;
 267   end;
 268   enet_host_destroy(NetMHost);
 269   NetMHost := nil;
 270 end;
 271
 272
 273 //==========================================================================
 274 //
 275 //  DisconnectAll
 276 //
 277 //==========================================================================
 278 procedure DisconnectAll ();
 279 var
 280   f: Integer;
 281 begin
 282   for f := 0 to High(mlist) do
 283   begin
 284     if (mlist[f].isAlive()) then mlist[f].disconnect(false);
 285   end;
 286 end;
 287
 288
 289 //==========================================================================
 290 //
 291 //  ConnectAll
 292 //
 293 //==========================================================================
 294 procedure ConnectAll (sendUpdate: Boolean);
 295 var
 296   f: Integer;
 297 begin
 298   for f := 0 to High(mlist) do
 299   begin
 300     // force reconnect
 301     mlist[f].lastConnectTime := 0;
 302     //if (not mlist[f].isAlive()) then continue;
 303     // force updating
 304     if (sendUpdate) then
 305     begin
 306       mlist[f].NetUpdatePending := true;
 307       mlist[f].lastUpdateTime := 0;
 308     end;
 309   end;
 310 end;
 311
 312
 313 //==========================================================================
 314 //
 315 //  UpdateAll
 316 //
 317 //==========================================================================
 318 procedure UpdateAll (force: Boolean);
 319 var
 320   f: Integer;
 321 begin
 322   for f := 0 to High(mlist) do
 323   begin
 324     if (not mlist[f].isAlive()) then continue;
 325     mlist[f].NetUpdatePending := true;
 326     if (force) then mlist[f].lastUpdateTime := 0;
 327   end;
 328 end;
 329
 330
 331 //**************************************************************************
 332 //
 333 // public api
 334 //
 335 //**************************************************************************
 336
 337 //==========================================================================
 338 //
 339 //  g_Net_Slist_Private
 340 //
 341 //  make this server private
 342 //
 343 //==========================================================================
 344 procedure g_Net_Slist_Private ();
 345 begin
 346   DisconnectAll();
 347   reportsEnabled := false;
 348 end;
 349
 350
 351 //==========================================================================
 352 //
 353 //  g_Net_Slist_Public
 354 //
 355 //  make this server public
 356 //
 357 //==========================================================================
 358 procedure g_Net_Slist_Public ();
 359 begin
 360   if (not reportsEnabled) then
 361   begin
 362     reportsEnabled := true;
 363     ConnectAll(true);
 364   end;
 365 end;
 366
 367
 368 //==========================================================================
 369 //
 370 //  g_Net_Slist_ServerUpdate
 371 //
 372 //  called while the server is running
 373 //
 374 //==========================================================================
 375 procedure g_Net_Slist_ServerUpdate ();
 376 begin
 377   UpdateAll(false);
 378 end;
 379
 380
 381 // called when the server is started
 382 procedure g_Net_Slist_ServerStarted ();
 383 begin
 384   reportsEnabled := NetUseMaster;
 385   if reportsEnabled and g_Game_IsServer() and g_Game_IsNet() then
 386   begin
 387     writeln('*** server started; reporting to master...');
 388     ConnectAll(true);
 389   end;
 390 end;
 391
 392
 393 //==========================================================================
 394 //
 395 //  g_Net_Slist_ServerClosed
 396 //
 397 //  called when the server is stopped
 398 //
 399 //==========================================================================
 400 procedure g_Net_Slist_ServerClosed ();
 401 var
 402   f: Integer;
 403 begin
 404   if reportsEnabled then
 405   begin
 406     reportsEnabled := false;
 407     for f := 0 to High(mlist) do
 408     begin
 409       if (mlist[f].isConnected()) then mlist[f].remove();
 410     end;
 411   end;
 412   DisconnectAll();
 413 end;
 414
 415
 416 //==========================================================================
 417 //
 418 //  g_Net_Slist_ServerPlayerComes
 419 //
 420 //  called when new netword player comes
 421 //
 422 //==========================================================================
 423 procedure g_Net_Slist_ServerPlayerComes ();
 424 begin
 425   UpdateAll(true);
 426 end;
 427
 428
 429 //==========================================================================
 430 //
 431 //  g_Net_Slist_ServerPlayerLeaves
 432 //
 433 //  called when new netword player comes
 434 //
 435 //==========================================================================
 436 procedure g_Net_Slist_ServerPlayerLeaves ();
 437 begin
 438   UpdateAll(true);
 439 end;
 440
 441
 442 //==========================================================================
 443 //
 444 //  g_Net_Slist_ServerMapStarted
 445 //
 446 //  started new map
 447 //
 448 //==========================================================================
 449 procedure g_Net_Slist_ServerMapStarted ();
 450 begin
 451   UpdateAll(true);
 452 end;
 453
 454
 455 //==========================================================================
 456 //
 457 //  g_Net_Slist_ServerRenamed
 458 //
 459 //  this server renamed (or password mode changed, or other params changed)
 460 //
 461 //==========================================================================
 462 procedure g_Net_Slist_ServerRenamed ();
 463 begin
 464   UpdateAll(true);
 465 end;
 466
 467
 468 //**************************************************************************
 469 //
 470 // TMasterHost
 471 //
 472 //**************************************************************************
 473
 474 //==========================================================================
 475 //
 476 //  TMasterHost.Create
 477 //
 478 //==========================================================================
 479 constructor TMasterHost.Create (hostandport: AnsiString);
 480 begin
 481   peer := nil;
 482   NetHostConnected := false;
 483   NetHostConReqTime := 0;
 484   NetUpdatePending := false;
 485   lastConnectTime := 0;
 486   updateSent := false;
 487   lastUpdateTime := 0;
 488   hostName := '';
 489   hostPort := 25665;
 490   SetLength(srvAnswer, 0);
 491   srvAnswered := 0;
 492   slMOTD := '';
 493   slUrgent := '';
 494   slReadUrgent := true;
 495   netmsg.Alloc(NET_BUFSIZE);
 496   setAddress(hostandport);
 497 end;
 498
 499
 500 //==========================================================================
 501 //
 502 //  TMasterHost.clear
 503 //
 504 //==========================================================================
 505 procedure TMasterHost.clear ();
 506 begin
 507   updateSent := false; // do not send 'remove'
 508   disconnect(true);
 509   hostName := '';
 510   hostPort := 25665;
 511   netmsg.Free();
 512   SetLength(srvAnswer, 0);
 513   srvAnswered := 0;
 514   slMOTD := '';
 515   slUrgent := '';
 516   slReadUrgent := true;
 517 end;
 518
 519
 520 //==========================================================================
 521 //
 522 //  TMasterHost.isSameAddress
 523 //
 524 //==========================================================================
 525 function TMasterHost.isSameAddress (hostandport: AnsiString): Boolean;
 526 var
 527   cp, pp: Integer;
 528   hn: AnsiString;
 529 begin
 530   result := false;
 531   if not isValid() then exit;
 532   hostandport := Trim(hostandport);
 533   if (length(hostandport) = 0) then exit;
 534   hn := hostandport;
 535   cp := Pos(':', hostandport);
 536   if (cp > 0) then
 537   begin
 538     hn := Copy(hostandport, 1, cp-1);
 539     Delete(hostandport, 1, cp);
 540     if (length(hostandport) > 0) then
 541     begin
 542       try
 543         pp := StrToInt(hostandport);
 544       except
 545         pp := -1;
 546       end;
 547     end;
 548   end
 549   else
 550   begin
 551     pp := 25665;
 552   end;
 553   result := strEquCI1251(hn, hostName) and (hostPort = pp);
 554 end;
 555
 556
 557 //==========================================================================
 558 //
 559 //  TMasterHost.setAddress
 560 //
 561 //==========================================================================
 562 function TMasterHost.setAddress (hostandport: AnsiString): Boolean;
 563 var
 564   cp, pp: Integer;
 565 begin
 566   result := false;
 567   SetLength(srvAnswer, 0);
 568   srvAnswered := 0;
 569   slMOTD := '';
 570   slUrgent := '';
 571   slReadUrgent := true;
 572   updateSent := false; // do not send 'remove'
 573   disconnect(true);
 574   hostName := '';
 575   hostPort := 25665;
 576
 577   if (not g_Net_IsNetworkAvailable()) then exit;
 578
 579   hostandport := Trim(hostandport);
 580   if (length(hostandport) > 0) then
 581   begin
 582       hostName := hostandport;
 583     cp := Pos(':', hostandport);
 584     if (cp > 0) then
 585     begin
 586       hostName := Copy(hostandport, 1, cp-1);
 587       Delete(hostandport, 1, cp);
 588       if (length(hostandport) > 0) then
 589       begin
 590         try
 591           pp := StrToInt(hostandport);
 592         except
 593           pp := -1;
 594         end;
 595         if (pp > 0) and (pp < 65536) then hostPort := pp else hostPort := 0;
 596       end;
 597     end;
 598   end;
 599
 600   if not isValid() then exit;
 601
 602   if (enet_address_set_host(@enetAddr, PChar(Addr(hostName[1]))) <> 0) then
 603   begin
 604     writeln('SHIT!');
 605     hostName := '';
 606     hostPort := 0;
 607   end;
 608   enetAddr.Port := hostPort;
 609
 610   result := isValid();
 611   //writeln('*********************: ', hostandport, ' [', hostName, ':', hostPort, '] ', result);
 612 end;
 613
 614
 615 //==========================================================================
 616 //
 617 //  TMasterHost.isValid
 618 //
 619 //==========================================================================
 620 function TMasterHost.isValid (): Boolean;
 621 begin
 622   result := (length(hostName) > 0) and (hostPort > 0);
 623 end;
 624
 625
 626 //==========================================================================
 627 //
 628 //  TMasterHost.isAlive
 629 //
 630 //  not disconnected
 631 //
 632 //==========================================================================
 633 function TMasterHost.isAlive (): Boolean;
 634 begin
 635   result := (NetMHost <> nil) and (peer <> nil);
 636 end;
 637
 638
 639 //==========================================================================
 640 //
 641 //  TMasterHost.isConnecting
 642 //
 643 //  is connection in progress?
 644 //
 645 //==========================================================================
 646 function TMasterHost.isConnecting (): Boolean;
 647 begin
 648   result := isAlive() and (not NetHostConnected) and (NetHostConReqTime <> -1);
 649 end;
 650
 651
 652 //==========================================================================
 653 //
 654 //  TMasterHost.isConnected
 655 //
 656 //==========================================================================
 657 function TMasterHost.isConnected (): Boolean;
 658 begin
 659   result := isAlive() and (NetHostConnected) and (NetHostConReqTime <> -1);
 660 end;
 661
 662
 663 //==========================================================================
 664 //
 665 //  TMasterHost.connectedEvent
 666 //
 667 //==========================================================================
 668 procedure TMasterHost.connectedEvent ();
 669 begin
 670   if not isAlive() then exit;
 671   if NetHostConnected then exit;
 672   NetHostConnected := true;
 673   e_LogWritefln('connected to master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
 674 end;
 675
 676
 677 //==========================================================================
 678 //
 679 //  TMasterHost.disconnectedEvent
 680 //
 681 //==========================================================================
 682 procedure TMasterHost.disconnectedEvent ();
 683 begin
 684   if not isAlive() then exit;
 685   e_LogWritefln('disconnected from master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
 686   disconnect(true);
 687   //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
 688 end;
 689
 690
 691 //==========================================================================
 692 //
 693 //  TMasterHost.receivedEvent
 694 //
 695 //  `pkt` is never `nil`
 696 //
 697 //==========================================================================
 698 procedure TMasterHost.receivedEvent (pkt: pENetPacket);
 699 var
 700   msg: TMsg;
 701   MID: Byte;
 702   Cnt: Byte;
 703   f: Integer;
 704   s: AnsiString;
 705 begin
 706   e_LogWritefln('received packed from master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
 707   if not msg.Init(pkt^.data, pkt^.dataLength, True) then exit;
 708   // packet type
 709   MID := msg.ReadByte();
 710   if (MID <> NET_MMSG_GET) then exit;
 711   e_LogWritefln('received list packet from master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
 712   SetLength(srvAnswer, 0);
 713   if (srvAnswered > 0) then Inc(srvAnswered);
 714   slMOTD := '';
 715   //slUrgent := '';
 716   slReadUrgent := true;
 717   // number of items
 718   Cnt := msg.ReadByte();
 719   g_Console_Add(_lc[I_NET_MSG]+Format(_lc[I_NET_SLIST_RETRIEVED], [Cnt]), True);
 720   if (Cnt > 0) then
 721   begin
 722     SetLength(srvAnswer, Cnt);
 723     for f := 0 to Cnt-1 do
 724     begin
 725       srvAnswer[f].Number := f;
 726       srvAnswer[f].IP := msg.ReadString();
 727       srvAnswer[f].Port := msg.ReadWord();
 728       srvAnswer[f].Name := msg.ReadString();
 729       srvAnswer[f].Map := msg.ReadString();
 730       srvAnswer[f].GameMode := msg.ReadByte();
 731       srvAnswer[f].Players := msg.ReadByte();
 732       srvAnswer[f].MaxPlayers := msg.ReadByte();
 733       srvAnswer[f].Protocol := msg.ReadByte();
 734       srvAnswer[f].Password := msg.ReadByte() = 1;
 735       enet_address_set_host(Addr(srvAnswer[f].PingAddr), PChar(Addr(srvAnswer[f].IP[1])));
 736       srvAnswer[f].Ping := -1;
 737       srvAnswer[f].PingAddr.port := NET_PING_PORT;
 738     end;
 739   end;
 740
 741   if (msg.ReadCount < msg.CurSize) then
 742   begin
 743     // new master, supports version reports
 744     s := msg.ReadString();
 745     if (s <> {MyVer}GAME_VERSION) then
 746     begin
 747       { TODO }
 748       g_Console_Add('!!! UpdVer = `'+s+'`');
 749     end;
 750     // even newer master, supports extra info
 751     if (msg.ReadCount < msg.CurSize) then
 752     begin
 753       slMOTD := b_Text_Format(msg.ReadString());
 754       s := b_Text_Format(msg.ReadString());
 755       // check if the message has updated and the user has to read it again
 756       if (slUrgent <> s) then slReadUrgent := false;
 757       slUrgent := s;
 758     end;
 759   end;
 760 end;
 761
 762
 763 //==========================================================================
 764 //
 765 //  TMasterHost.pulse
 766 //
 767 //  this performs various scheduled tasks, if necessary
 768 //
 769 //==========================================================================
 770 procedure TMasterHost.pulse ();
 771 var
 772   ct: Int64;
 773   mrate: Cardinal;
 774 begin
 775   if not isAlive() then exit;
 776   if (NetHostConReqTime = -1) then exit; // waiting for shutdown (disconnect in progress)
 777   ct := GetTimerMS();
 778   // process pending connection timeout
 779   if (not NetHostConnected) then
 780   begin
 781     if (ct < NetHostConReqTime) or (ct-NetHostConReqTime >= 3000) then
 782     begin
 783       e_LogWritefln('failed to connect to master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
 784       // do not spam with error messages, it looks like the master is down
 785       //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
 786       enet_peer_disconnect(peer, 0);
 787       // main pulse will take care of the rest
 788     end;
 789     exit;
 790   end;
 791   // send update, if necessary
 792   if (NetUpdatePending) then
 793   begin
 794     mrate := NetMasterRate;
 795          if (mrate < 10000) then mrate := 10000
 796     else if (mrate > 1000*60*10) then mrate := 1000*60*10;
 797     if (lastUpdateTime = 0) or (ct < lastUpdateTime) or (ct-lastUpdateTime >= mrate) then
 798     begin
 799       lastUpdateTime := ct;
 800       update();
 801     end;
 802   end;
 803 end;
 804
 805
 806 //==========================================================================
 807 //
 808 //  TMasterHost.disconnect
 809 //
 810 //==========================================================================
 811 procedure TMasterHost.disconnect (forced: Boolean);
 812 begin
 813   if not isAlive() then exit;
 814
 815   if (forced) then
 816   begin
 817     enet_peer_reset(peer);
 818     peer := nil;
 819     NetHostConReqTime := 0;
 820   end
 821   else
 822   begin
 823     enet_peer_disconnect_later(peer, 0);
 824     // main pulse will take care of the rest
 825     NetHostConReqTime := -1;
 826   end;
 827
 828   NetHostConnected := false;
 829   NetUpdatePending := false;
 830   //updateSent := false;
 831   lastUpdateTime := 0;
 832   //lastConnectTime := 0;
 833   //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
 834 end;
 835
 836
 837 //==========================================================================
 838 //
 839 //  TMasterHost.connect
 840 //
 841 //==========================================================================
 842 function TMasterHost.connect (): Boolean;
 843 begin
 844   result := false;
 845   if not isValid() then exit;
 846   if (NetHostConReqTime = -1) then
 847   begin
 848     disconnect(true);
 849   end
 850   else
 851   begin
 852     if isAlive() then begin result := true; exit; end;
 853   end;
 854
 855   lastConnectTime := GetTimerMS();
 856   SetLength(srvAnswer, 0);
 857   srvAnswered := 0;
 858   NetHostConnected := false;
 859   NetHostConReqTime := 0;
 860   NetUpdatePending := false;
 861   updateSent := false;
 862   lastUpdateTime := 0;
 863
 864   peer := enet_host_connect(NetMHost, @enetAddr, NET_MCHANS, 0);
 865   if (peer = nil) then
 866   begin
 867     g_Console_Add(_lc[I_NET_MSG_ERROR]+_lc[I_NET_ERR_CLIENT], true);
 868     exit;
 869   end;
 870
 871   NetHostConReqTime := lastConnectTime;
 872   e_LogWritefln('connecting to master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
 873 end;
 874
 875
 876 //==========================================================================
 877 //
 878 //  TMasterHost.writeInfo
 879 //
 880 //==========================================================================
 881 class procedure TMasterHost.writeInfo (var msg: TMsg);
 882 var
 883   wad, map: AnsiString;
 884 begin
 885   wad := g_ExtractWadNameNoPath(gMapInfo.Map);
 886   map := g_ExtractFileName(gMapInfo.Map);
 887
 888   msg.Write(NetServerName);
 889
 890   msg.Write(wad+':/'+map);
 891   msg.Write(gGameSettings.GameMode);
 892
 893   msg.Write(Byte(NetClientCount));
 894
 895   msg.Write(NetMaxClients);
 896
 897   msg.Write(Byte(NET_PROTOCOL_VER));
 898   msg.Write(Byte(NetPassword <> ''));
 899 end;
 900
 901
 902 //==========================================================================
 903 //
 904 //  TMasterHost.update
 905 //
 906 //==========================================================================
 907 procedure TMasterHost.update ();
 908 var
 909   pkt: pENetPacket;
 910 begin
 911   if not isAlive() then exit;
 912   if not isConnected() then
 913   begin
 914     NetUpdatePending := isConnecting();
 915     exit;
 916   end;
 917
 918   netmsg.Clear();
 919
 920   if reportsEnabled and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster then
 921   begin
 922     try
 923       netmsg.Write(Byte(NET_MMSG_UPD));
 924       netmsg.Write(NetAddr.port);
 925
 926       writeInfo(netmsg);
 927
 928       pkt := enet_packet_create(netmsg.Data, netmsg.CurSize, ENET_PACKET_FLAG_RELIABLE);
 929       if assigned(pkt) then
 930       begin
 931         if (enet_peer_send(peer, NET_MCHAN_UPD, pkt) = 0) then
 932         begin
 933           e_LogWritefln('sent update to master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
 934           NetUpdatePending := false;
 935           updateSent := true;
 936         end;
 937       end;
 938     finally
 939       netmsg.Clear();
 940     end;
 941   end
 942   else
 943   begin
 944     NetUpdatePending := false;
 945   end;
 946 end;
 947
 948
 949 //==========================================================================
 950 //
 951 //  TMasterHost.remove
 952 //
 953 //==========================================================================
 954 procedure TMasterHost.remove ();
 955 var
 956   pkt: pENetPacket;
 957 begin
 958   NetUpdatePending := false;
 959   lastUpdateTime := 0;
 960   updateSent := false;
 961   if not isAlive() then exit;
 962   if not isConnected() then exit;
 963
 964   netmsg.Clear();
 965   try
 966     netmsg.Write(Byte(NET_MMSG_DEL));
 967     netmsg.Write(NetAddr.port);
 968
 969     pkt := enet_packet_create(netmsg.Data, netmsg.CurSize, ENET_PACKET_FLAG_RELIABLE);
 970     if assigned(pkt) then
 971     begin
 972       enet_peer_send(peer, NET_MCHAN_MAIN, pkt);
 973     end;
 974   finally
 975     netmsg.Clear();
 976   end;
 977 end;
 978
 979
 980 //**************************************************************************
 981 //
 982 // other functions
 983 //
 984 //**************************************************************************
 985
 986 procedure g_Net_Slist_Set (IP: AnsiString; Port: Word);
 987 var
 988   f: Integer;
 989   sa: AnsiString;
 990 begin
 991   if (not g_Net_IsNetworkAvailable()) then exit;
 992   IP := Trim(IP);
 993   if (length(IP) = 0) or (Port = 0) then exit;
 994   sa := IP+':'+IntToStr(Port);
 995   for f := 0 to High(mlist) do if (mlist[f].isSameAddress(sa)) then exit;
 996   SetLength(mlist, length(mlist)+1);
 997   mlist[High(mlist)].Create(sa);
 998   mlist[High(mlist)].setAddress(sa);
 999   e_LogWritefln('Masterserver address set to [%s:%u]', [IP, Port], TMsgType.Notify);
1000 end;
1001
1002
1003 //**************************************************************************
1004 //
1005 // main pulse
1006 //
1007 //**************************************************************************
1008 procedure g_Net_Slist_Pulse (timeout: Integer=0);
1009 var
1010   f: Integer;
1011   sres: Integer;
1012   idx: Integer;
1013   ct: Int64;
1014 begin
1015   if (not g_Net_IsNetworkAvailable()) then exit;
1016
1017   if (length(mlist) = 0) then
1018   begin
1019     if (NetMHost <> nil) then
1020     begin
1021       enet_host_destroy(NetMHost);
1022       NetMHost := nil;
1023       exit;
1024     end;
1025   end;
1026
1027   if (NetMHost = nil) then
1028   begin
1029     NetMHost := enet_host_create(nil, 1, NET_MCHANS, 0, 0);
1030     if (NetMHost = nil) then
1031     begin
1032       g_Console_Add(_lc[I_NET_MSG_ERROR]+_lc[I_NET_ERR_CLIENT], True);
1033       for f := 0 to High(mlist) do mlist[f].clear();
1034       SetLength(mlist, 0);
1035       Exit;
1036     end;
1037   end;
1038
1039   ct := GetTimerMS();
1040   for f := 0 to High(mlist) do
1041   begin
1042     if (not mlist[f].isValid()) then continue;
1043     if (not mlist[f].isAlive()) then
1044     begin
1045       if reportsEnabled and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster then
1046       begin
1047         if (mlist[f].lastConnectTime = 0) or (ct < mlist[f].lastConnectTime) or (ct-mlist[f].lastConnectTime >= 1000*60*5) then
1048         begin
1049           mlist[f].connect();
1050         end;
1051       end;
1052     end
1053     else
1054     begin
1055       if not reportsEnabled or not g_Game_IsServer() or not g_Game_IsNet() or not NetUseMaster then
1056       begin
1057         if (mlist[f].isConnected()) and (mlist[f].updateSent) then mlist[f].remove();
1058         mlist[f].disconnect(false);
1059       end;
1060     end;
1061     mlist[f].pulse();
1062   end;
1063
1064   while true do
1065   begin
1066     sres := enet_host_service(NetMHost, @NetMEvent, timeout);
1067     if (sres < 0) then
1068     begin
1069       g_Console_Add(_lc[I_NET_MSG_ERROR]+_lc[I_NET_ERR_CLIENT], True);
1070       for f := 0 to High(mlist) do mlist[f].clear();
1071       SetLength(mlist, 0);
1072       enet_host_destroy(NetMHost);
1073       NetMHost := nil;
1074       exit;
1075     end;
1076
1077     if (sres = 0) then break;
1078     idx := findByPeer(NetMEvent.peer);
1079     if (idx < 0) then
1080     begin
1081       e_LogWriteln('network event from unknown master host. ignored.', TMsgType.Warning);
1082       if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then enet_packet_destroy(NetMEvent.packet);
1083       continue;
1084     end;
1085
1086     if (NetMEvent.kind = ENET_EVENT_TYPE_CONNECT) then
1087     begin
1088       mlist[idx].connectedEvent();
1089     end
1090     else if (NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1091     begin
1092       mlist[idx].disconnectedEvent();
1093     end
1094     else if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1095     begin
1096       mlist[idx].receivedEvent(NetMEvent.packet);
1097       enet_packet_destroy(NetMEvent.packet);
1098     end;
1099   end;
1100 end;
1101
1102
1103 //**************************************************************************
1104 //
1105 // gui and server list
1106 //
1107 //**************************************************************************
1108
1109 //==========================================================================
1110 //
1111 //  PingServer
1112 //
1113 //==========================================================================
1114 procedure PingServer (var S: TNetServer; Sock: ENetSocket);
1115 var
1116   Buf: ENetBuffer;
1117   Ping: array [0..9] of Byte;
1118   ClTime: Int64;
1119 begin
1120   ClTime := GetTimerMS();
1121
1122   Buf.data := Addr(Ping[0]);
1123   Buf.dataLength := 2+8;
1124
1125   Ping[0] := Ord('D');
1126   Ping[1] := Ord('F');
1127   Int64(Addr(Ping[2])^) := ClTime;
1128
1129   enet_socket_send(Sock, Addr(S.PingAddr), @Buf, 1);
1130 end;
1131
1132
1133 //==========================================================================
1134 //
1135 //  PingBcast
1136 //
1137 //==========================================================================
1138 procedure PingBcast (Sock: ENetSocket);
1139 var
1140   S: TNetServer;
1141 begin
1142   S.IP := '255.255.255.255';
1143   S.Port := NET_PING_PORT;
1144   enet_address_set_host(Addr(S.PingAddr), PChar(Addr(S.IP[1])));
1145   S.Ping := -1;
1146   S.PingAddr.port := S.Port;
1147   PingServer(S, Sock);
1148 end;
1149
1150
1151 //==========================================================================
1152 //
1153 //  g_Net_Slist_Fetch
1154 //
1155 //==========================================================================
1156 function g_Net_Slist_Fetch (var SL: TNetServerList): Boolean;
1157 var
1158   Cnt: Byte;
1159   pkt: pENetPacket;
1160   I, RX: Integer;
1161   T: Int64;
1162   Sock: ENetSocket;
1163   Buf: ENetBuffer;
1164   InMsg: TMsg;
1165   SvAddr: ENetAddress;
1166   FromSL: Boolean;
1167   MyVer: AnsiString;
1168
1169   procedure ProcessLocal ();
1170   begin
1171     I := Length(SL);
1172     SetLength(SL, I + 1);
1173     with SL[I] do
1174     begin
1175       IP := DecodeIPV4(SvAddr.host);
1176       Port := InMsg.ReadWord();
1177       Ping := InMsg.ReadInt64();
1178       Ping := GetTimerMS() - Ping;
1179       Name := InMsg.ReadString();
1180       Map := InMsg.ReadString();
1181       GameMode := InMsg.ReadByte();
1182       Players := InMsg.ReadByte();
1183       MaxPlayers := InMsg.ReadByte();
1184       Protocol := InMsg.ReadByte();
1185       Password := InMsg.ReadByte() = 1;
1186       LocalPl := InMsg.ReadByte();
1187       Bots := InMsg.ReadWord();
1188     end;
1189   end;
1190
1191   procedure CheckLocalServers ();
1192   begin
1193     SetLength(SL, 0);
1194
1195     Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1196     if Sock = ENET_SOCKET_NULL then Exit;
1197     enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
1198     enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
1199     PingBcast(Sock);
1200
1201     T := GetTimerMS();
1202
1203     InMsg.Alloc(NET_BUFSIZE);
1204     Buf.data := InMsg.Data;
1205     Buf.dataLength := InMsg.MaxSize;
1206     while GetTimerMS() - T <= 500 do
1207     begin
1208       InMsg.Clear();
1209
1210       RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
1211       if RX <= 0 then continue;
1212       InMsg.CurSize := RX;
1213
1214       InMsg.BeginReading();
1215
1216       if InMsg.ReadChar() <> 'D' then continue;
1217       if InMsg.ReadChar() <> 'F' then continue;
1218
1219       ProcessLocal();
1220     end;
1221
1222     InMsg.Free();
1223     enet_socket_destroy(Sock);
1224
1225     if Length(SL) = 0 then SL := nil;
1226   end;
1227
1228 var
1229   f, c, n, pos: Integer;
1230   aliveCount: Integer;
1231   hasUnanswered: Boolean;
1232   stt, ct: Int64;
1233 begin
1234   result := false;
1235   SL := nil;
1236
1237   if (not g_Net_IsNetworkAvailable()) then
1238   begin
1239     SetLength(SL, 0);
1240     exit;
1241   end;
1242
1243   g_Net_Slist_Pulse(); // this will create mhost
1244
1245   NetOut.Clear();
1246   NetOut.Write(Byte(NET_MMSG_GET));
1247
1248   // TODO: what should we identify the build with?
1249   MyVer := GAME_VERSION;
1250   NetOut.Write(MyVer);
1251
1252   try
1253     e_WriteLog('Fetching serverlist...', TMsgType.Notify);
1254     g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_FETCH]);
1255
1256     // wait until all servers connected and answered
1257     stt := GetTimerMS();
1258     while true do
1259     begin
1260       g_Net_Slist_Pulse(300);
1261       aliveCount := 0;
1262       hasUnanswered := false;
1263       for f := 0 to High(mlist) do
1264       begin
1265         {
1266         e_LogWritefln('  master #%d: [%s:%u] valid=%d; alive=%d; connected=%d; connecting=%d',
1267           [f, mlist[f].hostName, mlist[f].hostPort, Integer(mlist[f].isValid()), Integer(mlist[f].isAlive()),
1268           Integer(mlist[f].isConnected()), Integer(mlist[f].isConnecting())], TMsgType.Notify);
1269         }
1270         if (not mlist[f].isValid()) then continue;
1271         if (not mlist[f].isAlive()) then
1272         begin
1273           mlist[f].connect();
1274           if (mlist[f].isAlive()) then
1275           begin
1276             hasUnanswered := true;
1277             stt := GetTimerMS();
1278           end;
1279         end
1280         else if (mlist[f].isConnected()) then
1281         begin
1282           if (mlist[f].srvAnswered = 0) then
1283           begin
1284             pkt := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
1285             if assigned(pkt) then
1286             begin
1287               if (enet_peer_send(mlist[f].peer, NET_MCHAN_MAIN, pkt) = 0) then
1288               begin
1289                 hasUnanswered := true;
1290                 mlist[f].srvAnswered := 1;
1291                 stt := GetTimerMS();
1292               end;
1293             end;
1294           end
1295           else if (mlist[f].srvAnswered = 1) then
1296           begin
1297             hasUnanswered := true;
1298           end
1299           else if (mlist[f].srvAnswered > 1) then
1300           begin
1301             Inc(aliveCount);
1302           end;
1303         end
1304         else if (mlist[f].isConnecting()) then
1305         begin
1306           hasUnanswered := true;
1307         end;
1308       end;
1309       if (not hasUnanswered) then break;
1310       // check for timeout
1311       ct := GetTimerMS();
1312       if (ct < stt) or (ct-stt > 4000) then break;
1313     end;
1314
1315     if (aliveCount = 0) then
1316     begin
1317       DisconnectAll();
1318       CheckLocalServers();
1319       exit;
1320     end;
1321
1322     slMOTD := '';
1323     {
1324     slUrgent := '';
1325     slReadUrgent := true;
1326     }
1327
1328     SetLength(SL, 0);
1329     for f := 0 to High(mlist) do
1330     begin
1331       if (mlist[f].srvAnswered < 2) then continue;
1332       for n := 0 to High(mlist[f].srvAnswer) do
1333       begin
1334         pos := -1;
1335         for c := 0 to High(SL) do
1336         begin
1337           if (SL[c].IP = mlist[f].srvAnswer[n].IP) and (SL[c].Port = mlist[f].srvAnswer[n].Port) then
1338           begin
1339             pos := c;
1340             break;
1341           end;
1342         end;
1343         if (pos < 0) then
1344         begin
1345           pos := length(SL);
1346           SetLength(SL, pos+1);
1347           SL[pos] := mlist[f].srvAnswer[n];
1348           SL[pos].Number := pos;
1349         end;
1350       end;
1351       if (not mlist[f].slReadUrgent) and (mlist[f].slUrgent <> '') then
1352       begin
1353         if (mlist[f].slUrgent <> slUrgent) then
1354         begin
1355           slUrgent := mlist[f].slUrgent;
1356           slReadUrgent := false;
1357         end;
1358       end;
1359       if (slMOTD <> '') and (mlist[f].slMOTD <> '') then
1360       begin
1361         slMOTD := mlist[f].slMOTD;
1362       end;
1363     end;
1364
1365     DisconnectAll();
1366
1367     if (length(SL) = 0) then
1368     begin
1369       CheckLocalServers();
1370       exit;
1371     end;
1372
1373     Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1374     if Sock = ENET_SOCKET_NULL then Exit;
1375     enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
1376
1377     for I := Low(SL) to High(SL) do PingServer(SL[I], Sock);
1378
1379     enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
1380     PingBcast(Sock);
1381
1382     T := GetTimerMS();
1383
1384     InMsg.Alloc(NET_BUFSIZE);
1385     Buf.data := InMsg.Data;
1386     Buf.dataLength := InMsg.MaxSize;
1387     Cnt := 0;
1388     while GetTimerMS() - T <= 500 do
1389     begin
1390       InMsg.Clear();
1391
1392       RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
1393       if RX <= 0 then continue;
1394       InMsg.CurSize := RX;
1395
1396       InMsg.BeginReading();
1397
1398       if InMsg.ReadChar() <> 'D' then continue;
1399       if InMsg.ReadChar() <> 'F' then continue;
1400
1401       FromSL := False;
1402       for I := Low(SL) to High(SL) do
1403         if (SL[I].PingAddr.host = SvAddr.host) and
1404            (SL[I].PingAddr.port = SvAddr.port) then
1405         begin
1406           with SL[I] do
1407           begin
1408             Port := InMsg.ReadWord();
1409             Ping := InMsg.ReadInt64();
1410             Ping := GetTimerMS() - Ping;
1411             Name := InMsg.ReadString();
1412             Map := InMsg.ReadString();
1413             GameMode := InMsg.ReadByte();
1414             Players := InMsg.ReadByte();
1415             MaxPlayers := InMsg.ReadByte();
1416             Protocol := InMsg.ReadByte();
1417             Password := InMsg.ReadByte() = 1;
1418             LocalPl := InMsg.ReadByte();
1419             Bots := InMsg.ReadWord();
1420           end;
1421           FromSL := True;
1422           Inc(Cnt);
1423           break;
1424         end;
1425       if not FromSL then
1426         ProcessLocal();
1427     end;
1428
1429     InMsg.Free();
1430     enet_socket_destroy(Sock);
1431   finally
1432     NetOut.Clear();
1433   end;
1434 end;
1435
1436
1437 //==========================================================================
1438 //
1439 //  GetServerFromTable
1440 //
1441 //==========================================================================
1442 function GetServerFromTable (Index: Integer; SL: TNetServerList; ST: TNetServerTable): TNetServer;
1443 begin
1444   Result.Number := 0;
1445   Result.Protocol := 0;
1446   Result.Name := '';
1447   Result.IP := '';
1448   Result.Port := 0;
1449   Result.Map := '';
1450   Result.Players := 0;
1451   Result.MaxPlayers := 0;
1452   Result.LocalPl := 0;
1453   Result.Bots := 0;
1454   Result.Ping := 0;
1455   Result.GameMode := 0;
1456   Result.Password := false;
1457   FillChar(Result.PingAddr, SizeOf(ENetAddress), 0);
1458   if ST = nil then
1459     Exit;
1460   if (Index < 0) or (Index >= Length(ST)) then
1461     Exit;
1462   Result := SL[ST[Index].Indices[ST[Index].Current]];
1463 end;
1464
1465
1466 //==========================================================================
1467 //
1468 //  g_Serverlist_Draw
1469 //
1470 //==========================================================================
1471 procedure g_Serverlist_Draw (var SL: TNetServerList; var ST: TNetServerTable);
1472 var
1473   Srv: TNetServer;
1474   sy, i, y, mw, mx, l, motdh: Integer;
1475   cw: Byte = 0;
1476   ch: Byte = 0;
1477   ww: Word = 0;
1478   hh: Word = 0;
1479   ip: AnsiString;
1480 begin
1481   ip := '';
1482   sy := 0;
1483
1484   e_CharFont_GetSize(gMenuFont, _lc[I_NET_SLIST], ww, hh);
1485   e_CharFont_Print(gMenuFont, (gScreenWidth div 2) - (ww div 2), 16, _lc[I_NET_SLIST]);
1486
1487   e_TextureFontGetSize(gStdFont, cw, ch);
1488
1489   ip := _lc[I_NET_SLIST_HELP];
1490   mw := (Length(ip) * cw) div 2;
1491
1492   motdh := gScreenHeight - 49 - ch * b_Text_LineCount(slMOTD);
1493
1494   e_DrawFillQuad(16, 64, gScreenWidth-16, motdh, 64, 64, 64, 110);
1495   e_DrawQuad(16, 64, gScreenWidth-16, motdh, 255, 127, 0);
1496
1497   e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
1498
1499   // MOTD
1500   if slMOTD <> '' then
1501   begin
1502     e_DrawFillQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
1503     e_DrawQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
1504     e_TextureFontPrintFmt(20, motdh + 3, slMOTD, gStdFont, False, True);
1505   end;
1506
1507   // Urgent message
1508   if not slReadUrgent and (slUrgent <> '') then
1509   begin
1510     e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
1511     e_DrawFillQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
1512       gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 64, 64, 64, 128);
1513     e_DrawQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
1514       gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 255, 127, 0);
1515     e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 - 40,
1516       gScreenWidth div 2 + 256, gScreenHeight div 2 - 40, 255, 127, 0);
1517     l := Length(_lc[I_NET_SLIST_URGENT]) div 2;
1518     e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - 58,
1519       _lc[I_NET_SLIST_URGENT], gStdFont);
1520     l := Length(slUrgent) div 2;
1521     e_TextureFontPrintFmt(gScreenWidth div 2 - 253, gScreenHeight div 2 - 38,
1522       slUrgent, gStdFont, False, True);
1523     l := Length(_lc[I_NET_SLIST_URGENT_CONT]) div 2;
1524     e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 + 41,
1525       _lc[I_NET_SLIST_URGENT_CONT], gStdFont);
1526     e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 + 40,
1527       gScreenWidth div 2 + 256, gScreenHeight div 2 + 40, 255, 127, 0);
1528     Exit;
1529   end;
1530
1531   if SL = nil then
1532   begin
1533     l := Length(slWaitStr) div 2;
1534     e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
1535     e_DrawQuad(gScreenWidth div 2 - 192, gScreenHeight div 2 - 10,
1536       gScreenWidth div 2 + 192, gScreenHeight div 2 + 11, 255, 127, 0);
1537     e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - ch div 2,
1538       slWaitStr, gStdFont);
1539     Exit;
1540   end;
1541
1542   y := 90;
1543   if (slSelection < Length(ST)) then
1544   begin
1545     I := slSelection;
1546     sy := y + 42 * I - 4;
1547     Srv := GetServerFromTable(I, SL, ST);
1548     ip := _lc[I_NET_ADDRESS] + ' ' + Srv.IP + ':' + IntToStr(Srv.Port);
1549     if Srv.Password then
1550       ip := ip + '  ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_YES]
1551     else
1552       ip := ip + '  ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_NO];
1553   end else
1554     if Length(ST) > 0 then
1555       slSelection := 0;
1556
1557   mw := (gScreenWidth - 188);
1558   mx := 16 + mw;
1559
1560   e_DrawFillQuad(16 + 1, sy, gScreenWidth - 16 - 1, sy + 40, 64, 64, 64, 0);
1561   e_DrawLine(1, 16 + 1, sy, gScreenWidth - 16 - 1, sy, 205, 205, 205);
1562   e_DrawLine(1, 16 + 1, sy + 41, gScreenWidth - 16 - 1, sy + 41, 255, 255, 255);
1563
1564   e_DrawLine(1, 16, 85, gScreenWidth - 16, 85, 255, 127, 0);
1565   e_DrawLine(1, 16, motdh-20, gScreenWidth-16, motdh-20, 255, 127, 0);
1566
1567   e_DrawLine(1, mx - 70, 64, mx - 70, motdh, 255, 127, 0);
1568   e_DrawLine(1, mx, 64, mx, motdh-20, 255, 127, 0);
1569   e_DrawLine(1, mx + 52, 64, mx + 52, motdh-20, 255, 127, 0);
1570   e_DrawLine(1, mx + 104, 64, mx + 104, motdh-20, 255, 127, 0);
1571
1572   e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
1573   e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
1574   e_TextureFontPrintEx(mx + 2, 68, 'MODE', gStdFont, 255, 127, 0, 1);
1575   e_TextureFontPrintEx(mx + 54, 68, 'PLRS', gStdFont, 255, 127, 0, 1);
1576   e_TextureFontPrintEx(mx + 106, 68, 'VER', gStdFont, 255, 127, 0, 1);
1577
1578   y := 90;
1579   for I := 0 to High(ST) do
1580   begin
1581     Srv := GetServerFromTable(I, SL, ST);
1582     // Name and map
1583     e_TextureFontPrintEx(18, y, Srv.Name, gStdFont, 255, 255, 255, 1);
1584     e_TextureFontPrintEx(18, y + 16, Srv.Map, gStdFont, 210, 210, 210, 1);
1585
1586     // Ping and similar count
1587     if (Srv.Ping < 0) or (Srv.Ping > 999) then
1588       e_TextureFontPrintEx(mx - 68, y, _lc[I_NET_SLIST_NO_ACCESS], gStdFont, 255, 0, 0, 1)
1589     else
1590       if Srv.Ping = 0 then
1591         e_TextureFontPrintEx(mx - 68, y, '<1' + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1)
1592       else
1593         e_TextureFontPrintEx(mx - 68, y, IntToStr(Srv.Ping) + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1);
1594
1595     if Length(ST[I].Indices) > 1 then
1596       e_TextureFontPrintEx(mx - 68, y + 16, '< ' + IntToStr(Length(ST[I].Indices)) + ' >', gStdFont, 210, 210, 210, 1);
1597
1598     // Game mode
1599     e_TextureFontPrintEx(mx + 2, y, g_Game_ModeToText(Srv.GameMode), gStdFont, 255, 255, 255, 1);
1600
1601     // Players
1602     e_TextureFontPrintEx(mx + 54, y, IntToStr(Srv.Players) + '/' + IntToStr(Srv.MaxPlayers), gStdFont, 255, 255, 255, 1);
1603     e_TextureFontPrintEx(mx + 54, y + 16, IntToStr(Srv.LocalPl) + '+' + IntToStr(Srv.Bots), gStdFont, 210, 210, 210, 1);
1604
1605     // Version
1606     e_TextureFontPrintEx(mx + 106, y, IntToStr(Srv.Protocol), gStdFont, 255, 255, 255, 1);
1607
1608     y := y + 42;
1609   end;
1610
1611   e_TextureFontPrintEx(20, motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
1612   ip := IntToStr(Length(ST)) + _lc[I_NET_SLIST_SERVERS];
1613   e_TextureFontPrintEx(gScreenWidth - 48 - (Length(ip) + 1)*cw,
1614     motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
1615 end;
1616
1617
1618 //==========================================================================
1619 //
1620 //  g_Serverlist_GenerateTable
1621 //
1622 //==========================================================================
1623 procedure g_Serverlist_GenerateTable (SL: TNetServerList; var ST: TNetServerTable);
1624 var
1625   i, j: Integer;
1626
1627   function FindServerInTable(Name: AnsiString): Integer;
1628   var
1629     i: Integer;
1630   begin
1631     Result := -1;
1632     if ST = nil then
1633       Exit;
1634     for i := Low(ST) to High(ST) do
1635     begin
1636       if Length(ST[i].Indices) = 0 then
1637         continue;
1638       if SL[ST[i].Indices[0]].Name = Name then
1639       begin
1640         Result := i;
1641         Exit;
1642       end;
1643     end;
1644   end;
1645   function ComparePing(i1, i2: Integer): Boolean;
1646   var
1647     p1, p2: Int64;
1648   begin
1649     p1 := SL[i1].Ping;
1650     p2 := SL[i2].Ping;
1651     if (p1 < 0) then p1 := 999;
1652     if (p2 < 0) then p2 := 999;
1653     Result := p1 > p2;
1654   end;
1655   procedure SortIndices(var ind: Array of Integer);
1656   var
1657     I, J: Integer;
1658     T: Integer;
1659   begin
1660     for I := High(ind) downto Low(ind) do
1661       for J := Low(ind) to High(ind) - 1 do
1662         if ComparePing(ind[j], ind[j+1]) then
1663         begin
1664           T := ind[j];
1665           ind[j] := ind[j+1];
1666           ind[j+1] := T;
1667         end;
1668   end;
1669   procedure SortRows();
1670   var
1671     I, J: Integer;
1672     T: TNetServerRow;
1673   begin
1674     for I := High(ST) downto Low(ST) do
1675       for J := Low(ST) to High(ST) - 1 do
1676         if ComparePing(ST[j].Indices[0], ST[j+1].Indices[0]) then
1677         begin
1678           T := ST[j];
1679           ST[j] := ST[j+1];
1680           ST[j+1] := T;
1681         end;
1682   end;
1683 begin
1684   ST := nil;
1685   if SL = nil then
1686     Exit;
1687   for i := Low(SL) to High(SL) do
1688   begin
1689     j := FindServerInTable(SL[i].Name);
1690     if j = -1 then
1691     begin
1692       j := Length(ST);
1693       SetLength(ST, j + 1);
1694       ST[j].Current := 0;
1695       SetLength(ST[j].Indices, 1);
1696       ST[j].Indices[0] := i;
1697     end
1698     else
1699     begin
1700       SetLength(ST[j].Indices, Length(ST[j].Indices) + 1);
1701       ST[j].Indices[High(ST[j].Indices)] := i;
1702     end;
1703   end;
1704
1705   for i := Low(ST) to High(ST) do
1706     SortIndices(ST[i].Indices);
1707
1708   SortRows();
1709 end;
1710
1711
1712 //==========================================================================
1713 //
1714 //  g_Serverlist_Control
1715 //
1716 //==========================================================================
1717 procedure g_Serverlist_Control (var SL: TNetServerList; var ST: TNetServerTable);
1718 var
1719   qm: Boolean;
1720   Srv: TNetServer;
1721 begin
1722   g_Net_Slist_Pulse();
1723
1724   if gConsoleShow or gChatShow then
1725     Exit;
1726
1727   qm := sys_HandleInput(); // this updates kbd
1728
1729   if qm or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
1730      e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or
1731      e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
1732   begin
1733     SL := nil;
1734     ST := nil;
1735     gState := STATE_MENU;
1736     g_GUI_ShowWindow('MainMenu');
1737     g_GUI_ShowWindow('NetGameMenu');
1738     g_GUI_ShowWindow('NetClientMenu');
1739     g_Sound_PlayEx(WINDOW_CLOSESOUND);
1740     Exit;
1741   end;
1742
1743   // if there's a message on the screen,
1744   if not slReadUrgent and (slUrgent <> '') then
1745   begin
1746     if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1747        e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1748       slReadUrgent := True;
1749     Exit;
1750   end;
1751
1752   if e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_JUMP) or
1753      e_KeyPressed(JOY0_ACTIVATE) or e_KeyPressed(JOY1_ACTIVATE) or e_KeyPressed(JOY2_ACTIVATE) or e_KeyPressed(JOY3_ACTIVATE) then
1754   begin
1755     if not slFetched then
1756     begin
1757       slWaitStr := _lc[I_NET_SLIST_WAIT];
1758
1759       g_Game_Draw;
1760       sys_Repaint;
1761
1762       if g_Net_Slist_Fetch(SL) then
1763       begin
1764         if SL = nil then
1765           slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
1766       end
1767       else
1768         if SL = nil then
1769           slWaitStr := _lc[I_NET_SLIST_ERROR];
1770       slFetched := True;
1771       slSelection := 0;
1772       g_Serverlist_GenerateTable(SL, ST);
1773     end;
1774   end
1775   else
1776     slFetched := False;
1777
1778   if SL = nil then Exit;
1779
1780   if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1781      e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1782   begin
1783     if not slReturnPressed then
1784     begin
1785       Srv := GetServerFromTable(slSelection, SL, ST);
1786       if Srv.Password then
1787       begin
1788         PromptIP := Srv.IP;
1789         PromptPort := Srv.Port;
1790         gState := STATE_MENU;
1791         g_GUI_ShowWindow('ClientPasswordMenu');
1792         SL := nil;
1793         ST := nil;
1794         slReturnPressed := True;
1795         Exit;
1796       end
1797       else
1798         g_Game_StartClient(Srv.IP, Srv.Port, '');
1799       SL := nil;
1800       ST := nil;
1801       slReturnPressed := True;
1802       Exit;
1803     end;
1804   end
1805   else
1806     slReturnPressed := False;
1807
1808   if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) or e_KeyPressed(VK_DOWN) or
1809      e_KeyPressed(JOY0_DOWN) or e_KeyPressed(JOY1_DOWN) or e_KeyPressed(JOY2_DOWN) or e_KeyPressed(JOY3_DOWN) then
1810   begin
1811     if not slDirPressed then
1812     begin
1813       Inc(slSelection);
1814       if slSelection > High(ST) then slSelection := 0;
1815       slDirPressed := True;
1816     end;
1817   end;
1818
1819   if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) or e_KeyPressed(VK_UP) or
1820      e_KeyPressed(JOY0_UP) or e_KeyPressed(JOY1_UP) or e_KeyPressed(JOY2_UP) or e_KeyPressed(JOY3_UP) then
1821   begin
1822     if not slDirPressed then
1823     begin
1824       if slSelection = 0 then slSelection := Length(ST);
1825       Dec(slSelection);
1826
1827       slDirPressed := True;
1828     end;
1829   end;
1830
1831   if e_KeyPressed(IK_RIGHT) or e_KeyPressed(IK_KPRIGHT) or e_KeyPressed(VK_RIGHT) or
1832      e_KeyPressed(JOY0_RIGHT) or e_KeyPressed(JOY1_RIGHT) or e_KeyPressed(JOY2_RIGHT) or e_KeyPressed(JOY3_RIGHT) then
1833   begin
1834     if not slDirPressed then
1835     begin
1836       Inc(ST[slSelection].Current);
1837       if ST[slSelection].Current > High(ST[slSelection].Indices) then ST[slSelection].Current := 0;
1838       slDirPressed := True;
1839     end;
1840   end;
1841
1842   if e_KeyPressed(IK_LEFT) or e_KeyPressed(IK_KPLEFT) or e_KeyPressed(VK_LEFT) or
1843      e_KeyPressed(JOY0_LEFT) or e_KeyPressed(JOY1_LEFT) or e_KeyPressed(JOY2_LEFT) or e_KeyPressed(JOY3_LEFT) then
1844   begin
1845     if not slDirPressed then
1846     begin
1847       if ST[slSelection].Current = 0 then ST[slSelection].Current := Length(ST[slSelection].Indices);
1848       Dec(ST[slSelection].Current);
1849
1850       slDirPressed := True;
1851     end;
1852   end;
1853
1854   if (not e_KeyPressed(IK_DOWN)) and
1855      (not e_KeyPressed(IK_UP)) and
1856      (not e_KeyPressed(IK_RIGHT)) and
1857      (not e_KeyPressed(IK_LEFT)) and
1858      (not e_KeyPressed(IK_KPDOWN)) and
1859      (not e_KeyPressed(IK_KPUP)) and
1860      (not e_KeyPressed(IK_KPRIGHT)) and
1861      (not e_KeyPressed(IK_KPLEFT)) and
1862      (not e_KeyPressed(VK_DOWN)) and
1863      (not e_KeyPressed(VK_UP)) and
1864      (not e_KeyPressed(VK_RIGHT)) and
1865      (not e_KeyPressed(VK_LEFT)) and
1866      (not e_KeyPressed(JOY0_UP)) and (not e_KeyPressed(JOY1_UP)) and (not e_KeyPressed(JOY2_UP)) and (not e_KeyPressed(JOY3_UP)) and
1867      (not e_KeyPressed(JOY0_DOWN)) and (not e_KeyPressed(JOY1_DOWN)) and (not e_KeyPressed(JOY2_DOWN)) and (not e_KeyPressed(JOY3_DOWN)) and
1868      (not e_KeyPressed(JOY0_LEFT)) and (not e_KeyPressed(JOY1_LEFT)) and (not e_KeyPressed(JOY2_LEFT)) and (not e_KeyPressed(JOY3_LEFT)) and
1869      (not e_KeyPressed(JOY0_RIGHT)) and (not e_KeyPressed(JOY1_RIGHT)) and (not e_KeyPressed(JOY2_RIGHT)) and (not e_KeyPressed(JOY3_RIGHT))
1870  then
1871     slDirPressed := False;
1872 end;
1873
1874
1875 end.