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