DEADSOFTWARE

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