DEADSOFTWARE

AL: add GME music loader
[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 (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 (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 list := Trim(list);
1068 //writeln('list=[', list, ']');
1069 while (length(list) > 0) do
1070 begin
1071 pp := Pos(',', list);
1072 if (pp < 1) then pp := length(list)+1;
1073 sa := Trim(Copy(list, 1, pp-1));
1074 Delete(list, 1, pp);
1075 //writeln(' sa=[', sa, ']');
1076 if (length(sa) > 0) and parseAddressPort(ea, sa) then addMasterRecord(ea, sa);
1077 end;
1079 // remove unknown master servers
1080 dest := 0;
1081 for f := 0 to High(mlist) do
1082 begin
1083 if (not mlist[f].justAdded) then mlist[f].clear();
1084 if (mlist[f].isValid()) then
1085 begin
1086 if (dest <> f) then mlist[dest] := mlist[f];
1087 Inc(dest);
1088 end;
1089 end;
1090 if (dest <> length(mlist)) then SetLength(mlist, dest);
1091 end;
1094 //**************************************************************************
1095 //
1096 // main pulse
1097 //
1098 //**************************************************************************
1100 //==========================================================================
1101 //
1102 // isMasterReportsEnabled
1103 //
1104 //==========================================================================
1105 function isMasterReportsEnabled (): Boolean;
1106 begin
1107 result := (reportsEnabled and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster);
1108 end;
1111 //==========================================================================
1112 //
1113 // g_Net_Slist_Pulse
1114 //
1115 // non-zero timeout ignores current status (used to fetch server list)
1116 //
1117 //==========================================================================
1118 procedure g_Net_Slist_Pulse (timeout: Integer=0);
1119 var
1120 f: Integer;
1121 sres: Integer;
1122 idx: Integer;
1123 ct: Int64;
1124 isListQuery: Boolean;
1125 count: Integer;
1126 begin
1127 if (not g_Net_IsNetworkAvailable()) then exit;
1129 if (length(mlist) = 0) then
1130 begin
1131 if (NetMHost <> nil) then
1132 begin
1133 enet_host_destroy(NetMHost);
1134 NetMHost := nil;
1135 exit;
1136 end;
1137 end;
1139 if (NetMHost = nil) then
1140 begin
1141 NetMHost := enet_host_create(nil, 64, NET_MCHANS, 1024*1024, 1024*1024);
1142 if (NetMHost = nil) then
1143 begin
1144 e_LogWriteln(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT] + ' (host_create)', TMsgType.Notify);
1145 for f := 0 to High(mlist) do mlist[f].clear();
1146 SetLength(mlist, 0);
1147 Exit;
1148 end;
1149 end;
1151 isListQuery := (timeout > 0);
1152 ct := GetTimerMS();
1153 // reconnect/disconnect/pulse for each master
1154 for f := 0 to High(mlist) do
1155 begin
1156 if (not mlist[f].isValid()) then continue;
1157 if (not mlist[f].isAlive()) then
1158 begin
1159 // not connected; try to reconnect if we're asking for a host list, or we are in netgame, and we are the host
1160 if (not isListQuery) and isMasterReportsEnabled() then
1161 begin
1162 if (mlist[f].lastDisconnectTime = 0) or (ct < mlist[f].lastDisconnectTime) or (ct-mlist[f].lastDisconnectTime >= 1000*NMASTER_TIMEOUT_RECONNECT) then
1163 begin
1164 e_LogWritefln('reconnecting to master [%s]', [mlist[f].hostName], TMsgType.Notify);
1165 mlist[f].connect();
1166 end
1167 else
1168 begin
1169 //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);
1170 end;
1171 end;
1172 end
1173 else
1174 begin
1175 // if we're not in slist query, and not in netgame (or not a host), disconnect
1176 if (not isListQuery) and (not isMasterReportsEnabled()) then
1177 begin
1178 if (mlist[f].isConnected()) and (mlist[f].updateSent) then
1179 begin
1180 e_LogWritefln('removing from master [%s]', [mlist[f].hostName], TMsgType.Notify);
1181 mlist[f].remove();
1182 end;
1183 e_LogWritefln('disconnecting from master [%s]', [mlist[f].hostName], TMsgType.Notify);
1184 mlist[f].disconnect(false);
1185 end;
1186 end;
1187 mlist[f].pulse();
1188 end;
1190 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
1191 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
1192 // thank you, enet. let's ignore failures altogether then.
1193 count := 10; // no more than ten events in a row
1194 sres := enet_host_service(NetMHost, @NetMEvent, timeout);
1195 while (sres > 0) do
1196 begin
1198 if (sres < 0) then
1199 begin
1200 e_LogWriteln(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT] + ' (host_service)', TMsgType.Notify);
1201 for f := 0 to High(mlist) do mlist[f].clear();
1202 SetLength(mlist, 0);
1203 enet_host_destroy(NetMHost);
1204 NetMHost := nil;
1205 exit;
1206 end;
1209 idx := findByPeer(NetMEvent.peer);
1210 if (idx < 0) then
1211 begin
1212 e_LogWriteln('network event from unknown master host. ignored.', TMsgType.Warning);
1213 if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then enet_packet_destroy(NetMEvent.packet);
1214 end
1215 else
1216 begin
1217 if (NetMEvent.kind = ENET_EVENT_TYPE_CONNECT) then
1218 begin
1219 mlist[idx].connectedEvent();
1220 end
1221 else if (NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1222 begin
1223 mlist[idx].disconnectedEvent();
1224 end
1225 else if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1226 begin
1227 mlist[idx].receivedEvent(NetMEvent.packet);
1228 enet_packet_destroy(NetMEvent.packet);
1229 end;
1230 end;
1232 Dec(count);
1233 if (count = 0) then break;
1234 sres := enet_host_service(NetMHost, @NetMEvent, 0);
1235 end;
1236 end;
1239 //**************************************************************************
1240 //
1241 // gui and server list
1242 //
1243 //**************************************************************************
1245 //==========================================================================
1246 //
1247 // PingServer
1248 //
1249 //==========================================================================
1250 procedure PingServer (var S: TNetServer; Sock: ENetSocket);
1251 var
1252 Buf: ENetBuffer;
1253 Ping: array [0..9] of Byte;
1254 ClTime: Int64;
1255 begin
1256 ClTime := GetTimerMS();
1258 Buf.data := Addr(Ping[0]);
1259 Buf.dataLength := 2+8;
1261 Ping[0] := Ord('D');
1262 Ping[1] := Ord('F');
1263 Int64(Addr(Ping[2])^) := ClTime;
1265 enet_socket_send(Sock, Addr(S.PingAddr), @Buf, 1);
1266 end;
1269 //==========================================================================
1270 //
1271 // PingBcast
1272 //
1273 //==========================================================================
1274 procedure PingBcast (Sock: ENetSocket);
1275 var
1276 S: TNetServer;
1277 begin
1278 S.IP := '255.255.255.255';
1279 S.Port := NET_PING_PORT;
1280 enet_address_set_host(Addr(S.PingAddr), PChar(Addr(S.IP[1])));
1281 S.Ping := -1;
1282 S.PingAddr.port := S.Port;
1283 PingServer(S, Sock);
1284 end;
1287 //==========================================================================
1288 //
1289 // g_Net_Slist_Fetch
1290 //
1291 //==========================================================================
1292 function g_Net_Slist_Fetch (var SL: TNetServerList): Boolean;
1293 var
1294 Cnt: Byte;
1295 pkt: pENetPacket;
1296 I, RX: Integer;
1297 T: Int64;
1298 Sock: ENetSocket;
1299 Buf: ENetBuffer;
1300 InMsg: TMsg;
1301 SvAddr: ENetAddress;
1302 FromSL: Boolean;
1303 MyVer: AnsiString;
1305 procedure ProcessLocal ();
1306 begin
1307 I := Length(SL);
1308 SetLength(SL, I + 1);
1309 with SL[I] do
1310 begin
1311 IP := DecodeIPV4(SvAddr.host);
1312 Port := InMsg.ReadWord();
1313 Ping := InMsg.ReadInt64();
1314 Ping := GetTimerMS() - Ping;
1315 Name := InMsg.ReadString();
1316 Map := InMsg.ReadString();
1317 GameMode := InMsg.ReadByte();
1318 Players := InMsg.ReadByte();
1319 MaxPlayers := InMsg.ReadByte();
1320 Protocol := InMsg.ReadByte();
1321 Password := InMsg.ReadByte() = 1;
1322 LocalPl := InMsg.ReadByte();
1323 Bots := InMsg.ReadWord();
1324 end;
1325 end;
1327 procedure CheckLocalServers ();
1328 begin
1329 SetLength(SL, 0);
1331 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1332 if Sock = ENET_SOCKET_NULL then Exit;
1333 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
1334 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
1335 PingBcast(Sock);
1337 T := GetTimerMS();
1339 InMsg.Alloc(NET_BUFSIZE);
1340 Buf.data := InMsg.Data;
1341 Buf.dataLength := InMsg.MaxSize;
1342 while GetTimerMS() - T <= 500 do
1343 begin
1344 InMsg.Clear();
1346 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
1347 if RX <= 0 then continue;
1348 InMsg.CurSize := RX;
1350 InMsg.BeginReading();
1352 if InMsg.ReadChar() <> 'D' then continue;
1353 if InMsg.ReadChar() <> 'F' then continue;
1355 ProcessLocal();
1356 end;
1358 InMsg.Free();
1359 enet_socket_destroy(Sock);
1361 if Length(SL) = 0 then SL := nil;
1362 end;
1364 var
1365 f, c, n, pos: Integer;
1366 aliveCount: Integer;
1367 hasUnanswered: Boolean;
1368 stt, ct: Int64;
1369 tmpsv: TNetServer;
1370 begin
1371 result := false;
1372 SL := nil;
1374 if (not g_Net_IsNetworkAvailable()) then
1375 begin
1376 SetLength(SL, 0);
1377 exit;
1378 end;
1380 g_Net_Slist_Pulse(); // this will create mhost
1382 DisconnectAll(true); // forced disconnect
1384 for f := 0 to High(mlist) do
1385 begin
1386 mlist[f].connectCount := 0;
1387 mlist[f].srvAnswered := 0;
1388 end;
1390 NetOut.Clear();
1391 NetOut.Write(Byte(NET_MMSG_GET));
1393 // TODO: what should we identify the build with?
1394 MyVer := GAME_VERSION;
1395 NetOut.Write(MyVer);
1397 try
1398 e_WriteLog('Fetching serverlist...', TMsgType.Notify);
1399 g_Console_Add(_lc[I_NET_MSG]+_lc[I_NET_SLIST_FETCH]);
1401 // wait until all servers connected and answered
1402 stt := GetTimerMS();
1403 while true do
1404 begin
1405 aliveCount := 0;
1406 hasUnanswered := false;
1407 for f := 0 to High(mlist) do
1408 begin
1410 e_LogWritefln(' master #%d: [%s] valid=%d; alive=%d; connected=%d; connecting=%d',
1411 [f, mlist[f].hostName, Integer(mlist[f].isValid()), Integer(mlist[f].isAlive()),
1412 Integer(mlist[f].isConnected()), Integer(mlist[f].isConnecting())], TMsgType.Notify);
1414 if (not mlist[f].isValid()) then continue;
1415 if (not mlist[f].isAlive()) then
1416 begin
1417 if (mlist[f].connectCount = 0) then
1418 begin
1419 mlist[f].connect();
1420 if (mlist[f].isAlive()) then
1421 begin
1422 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_WCONN], [mlist[f].hostName]));
1423 hasUnanswered := true;
1424 stt := GetTimerMS();
1425 end;
1426 end
1427 else if (mlist[f].srvAnswered > 1) then
1428 begin
1429 Inc(aliveCount);
1430 end;
1431 end
1432 else if (mlist[f].isConnected()) then
1433 begin
1434 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_CONN], [mlist[f].hostName]));
1435 if (mlist[f].srvAnswered = 0) then
1436 begin
1437 pkt := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
1438 if assigned(pkt) then
1439 begin
1440 if (enet_peer_send(mlist[f].peer, NET_MCHAN_MAIN, pkt) = 0) then
1441 begin
1442 hasUnanswered := true;
1443 mlist[f].srvAnswered := 1;
1444 stt := GetTimerMS();
1445 end;
1446 end;
1447 end
1448 else if (mlist[f].srvAnswered = 1) then
1449 begin
1450 hasUnanswered := true;
1451 end
1452 else if (mlist[f].srvAnswered > 1) then
1453 begin
1454 Inc(aliveCount);
1455 mlist[f].disconnect(false); // not forced
1456 end;
1457 end
1458 else if (mlist[f].isConnecting()) then
1459 begin
1460 hasUnanswered := true;
1461 end;
1462 end;
1463 if (not hasUnanswered) then break;
1464 // check for timeout
1465 ct := GetTimerMS();
1466 if (ct < stt) or (ct-stt > 4000) then break;
1467 g_Net_Slist_Pulse(300);
1468 end;
1470 if (aliveCount = 0) then
1471 begin
1472 DisconnectAll();
1473 CheckLocalServers();
1474 exit;
1475 end;
1477 slMOTD := '';
1479 slUrgent := '';
1480 slReadUrgent := true;
1483 SetLength(SL, 0);
1484 for f := 0 to High(mlist) do
1485 begin
1486 if (mlist[f].srvAnswered < 2) then continue;
1487 for n := 0 to High(mlist[f].srvAnswer) do
1488 begin
1489 pos := -1;
1490 for c := 0 to High(SL) do
1491 begin
1492 if (SL[c].IP = mlist[f].srvAnswer[n].IP) and (SL[c].Port = mlist[f].srvAnswer[n].Port) then
1493 begin
1494 pos := c;
1495 break;
1496 end;
1497 end;
1498 if (pos < 0) then
1499 begin
1500 pos := length(SL);
1501 SetLength(SL, pos+1);
1502 SL[pos] := mlist[f].srvAnswer[n];
1503 SL[pos].Number := pos;
1504 end;
1505 end;
1506 if (not mlist[f].slReadUrgent) and (mlist[f].slUrgent <> '') then
1507 begin
1508 if (mlist[f].slUrgent <> slUrgent) then
1509 begin
1510 slUrgent := mlist[f].slUrgent;
1511 slReadUrgent := false;
1512 end;
1513 end;
1514 if (slMOTD <> '') and (mlist[f].slMOTD <> '') then
1515 begin
1516 slMOTD := mlist[f].slMOTD;
1517 end;
1518 end;
1520 DisconnectAll();
1522 if (length(SL) = 0) then
1523 begin
1524 CheckLocalServers();
1525 exit;
1526 end;
1528 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1529 if Sock = ENET_SOCKET_NULL then Exit;
1530 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
1532 for I := Low(SL) to High(SL) do PingServer(SL[I], Sock);
1534 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
1535 PingBcast(Sock);
1537 T := GetTimerMS();
1539 InMsg.Alloc(NET_BUFSIZE);
1540 Buf.data := InMsg.Data;
1541 Buf.dataLength := InMsg.MaxSize;
1542 Cnt := 0;
1543 while GetTimerMS() - T <= 500 do
1544 begin
1545 InMsg.Clear();
1547 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
1548 if RX <= 0 then continue;
1549 InMsg.CurSize := RX;
1551 InMsg.BeginReading();
1553 if InMsg.ReadChar() <> 'D' then continue;
1554 if InMsg.ReadChar() <> 'F' then continue;
1556 with tmpsv do
1557 begin
1558 Port := InMsg.ReadWord();
1559 Ping := InMsg.ReadInt64();
1560 Ping := GetTimerMS() - Ping;
1561 Name := InMsg.ReadString();
1562 Map := InMsg.ReadString();
1563 GameMode := InMsg.ReadByte();
1564 Players := InMsg.ReadByte();
1565 MaxPlayers := InMsg.ReadByte();
1566 Protocol := InMsg.ReadByte();
1567 Password := InMsg.ReadByte() = 1;
1568 LocalPl := InMsg.ReadByte();
1569 Bots := InMsg.ReadWord();
1570 PingAddr := SvAddr;
1571 end;
1573 FromSL := False;
1574 for I := Low(SL) to High(SL) do
1575 if (SL[I].PingAddr.host = SvAddr.host) and
1576 (SL[I].PingAddr.port = SvAddr.port) and
1577 (SL[I].Port = tmpsv.Port) then
1578 begin
1579 tmpsv.IP := SL[I].IP;
1580 SL[I] := tmpsv;
1581 FromSL := True;
1582 Inc(Cnt);
1583 break;
1584 end;
1586 if not FromSL then
1587 begin
1588 I := Length(SL);
1589 SetLength(SL, I + 1);
1590 tmpsv.IP := DecodeIPV4(SvAddr.host);
1591 SL[I] := tmpsv;
1592 end;
1593 end;
1595 InMsg.Free();
1596 enet_socket_destroy(Sock);
1597 finally
1598 NetOut.Clear();
1599 end;
1600 end;
1603 //==========================================================================
1604 //
1605 // GetServerFromTable
1606 //
1607 //==========================================================================
1608 function GetServerFromTable (Index: Integer; SL: TNetServerList; ST: TNetServerTable): TNetServer;
1609 begin
1610 Result.Number := 0;
1611 Result.Protocol := 0;
1612 Result.Name := '';
1613 Result.IP := '';
1614 Result.Port := 0;
1615 Result.Map := '';
1616 Result.Players := 0;
1617 Result.MaxPlayers := 0;
1618 Result.LocalPl := 0;
1619 Result.Bots := 0;
1620 Result.Ping := 0;
1621 Result.GameMode := 0;
1622 Result.Password := false;
1623 FillChar(Result.PingAddr, SizeOf(ENetAddress), 0);
1624 if ST = nil then
1625 Exit;
1626 if (Index < 0) or (Index >= Length(ST)) then
1627 Exit;
1628 Result := SL[ST[Index].Indices[ST[Index].Current]];
1629 end;
1632 //==========================================================================
1633 //
1634 // g_Serverlist_Draw
1635 //
1636 //==========================================================================
1637 procedure g_Serverlist_Draw (var SL: TNetServerList; var ST: TNetServerTable);
1638 var
1639 Srv: TNetServer;
1640 sy, i, y, mw, mx, l, motdh: Integer;
1641 cw: Byte = 0;
1642 ch: Byte = 0;
1643 ww: Word = 0;
1644 hh: Word = 0;
1645 ip: AnsiString;
1646 begin
1647 ip := '';
1648 sy := 0;
1650 e_CharFont_GetSize(gMenuFont, _lc[I_NET_SLIST], ww, hh);
1651 e_CharFont_Print(gMenuFont, (gScreenWidth div 2) - (ww div 2), 16, _lc[I_NET_SLIST]);
1653 e_TextureFontGetSize(gStdFont, cw, ch);
1655 ip := _lc[I_NET_SLIST_HELP];
1656 mw := (Length(ip) * cw) div 2;
1658 motdh := gScreenHeight - 49 - ch * b_Text_LineCount(slMOTD);
1660 e_DrawFillQuad(16, 64, gScreenWidth-16, motdh, 64, 64, 64, 110);
1661 e_DrawQuad(16, 64, gScreenWidth-16, motdh, 255, 127, 0);
1663 e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
1665 // MOTD
1666 if slMOTD <> '' then
1667 begin
1668 e_DrawFillQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
1669 e_DrawQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
1670 e_TextureFontPrintFmt(20, motdh + 3, slMOTD, gStdFont, False, True);
1671 end;
1673 // Urgent message
1674 if not slReadUrgent and (slUrgent <> '') then
1675 begin
1676 e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
1677 e_DrawFillQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
1678 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 64, 64, 64, 128);
1679 e_DrawQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
1680 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 255, 127, 0);
1681 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 - 40,
1682 gScreenWidth div 2 + 256, gScreenHeight div 2 - 40, 255, 127, 0);
1683 l := Length(_lc[I_NET_SLIST_URGENT]) div 2;
1684 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - 58,
1685 _lc[I_NET_SLIST_URGENT], gStdFont);
1686 l := Length(slUrgent) div 2;
1687 e_TextureFontPrintFmt(gScreenWidth div 2 - 253, gScreenHeight div 2 - 38,
1688 slUrgent, gStdFont, False, True);
1689 l := Length(_lc[I_NET_SLIST_URGENT_CONT]) div 2;
1690 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 + 41,
1691 _lc[I_NET_SLIST_URGENT_CONT], gStdFont);
1692 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 + 40,
1693 gScreenWidth div 2 + 256, gScreenHeight div 2 + 40, 255, 127, 0);
1694 Exit;
1695 end;
1697 if SL = nil then
1698 begin
1699 l := Length(slWaitStr) div 2;
1700 e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
1701 e_DrawQuad(gScreenWidth div 2 - 192, gScreenHeight div 2 - 10,
1702 gScreenWidth div 2 + 192, gScreenHeight div 2 + 11, 255, 127, 0);
1703 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - ch div 2,
1704 slWaitStr, gStdFont);
1705 Exit;
1706 end;
1708 y := 90;
1709 if (slSelection < Length(ST)) then
1710 begin
1711 I := slSelection;
1712 sy := y + 42 * I - 4;
1713 Srv := GetServerFromTable(I, SL, ST);
1714 ip := _lc[I_NET_ADDRESS] + ' ' + Srv.IP + ':' + IntToStr(Srv.Port);
1715 if Srv.Password then
1716 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_YES]
1717 else
1718 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_NO];
1719 end else
1720 if Length(ST) > 0 then
1721 slSelection := 0;
1723 mw := (gScreenWidth - 188);
1724 mx := 16 + mw;
1726 e_DrawFillQuad(16 + 1, sy, gScreenWidth - 16 - 1, sy + 40, 64, 64, 64, 0);
1727 e_DrawLine(1, 16 + 1, sy, gScreenWidth - 16 - 1, sy, 205, 205, 205);
1728 e_DrawLine(1, 16 + 1, sy + 41, gScreenWidth - 16 - 1, sy + 41, 255, 255, 255);
1730 e_DrawLine(1, 16, 85, gScreenWidth - 16, 85, 255, 127, 0);
1731 e_DrawLine(1, 16, motdh-20, gScreenWidth-16, motdh-20, 255, 127, 0);
1733 e_DrawLine(1, mx - 70, 64, mx - 70, motdh, 255, 127, 0);
1734 e_DrawLine(1, mx, 64, mx, motdh-20, 255, 127, 0);
1735 e_DrawLine(1, mx + 52, 64, mx + 52, motdh-20, 255, 127, 0);
1736 e_DrawLine(1, mx + 104, 64, mx + 104, motdh-20, 255, 127, 0);
1738 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
1739 e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
1740 e_TextureFontPrintEx(mx + 2, 68, 'MODE', gStdFont, 255, 127, 0, 1);
1741 e_TextureFontPrintEx(mx + 54, 68, 'PLRS', gStdFont, 255, 127, 0, 1);
1742 e_TextureFontPrintEx(mx + 106, 68, 'VER', gStdFont, 255, 127, 0, 1);
1744 y := 90;
1745 for I := 0 to High(ST) do
1746 begin
1747 Srv := GetServerFromTable(I, SL, ST);
1748 // Name and map
1749 e_TextureFontPrintEx(18, y, Srv.Name, gStdFont, 255, 255, 255, 1);
1750 e_TextureFontPrintEx(18, y + 16, Srv.Map, gStdFont, 210, 210, 210, 1);
1752 // Ping and similar count
1753 if (Srv.Ping < 0) or (Srv.Ping > 999) then
1754 e_TextureFontPrintEx(mx - 68, y, _lc[I_NET_SLIST_NO_ACCESS], gStdFont, 255, 0, 0, 1)
1755 else
1756 if Srv.Ping = 0 then
1757 e_TextureFontPrintEx(mx - 68, y, '<1' + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1)
1758 else
1759 e_TextureFontPrintEx(mx - 68, y, IntToStr(Srv.Ping) + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1);
1761 if Length(ST[I].Indices) > 1 then
1762 e_TextureFontPrintEx(mx - 68, y + 16, '< ' + IntToStr(Length(ST[I].Indices)) + ' >', gStdFont, 210, 210, 210, 1);
1764 // Game mode
1765 e_TextureFontPrintEx(mx + 2, y, g_Game_ModeToText(Srv.GameMode), gStdFont, 255, 255, 255, 1);
1767 // Players
1768 e_TextureFontPrintEx(mx + 54, y, IntToStr(Srv.Players) + '/' + IntToStr(Srv.MaxPlayers), gStdFont, 255, 255, 255, 1);
1769 e_TextureFontPrintEx(mx + 54, y + 16, IntToStr(Srv.LocalPl) + '+' + IntToStr(Srv.Bots), gStdFont, 210, 210, 210, 1);
1771 // Version
1772 e_TextureFontPrintEx(mx + 106, y, IntToStr(Srv.Protocol), gStdFont, 255, 255, 255, 1);
1774 y := y + 42;
1775 end;
1777 e_TextureFontPrintEx(20, motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
1778 ip := IntToStr(Length(ST)) + _lc[I_NET_SLIST_SERVERS];
1779 e_TextureFontPrintEx(gScreenWidth - 48 - (Length(ip) + 1)*cw,
1780 motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
1781 end;
1784 //==========================================================================
1785 //
1786 // g_Serverlist_GenerateTable
1787 //
1788 //==========================================================================
1789 procedure g_Serverlist_GenerateTable (SL: TNetServerList; var ST: TNetServerTable);
1790 var
1791 i, j: Integer;
1793 function FindServerInTable(Name: AnsiString; Port: Word): Integer;
1794 var
1795 i: Integer;
1796 begin
1797 Result := -1;
1798 if ST = nil then
1799 Exit;
1800 for i := Low(ST) to High(ST) do
1801 begin
1802 if Length(ST[i].Indices) = 0 then
1803 continue;
1804 if (SL[ST[i].Indices[0]].Name = Name) and (SL[ST[i].Indices[0]].Port = Port) then
1805 begin
1806 Result := i;
1807 Exit;
1808 end;
1809 end;
1810 end;
1811 function ComparePing(i1, i2: Integer): Boolean;
1812 var
1813 p1, p2: Int64;
1814 begin
1815 p1 := SL[i1].Ping;
1816 p2 := SL[i2].Ping;
1817 if (p1 < 0) then p1 := 999;
1818 if (p2 < 0) then p2 := 999;
1819 Result := p1 > p2;
1820 end;
1821 procedure SortIndices(var ind: Array of Integer);
1822 var
1823 I, J: Integer;
1824 T: Integer;
1825 begin
1826 for I := High(ind) downto Low(ind) do
1827 for J := Low(ind) to High(ind) - 1 do
1828 if ComparePing(ind[j], ind[j+1]) then
1829 begin
1830 T := ind[j];
1831 ind[j] := ind[j+1];
1832 ind[j+1] := T;
1833 end;
1834 end;
1835 procedure SortRows();
1836 var
1837 I, J: Integer;
1838 T: TNetServerRow;
1839 begin
1840 for I := High(ST) downto Low(ST) do
1841 for J := Low(ST) to High(ST) - 1 do
1842 if ComparePing(ST[j].Indices[0], ST[j+1].Indices[0]) then
1843 begin
1844 T := ST[j];
1845 ST[j] := ST[j+1];
1846 ST[j+1] := T;
1847 end;
1848 end;
1849 begin
1850 ST := nil;
1851 if SL = nil then
1852 Exit;
1854 for i := Low(SL) to High(SL) do
1855 begin
1856 j := FindServerInTable(SL[i].Name, SL[i].Port);
1857 if j = -1 then
1858 begin
1859 j := Length(ST);
1860 SetLength(ST, j + 1);
1861 ST[j].Current := 0;
1862 SetLength(ST[j].Indices, 1);
1863 ST[j].Indices[0] := i;
1864 end
1865 else
1866 begin
1867 SetLength(ST[j].Indices, Length(ST[j].Indices) + 1);
1868 ST[j].Indices[High(ST[j].Indices)] := i;
1869 end;
1870 end;
1872 for i := Low(ST) to High(ST) do
1873 SortIndices(ST[i].Indices);
1875 SortRows();
1876 end;
1879 //==========================================================================
1880 //
1881 // g_Serverlist_Control
1882 //
1883 //==========================================================================
1884 procedure g_Serverlist_Control (var SL: TNetServerList; var ST: TNetServerTable);
1885 var
1886 qm: Boolean;
1887 Srv: TNetServer;
1888 begin
1889 g_Net_Slist_Pulse();
1891 if gConsoleShow or gChatShow then
1892 Exit;
1894 qm := sys_HandleInput(); // this updates kbd
1896 if qm or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
1897 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or
1898 e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
1899 begin
1900 SL := nil;
1901 ST := nil;
1902 gState := STATE_MENU;
1903 g_GUI_ShowWindow('MainMenu');
1904 g_GUI_ShowWindow('NetGameMenu');
1905 g_GUI_ShowWindow('NetClientMenu');
1906 g_Sound_PlayEx(WINDOW_CLOSESOUND);
1907 Exit;
1908 end;
1910 // if there's a message on the screen,
1911 if not slReadUrgent and (slUrgent <> '') then
1912 begin
1913 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1914 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1915 slReadUrgent := True;
1916 Exit;
1917 end;
1919 if e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_JUMP) or
1920 e_KeyPressed(JOY0_ACTIVATE) or e_KeyPressed(JOY1_ACTIVATE) or e_KeyPressed(JOY2_ACTIVATE) or e_KeyPressed(JOY3_ACTIVATE) then
1921 begin
1922 if not slFetched then
1923 begin
1924 slWaitStr := _lc[I_NET_SLIST_WAIT];
1926 g_Game_Draw;
1927 sys_Repaint;
1929 if g_Net_Slist_Fetch(SL) then
1930 begin
1931 if SL = nil then
1932 slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
1933 end
1934 else
1935 if SL = nil then
1936 slWaitStr := _lc[I_NET_SLIST_ERROR];
1937 slFetched := True;
1938 slSelection := 0;
1939 g_Serverlist_GenerateTable(SL, ST);
1940 end;
1941 end
1942 else
1943 slFetched := False;
1945 if SL = nil then Exit;
1947 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1948 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1949 begin
1950 if not slReturnPressed then
1951 begin
1952 Srv := GetServerFromTable(slSelection, SL, ST);
1953 if Srv.Password then
1954 begin
1955 PromptIP := Srv.IP;
1956 PromptPort := Srv.Port;
1957 gState := STATE_MENU;
1958 g_GUI_ShowWindow('ClientPasswordMenu');
1959 SL := nil;
1960 ST := nil;
1961 slReturnPressed := True;
1962 Exit;
1963 end
1964 else
1965 g_Game_StartClient(Srv.IP, Srv.Port, '');
1966 SL := nil;
1967 ST := nil;
1968 slReturnPressed := True;
1969 Exit;
1970 end;
1971 end
1972 else
1973 slReturnPressed := False;
1975 if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) or e_KeyPressed(VK_DOWN) or
1976 e_KeyPressed(JOY0_DOWN) or e_KeyPressed(JOY1_DOWN) or e_KeyPressed(JOY2_DOWN) or e_KeyPressed(JOY3_DOWN) then
1977 begin
1978 if not slDirPressed then
1979 begin
1980 Inc(slSelection);
1981 if slSelection > High(ST) then slSelection := 0;
1982 slDirPressed := True;
1983 end;
1984 end;
1986 if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) or e_KeyPressed(VK_UP) or
1987 e_KeyPressed(JOY0_UP) or e_KeyPressed(JOY1_UP) or e_KeyPressed(JOY2_UP) or e_KeyPressed(JOY3_UP) then
1988 begin
1989 if not slDirPressed then
1990 begin
1991 if slSelection = 0 then slSelection := Length(ST);
1992 Dec(slSelection);
1994 slDirPressed := True;
1995 end;
1996 end;
1998 if e_KeyPressed(IK_RIGHT) or e_KeyPressed(IK_KPRIGHT) or e_KeyPressed(VK_RIGHT) or
1999 e_KeyPressed(JOY0_RIGHT) or e_KeyPressed(JOY1_RIGHT) or e_KeyPressed(JOY2_RIGHT) or e_KeyPressed(JOY3_RIGHT) then
2000 begin
2001 if not slDirPressed then
2002 begin
2003 Inc(ST[slSelection].Current);
2004 if ST[slSelection].Current > High(ST[slSelection].Indices) then ST[slSelection].Current := 0;
2005 slDirPressed := True;
2006 end;
2007 end;
2009 if e_KeyPressed(IK_LEFT) or e_KeyPressed(IK_KPLEFT) or e_KeyPressed(VK_LEFT) or
2010 e_KeyPressed(JOY0_LEFT) or e_KeyPressed(JOY1_LEFT) or e_KeyPressed(JOY2_LEFT) or e_KeyPressed(JOY3_LEFT) then
2011 begin
2012 if not slDirPressed then
2013 begin
2014 if ST[slSelection].Current = 0 then ST[slSelection].Current := Length(ST[slSelection].Indices);
2015 Dec(ST[slSelection].Current);
2017 slDirPressed := True;
2018 end;
2019 end;
2021 if (not e_KeyPressed(IK_DOWN)) and
2022 (not e_KeyPressed(IK_UP)) and
2023 (not e_KeyPressed(IK_RIGHT)) and
2024 (not e_KeyPressed(IK_LEFT)) and
2025 (not e_KeyPressed(IK_KPDOWN)) and
2026 (not e_KeyPressed(IK_KPUP)) and
2027 (not e_KeyPressed(IK_KPRIGHT)) and
2028 (not e_KeyPressed(IK_KPLEFT)) and
2029 (not e_KeyPressed(VK_DOWN)) and
2030 (not e_KeyPressed(VK_UP)) and
2031 (not e_KeyPressed(VK_RIGHT)) and
2032 (not e_KeyPressed(VK_LEFT)) and
2033 (not e_KeyPressed(JOY0_UP)) and (not e_KeyPressed(JOY1_UP)) and (not e_KeyPressed(JOY2_UP)) and (not e_KeyPressed(JOY3_UP)) and
2034 (not e_KeyPressed(JOY0_DOWN)) and (not e_KeyPressed(JOY1_DOWN)) and (not e_KeyPressed(JOY2_DOWN)) and (not e_KeyPressed(JOY3_DOWN)) and
2035 (not e_KeyPressed(JOY0_LEFT)) and (not e_KeyPressed(JOY1_LEFT)) and (not e_KeyPressed(JOY2_LEFT)) and (not e_KeyPressed(JOY3_LEFT)) and
2036 (not e_KeyPressed(JOY0_RIGHT)) and (not e_KeyPressed(JOY1_RIGHT)) and (not e_KeyPressed(JOY2_RIGHT)) and (not e_KeyPressed(JOY3_RIGHT))
2037 then
2038 slDirPressed := False;
2039 end;
2042 end.