Engine: Simplify and clarify e_SetViewPort() from e_graphics.pas
[d2df-sdl.git] / src / game / g_netmaster.pas
blob4fa402f0e860c5812f4c9a9d8b70120d87898f71
1 (* Copyright (C) 2016 - The Doom2D.org team & involved community members <http://www.doom2d.org>.
2 * This file is part of Doom2D Forever.
4 * This program is free software: you can redistribute it and/or modify it under the terms of
5 * the GNU General Public License as published by the Free Software Foundation, version 3 of
6 * the License ONLY.
8 * This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
9 * without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
10 * See the GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License along with this program.
13 * If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
17 unit g_netmaster;
19 interface
21 uses
22 ENet, SysUtils, e_msg;
24 const
25 NET_MCHANS = 2;
27 NET_MCHAN_MAIN = 0;
28 NET_MCHAN_UPD = 1;
30 NET_MMSG_UPD = 200;
31 NET_MMSG_DEL = 201;
32 NET_MMSG_GET = 202;
34 const
35 // all timeouts in seconds
36 NMASTER_TIMEOUT_CONNECT = 3; // 3 seconds
37 NMASTER_TIMEOUT_RECONNECT = 5*60; // 5 minutes
38 //NMASTER_TIMEOUT_RECONNECT = 30; // 5 minutes
39 //NMASTER_FORCE_UPDATE_TIMEOUT = 20;
40 //NMASTER_FORCE_UPDATE_TIMEOUT = 0;
42 type
43 TNetServer = record
44 Number: Byte;
45 Protocol: Byte;
46 Name: AnsiString;
47 IP: AnsiString;
48 Port: Word;
49 Map: AnsiString;
50 Players, MaxPlayers, LocalPl, Bots: Byte;
51 Ping: Int64;
52 GameMode: Byte;
53 Password: Boolean;
54 PingAddr: ENetAddress;
55 end;
56 pTNetServer = ^TNetServer;
57 TNetServerRow = record
58 Indices: Array of Integer;
59 Current: Integer;
60 end;
62 TNetServerList = array of TNetServer;
63 pTNetServerList = ^TNetServerList;
64 TNetServerTable = array of TNetServerRow;
66 type
67 TMasterHost = record
68 public
69 hostName: AnsiString;
71 public
72 peer: pENetPeer;
73 enetAddr: ENetAddress;
74 // inside the game, calling `connect()` is disasterous, as it is blocking.
75 // so we'll use this variable to indicate if "connected" event is received.
76 NetHostConnected: Boolean;
77 NetHostConReqTime: Int64; // to timeout `connect`; -1 means "waiting for shutdown"
78 NetUpdatePending: Boolean; // should we send an update after connection completes?
79 lastDisconnectTime: Int64; // last real disconnect time; <0: do not reconnect
80 updateSent: Boolean; // was at least one update sent? (used to decide if we should call `remove()`)
81 lastUpdateTime: Int64;
82 // server list request working flags
83 srvAnswered: Integer;
84 srvAnswer: array of TNetServer;
85 slMOTD: AnsiString;
86 slUrgent: AnsiString;
87 slReadUrgent: Boolean;
88 // temporary mark
89 justAdded: Boolean;
90 connectCount: Integer;
92 private
93 netmsg: TMsg;
95 public
96 constructor Create (var ea: ENetAddress);
97 procedure finish ();
98 procedure cleanup ();
100 function setAddress (var ea: ENetAddress; hostStr: AnsiString): Boolean;
102 function isValid (): Boolean;
103 function isAlive (): Boolean; // not disconnected
104 function isConnecting (): Boolean; // is connection in progress?
105 function isConnected (): Boolean;
107 // call as often as you want, the object will do the rest
108 // but try to call this at least once in 100 msecs
109 procedure pulse ();
111 procedure disconnect (forced: Boolean);
112 function connect (): Boolean;
114 procedure update ();
115 procedure remove ();
117 class procedure writeInfo (var msg: TMsg); static;
119 procedure connectedEvent ();
120 procedure disconnectedEvent ();
121 procedure receivedEvent (pkt: pENetPacket); // `pkt` is never `nil`
122 end;
126 slCurrent: TNetServerList;
127 slTable: TNetServerTable;
128 slWaitStr: AnsiString;
129 slReturnPressed: Boolean = True;
131 slMOTD: AnsiString;
132 slUrgent: AnsiString;
134 NMASTER_FORCE_UPDATE_TIMEOUT: Integer = 0; // fuck you, fpc, and your idiotic "diagnostics"
137 procedure g_Net_Slist_Set (list: AnsiString);
138 function g_Net_Slist_Fetch (var SL: TNetServerList): Boolean;
140 // make this server private
141 procedure g_Net_Slist_Private ();
142 // make this server public
143 procedure g_Net_Slist_Public ();
145 // called while the server is running
146 procedure g_Net_Slist_ServerUpdate ();
147 // called when the server is started
148 procedure g_Net_Slist_ServerStarted ();
149 // called when the server is stopped
150 procedure g_Net_Slist_ServerClosed ();
152 // called when new netword player comes
153 procedure g_Net_Slist_ServerPlayerComes ();
154 // called when new netword player comes
155 procedure g_Net_Slist_ServerPlayerLeaves ();
156 // started new map
157 procedure g_Net_Slist_ServerMapStarted ();
158 // this server renamed (or password mode changed, or other params changed)
159 procedure g_Net_Slist_ServerRenamed ();
161 // non-zero timeout ignores current status (used to fetch server list)
162 procedure g_Net_Slist_Pulse (timeout: Integer=0);
164 procedure g_Net_Slist_ShutdownAll ();
166 procedure g_Serverlist_GenerateTable (SL: TNetServerList; var ST: TNetServerTable);
167 procedure g_Serverlist_Draw (var SL: TNetServerList; var ST: TNetServerTable);
168 procedure g_Serverlist_Control (var SL: TNetServerList; var ST: TNetServerTable);
170 function GetTimerMS (): Int64;
173 implementation
175 uses
176 {$IFDEF ENABLE_SOUND}
177 g_sound,
178 {$ENDIF}
179 e_input, e_graphics, e_log, g_window, g_net, g_console,
180 g_map, g_game, g_gui, g_menu, g_options, g_language, g_basic,
181 wadreader, g_system, utils, hashtable;
183 // ////////////////////////////////////////////////////////////////////////// //
185 type
186 THashStrDWord = specialize THashBase<AnsiString, LongWord, THashKeyStrAnsiCI>;
189 NetMHost: pENetHost;
190 NetMEvent: ENetEvent;
191 mlist: array of TMasterHost;
193 slSelection: Byte;
194 slFetched: Boolean;
195 slDirPressed: Boolean;
196 slReadUrgent: Boolean;
198 reportsEnabled: Boolean = True;
199 knownHosts: THashStrDWord;
201 //==========================================================================
203 // GetTimerMS
205 //==========================================================================
206 function GetTimerMS (): Int64;
207 begin
208 Result := sys_GetTicks() {div 1000};
209 end;
211 //==========================================================================
213 // findByPeer
215 //==========================================================================
216 function findByPeer (peer: pENetPeer): Integer;
218 f: Integer;
219 begin
220 for f := 0 to High(mlist) do
221 if (mlist[f].peer = peer) then
222 exit(f);
224 Result := -1;
225 end;
227 //==========================================================================
229 // ShutdownAll
231 //==========================================================================
232 procedure g_Net_Slist_ShutdownAll ();
234 f, sres, idx: Integer;
235 stt, ct: Int64;
236 activeCount: Integer = 0;
237 label // all this code is retarded anyway, so I feel no shame
238 discard;
239 begin
240 if (NetMHost = nil) then goto discard;
241 for f := 0 to High(mlist) do
242 begin
243 if (mlist[f].isAlive()) then
244 begin
245 Inc(activeCount);
246 if (mlist[f].isConnected() and mlist[f].updateSent) then
247 begin
248 writeln('unregistering from [', mlist[f].hostName, ']');
249 mlist[f].remove();
250 end;
251 //mlist[f].disconnect(false);
252 enet_peer_disconnect_later(mlist[f].peer, 0);
253 end;
254 end;
255 if (activeCount = 0) then goto discard;
256 stt := GetTimerMS();
257 while (activeCount > 0) do
258 begin
259 ct := GetTimerMS();
260 if (ct < stt) or (ct-stt >= 1500) then break;
262 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
263 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
264 // thank you, enet. let's ignore failures altogether then.
265 sres := enet_host_service(NetMHost, @NetMEvent, 100);
266 // if (sres < 0) then break;
267 if (sres <= 0) then continue;
269 idx := findByPeer(NetMEvent.peer);
270 if (idx < 0) then
271 begin
272 if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then enet_packet_destroy(NetMEvent.packet);
273 continue;
274 end;
276 if (NetMEvent.kind = ENET_EVENT_TYPE_CONNECT) then
277 begin
278 mlist[idx].connectedEvent();
279 //mlist[idx].disconnect(false);
280 enet_peer_disconnect(mlist[f].peer, 0);
282 else if (NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
283 begin
284 mlist[idx].disconnectedEvent();
285 Dec(activeCount);
287 else if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
288 begin
289 mlist[idx].receivedEvent(NetMEvent.packet);
290 enet_packet_destroy(NetMEvent.packet);
291 end;
292 end;
293 enet_host_destroy(NetMHost);
294 NetMHost := nil;
296 discard:
297 for f := 0 to High(mlist) do
298 mlist[f].finish();
299 SetLength(mlist, 0);
301 FreeAndNil(knownHosts);
302 end;
304 //==========================================================================
306 // DisconnectAll
308 //==========================================================================
309 procedure DisconnectAll (forced: Boolean=false);
311 f: Integer;
312 begin
313 for f := 0 to High(mlist) do
314 begin
315 if (mlist[f].isAlive()) then mlist[f].disconnect(forced);
316 end;
317 end;
319 //==========================================================================
321 // ConnectAll
323 //==========================================================================
324 procedure ConnectAll (sendUpdate: Boolean);
326 f: Integer;
327 begin
328 // set flags; pulse will take care of the rest
329 for f := 0 to High(mlist) do
330 begin
331 // force reconnect
332 mlist[f].lastDisconnectTime := 0;
333 // force updating
334 if (sendUpdate) then
335 begin
336 mlist[f].NetUpdatePending := true;
337 mlist[f].lastUpdateTime := 0;
338 end;
339 end;
340 end;
342 //==========================================================================
344 // UpdateAll
346 //==========================================================================
347 procedure UpdateAll (force: Boolean);
349 f: Integer;
350 begin
351 // set flags; pulse will take care of the rest
352 for f := 0 to High(mlist) do
353 begin
354 if (not mlist[f].isAlive()) then continue;
355 mlist[f].NetUpdatePending := true;
356 if (force) then mlist[f].lastUpdateTime := 0;
357 end;
358 end;
360 //**************************************************************************
362 // public api
364 //**************************************************************************
366 //==========================================================================
368 // g_Net_Slist_Private
370 // make this server private
372 //==========================================================================
373 procedure g_Net_Slist_Private ();
374 begin
375 DisconnectAll();
376 reportsEnabled := false;
377 end;
379 //==========================================================================
381 // g_Net_Slist_Public
383 // make this server public
385 //==========================================================================
386 procedure g_Net_Slist_Public ();
387 begin
388 if (not reportsEnabled) then
389 begin
390 reportsEnabled := true;
391 ConnectAll(true);
392 end;
393 end;
395 //==========================================================================
397 // g_Net_Slist_ServerUpdate
399 // called while the server is running
401 //==========================================================================
402 procedure g_Net_Slist_ServerUpdate ();
403 begin
404 UpdateAll(false);
405 end;
407 // called when the server is started
408 procedure g_Net_Slist_ServerStarted ();
409 begin
410 reportsEnabled := NetUseMaster;
411 if reportsEnabled and g_Game_IsServer() and g_Game_IsNet() then
412 begin
413 writeln('*** server started; reporting to master...');
414 ConnectAll(true);
415 end;
416 end;
418 //==========================================================================
420 // g_Net_Slist_ServerClosed
422 // called when the server is stopped
424 //==========================================================================
425 procedure g_Net_Slist_ServerClosed ();
427 f: Integer;
428 begin
429 if reportsEnabled then
430 begin
431 reportsEnabled := false;
432 for f := 0 to High(mlist) do
433 begin
434 if (mlist[f].isConnected()) then mlist[f].remove();
435 end;
436 end;
437 DisconnectAll();
438 end;
440 //==========================================================================
442 // g_Net_Slist_ServerPlayerComes
444 // called when new netword player comes
446 //==========================================================================
447 procedure g_Net_Slist_ServerPlayerComes ();
448 begin
449 UpdateAll(true);
450 end;
452 //==========================================================================
454 // g_Net_Slist_ServerPlayerLeaves
456 // called when new netword player comes
458 //==========================================================================
459 procedure g_Net_Slist_ServerPlayerLeaves ();
460 begin
461 UpdateAll(true);
462 end;
464 //==========================================================================
466 // g_Net_Slist_ServerMapStarted
468 // started new map
470 //==========================================================================
471 procedure g_Net_Slist_ServerMapStarted ();
472 begin
473 UpdateAll(true);
474 end;
476 //==========================================================================
478 // g_Net_Slist_ServerRenamed
480 // this server renamed (or password mode changed, or other params changed)
482 //==========================================================================
483 procedure g_Net_Slist_ServerRenamed ();
484 begin
485 UpdateAll(true);
486 end;
488 //**************************************************************************
490 // TMasterHost
492 //**************************************************************************
494 constructor TMasterHost.Create (var ea: ENetAddress);
495 begin
496 peer := nil;
497 NetHostConnected := false;
498 NetHostConReqTime := 0;
499 NetUpdatePending := false;
500 lastDisconnectTime := 0;
501 updateSent := false;
502 lastUpdateTime := 0;
503 hostName := '';
504 ZeroMemory(@enetAddr, sizeof(enetAddr));
505 SetLength(srvAnswer, 0);
506 srvAnswered := 0;
507 slMOTD := '';
508 slUrgent := '';
509 slReadUrgent := true;
510 justAdded := false;
511 connectCount := 0;
512 netmsg.Alloc(NET_BUFSIZE);
513 setAddress(ea, '');
514 end;
516 procedure TMasterHost.finish ();
517 begin
518 netmsg.Free();
519 end;
521 procedure TMasterHost.cleanup ();
522 begin
523 updateSent := False; // do not send 'remove'
524 disconnect(True);
525 hostName := '';
526 netmsg.Clear();
527 SetLength(srvAnswer, 0);
528 srvAnswered := 0;
529 slMOTD := '';
530 slUrgent := '';
531 slReadUrgent := True;
532 ZeroMemory(@enetAddr, sizeof(enetAddr));
533 end;
535 //==========================================================================
537 // TMasterHost.setAddress
539 //==========================================================================
540 function TMasterHost.setAddress (var ea: ENetAddress; hostStr: AnsiString): Boolean;
541 begin
542 result := false;
543 SetLength(srvAnswer, 0);
544 srvAnswered := 0;
545 slMOTD := '';
546 slUrgent := '';
547 slReadUrgent := true;
548 updateSent := false; // do not send 'remove'
549 disconnect(true);
550 hostName := '';
552 if (not g_Net_IsNetworkAvailable()) then exit;
554 enetAddr := ea;
555 if (enetAddr.host = 0) or (enetAddr.port = 0) then exit;
557 if (length(hostStr) > 0) then hostName := hostStr else hostName := IntToStr(enetAddr.host)+':'+IntToStr(ea.port);
559 result := isValid();
560 end;
562 //==========================================================================
564 // TMasterHost.isValid
566 //==========================================================================
567 function TMasterHost.isValid (): Boolean;
568 begin
569 result := (enetAddr.host <> 0) and (enetAddr.port <> 0);
570 end;
572 //==========================================================================
574 // TMasterHost.isAlive
576 // not disconnected
578 //==========================================================================
579 function TMasterHost.isAlive (): Boolean;
580 begin
581 result := (NetMHost <> nil) and (peer <> nil);
582 end;
584 //==========================================================================
586 // TMasterHost.isConnecting
588 // is connection in progress?
590 //==========================================================================
591 function TMasterHost.isConnecting (): Boolean;
592 begin
593 result := isAlive() and (not NetHostConnected) and (NetHostConReqTime <> -1);
594 end;
596 //==========================================================================
598 // TMasterHost.isConnected
600 //==========================================================================
601 function TMasterHost.isConnected (): Boolean;
602 begin
603 result := isAlive() and (NetHostConnected) and (NetHostConReqTime <> -1);
604 end;
606 //==========================================================================
608 // TMasterHost.connectedEvent
610 //==========================================================================
611 procedure TMasterHost.connectedEvent ();
612 begin
613 if not isAlive() then exit;
614 if NetHostConnected then exit;
615 NetHostConnected := true;
616 NetHostConReqTime := 0; // just in case
617 e_LogWritefln('connected to master at [%s]', [hostName], TMsgType.Notify);
618 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_CONN], [mlist[f].hostName]));
619 end;
621 //==========================================================================
623 // TMasterHost.disconnectedEvent
625 //==========================================================================
626 procedure TMasterHost.disconnectedEvent ();
627 begin
628 if not isAlive() then exit;
629 e_LogWritefln('disconnected from master at [%s]', [hostName], TMsgType.Notify);
630 disconnect(true);
631 //if (spamConsole) then g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_DISC], [hostName]));
632 end;
634 //==========================================================================
636 // TMasterHost.receivedEvent
638 // `pkt` is never `nil`
640 //==========================================================================
641 procedure TMasterHost.receivedEvent (pkt: pENetPacket);
643 msg: TMsg;
644 MID: Byte;
645 Cnt: Byte;
646 f: Integer;
647 s: AnsiString;
648 begin
649 e_LogWritefln('received packed from master at [%s]', [hostName], TMsgType.Notify);
650 if not msg.Init(pkt^.data, pkt^.dataLength, True) then exit;
651 // packet type
652 MID := msg.ReadByte();
653 if (MID <> NET_MMSG_GET) then exit;
654 e_LogWritefln('received list packet from master at [%s]', [hostName], TMsgType.Notify);
655 SetLength(srvAnswer, 0);
656 if (srvAnswered > 0) then Inc(srvAnswered);
657 slMOTD := '';
658 //slUrgent := '';
659 slReadUrgent := true;
660 // number of items
661 Cnt := msg.ReadByte();
662 //g_Console_Add(_lc[I_NET_MSG]+Format(_lc[I_NET_SLIST_RETRIEVED], [Cnt, hostName]), True);
663 e_LogWritefln('got %u server(s) from master at [%s]', [Cnt, hostName], TMsgType.Notify);
664 if (Cnt > 0) then
665 begin
666 SetLength(srvAnswer, Cnt);
667 for f := 0 to Cnt-1 do
668 begin
669 srvAnswer[f].Number := f;
670 srvAnswer[f].IP := msg.ReadString();
671 srvAnswer[f].Port := msg.ReadWord();
672 srvAnswer[f].Name := msg.ReadString();
673 srvAnswer[f].Map := msg.ReadString();
674 srvAnswer[f].GameMode := msg.ReadByte();
675 srvAnswer[f].Players := msg.ReadByte();
676 srvAnswer[f].MaxPlayers := msg.ReadByte();
677 srvAnswer[f].Protocol := msg.ReadByte();
678 srvAnswer[f].Password := msg.ReadByte() = 1;
679 enet_address_set_host(Addr(srvAnswer[f].PingAddr), PChar(Addr(srvAnswer[f].IP[1])));
680 srvAnswer[f].Ping := -1;
681 srvAnswer[f].PingAddr.port := NET_PING_PORT;
682 end;
683 end;
685 if (msg.ReadCount < msg.CurSize) then
686 begin
687 // new master, supports version reports
688 s := msg.ReadString();
689 if (s <> {MyVer}GAME_VERSION) then
690 begin
691 { TODO }
692 g_Console_Add('!!! UpdVer = `'+s+'`');
693 end;
694 // even newer master, supports extra info
695 if (msg.ReadCount < msg.CurSize) then
696 begin
697 slMOTD := b_Text_Format(msg.ReadString());
698 if (slMOTD <> '') then e_LogWritefln('got MOTD from master at [%s]: %s', [hostName, slMOTD], TMsgType.Notify);
699 s := b_Text_Format(msg.ReadString());
700 // check if the message has updated and the user has to read it again
701 if (slUrgent <> s) then slReadUrgent := false;
702 slUrgent := s;
703 if (s <> '') then e_LogWritefln('got urgent from master at [%s]: %s', [hostName, s], TMsgType.Notify);
704 end;
705 end;
706 end;
708 //==========================================================================
710 // TMasterHost.disconnect
712 //==========================================================================
713 procedure TMasterHost.disconnect (forced: Boolean);
714 begin
715 if isAlive() then
716 begin
717 lastDisconnectTime := GetTimerMS();
718 if forced or (not NetHostConnected) or (NetHostConReqTime = -1) then
719 begin
720 enet_peer_reset(peer);
721 peer := nil;
722 NetHostConReqTime := 0;
723 updateSent := false;
725 else
726 begin
727 enet_peer_disconnect_later(peer, 0);
728 // main pulse will take care of the rest
729 NetHostConReqTime := -1;
730 end;
732 else
733 begin
734 // just in case
735 NetHostConReqTime := 0;
736 updateSent := false;
737 end;
739 NetHostConnected := false;
740 NetUpdatePending := false;
741 lastUpdateTime := 0;
742 //if (spamConsole) then g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_DISC], [hostName]));
743 end;
745 //==========================================================================
747 // TMasterHost.connect
749 //==========================================================================
750 function TMasterHost.connect (): Boolean;
751 begin
752 result := false;
753 if not isValid() then exit;
754 if (NetHostConReqTime = -1) then
755 begin
756 disconnect(true);
757 if (NetHostConReqTime = -1) then e_LogWritefln('ketmar broke master [%s] logic! (000)', [hostName], TMsgType.Notify);
758 if (isAlive()) then e_LogWritefln('ketmar broke master [%s] logic! (001)', [hostName], TMsgType.Notify);
760 else
761 begin
762 if isAlive() then begin result := true; exit; end;
763 end;
765 lastDisconnectTime := GetTimerMS(); // why not?
766 SetLength(srvAnswer, 0);
767 srvAnswered := 0;
768 NetHostConnected := false;
769 NetHostConReqTime := 0;
770 NetUpdatePending := false;
771 updateSent := false;
772 lastUpdateTime := 0;
773 Inc(connectCount);
775 peer := enet_host_connect(NetMHost, @enetAddr, NET_MCHANS, 0);
776 if (peer = nil) then
777 begin
778 g_Console_Add(_lc[I_NET_MSG_ERROR]+_lc[I_NET_ERR_CLIENT], true);
779 exit;
780 end;
782 NetHostConReqTime := lastDisconnectTime;
783 e_LogWritefln('connecting to master at [%s]', [hostName], TMsgType.Notify);
784 end;
786 //==========================================================================
788 // TMasterHost.writeInfo
790 //==========================================================================
791 class procedure TMasterHost.writeInfo (var msg: TMsg);
793 wad, map: AnsiString;
794 begin
795 wad := g_ExtractWadNameNoPath(gMapInfo.Map);
796 map := g_ExtractFileName(gMapInfo.Map);
798 msg.Write(NetServerName);
800 msg.Write(wad+':/'+map);
801 msg.Write(gGameSettings.GameMode);
803 msg.Write(Byte(NetClientCount));
805 msg.Write(NetMaxClients);
807 msg.Write(Byte(NET_PROTOCOL_VER));
808 msg.Write(Byte(NetPassword <> ''));
809 end;
811 //==========================================================================
813 // TMasterHost.update
815 //==========================================================================
816 procedure TMasterHost.update ();
818 pkt: pENetPacket;
819 begin
820 if not isAlive() then exit;
821 if not isConnected() then
822 begin
823 NetUpdatePending := isConnecting();
824 exit;
825 end;
827 netmsg.Clear();
829 if reportsEnabled and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster then
830 begin
832 netmsg.Write(Byte(NET_MMSG_UPD));
833 netmsg.Write(NetAddr.port);
834 //writeln(formatstrf('%08x', [NetAddr.host]), ' : ', NetAddr.host);
836 writeInfo(netmsg);
838 pkt := enet_packet_create(netmsg.Data, netmsg.CurSize, ENET_PACKET_FLAG_RELIABLE);
839 if assigned(pkt) then
840 begin
841 if (enet_peer_send(peer, NET_MCHAN_UPD, pkt) = 0) then
842 begin
843 e_LogWritefln('sent update to master at [%s]', [hostName], TMsgType.Notify);
844 NetUpdatePending := false;
845 updateSent := true;
846 end;
847 end;
848 finally
849 netmsg.Clear();
850 end;
852 else
853 begin
854 NetUpdatePending := false;
855 end;
856 end;
858 //==========================================================================
860 // TMasterHost.remove
862 //==========================================================================
863 procedure TMasterHost.remove ();
865 pkt: pENetPacket;
866 begin
867 NetUpdatePending := false;
868 lastUpdateTime := 0;
869 updateSent := false;
870 if not isAlive() then exit;
871 if not isConnected() then exit;
873 netmsg.Clear();
875 netmsg.Write(Byte(NET_MMSG_DEL));
876 netmsg.Write(NetAddr.port);
878 pkt := enet_packet_create(netmsg.Data, netmsg.CurSize, ENET_PACKET_FLAG_RELIABLE);
879 if assigned(pkt) then
880 begin
881 enet_peer_send(peer, NET_MCHAN_MAIN, pkt);
882 end;
883 finally
884 netmsg.Clear();
885 end;
886 end;
888 //==========================================================================
890 // TMasterHost.pulse
892 // this performs various scheduled tasks, if necessary
894 //==========================================================================
895 procedure TMasterHost.pulse ();
897 ct: Int64;
898 mrate: Cardinal;
899 begin
900 if not isAlive() then exit;
901 if (NetHostConReqTime = -1) then exit; // waiting for shutdown (disconnect in progress)
902 ct := GetTimerMS();
903 // process pending connection timeout
904 if (not NetHostConnected) then
905 begin
906 if (ct < NetHostConReqTime) or (ct-NetHostConReqTime >= 1000*NMASTER_TIMEOUT_CONNECT) then
907 begin
908 e_LogWritefln('failed to connect to master at [%s]', [hostName], TMsgType.Notify);
909 // do not spam with error messages, it looks like the master is down
910 //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
911 disconnect(true);
912 end;
913 exit;
914 end;
915 // send update, if necessary
916 if (NetUpdatePending) then
917 begin
918 mrate := NetMasterRate;
919 if (mrate < 10000) then mrate := 10000
920 else if (mrate > 1000*60*10) then mrate := 1000*60*10;
921 if (NMASTER_FORCE_UPDATE_TIMEOUT > 0) then mrate := NMASTER_FORCE_UPDATE_TIMEOUT*1000;
922 if (lastUpdateTime = 0) or (ct < lastUpdateTime) or (ct-lastUpdateTime >= mrate) then
923 begin
924 //e_LogWritefln('update timeout: %d', [Integer(mrate)], TMsgType.Notify);
925 lastUpdateTime := ct;
926 update();
927 end;
928 end;
929 end;
931 //==========================================================================
933 // parseAddressPort
935 //==========================================================================
936 function parseAddressPort (var ea: ENetAddress; hostandport: AnsiString): Boolean;
938 cp, port: Integer;
939 hostName: AnsiString;
940 ip: LongWord;
941 begin
942 result := false;
943 if (not g_Net_IsNetworkAvailable()) then exit;
945 hostandport := Trim(hostandport);
946 if (length(hostandport) = 0) then exit;
948 hostName := hostandport;
949 port := 25665;
951 cp := Pos(':', hostandport);
952 if (cp > 0) then
953 begin
954 hostName := Trim(Copy(hostandport, 1, cp-1));
955 Delete(hostandport, 1, cp);
956 hostandport := Trim(hostandport);
957 if (length(hostandport) > 0) then
958 begin
960 port := StrToInt(hostandport);
961 except
962 port := -1;
963 end;
964 end;
965 end;
967 if (length(hostName) = 0) then exit;
968 if (port < 1) or (port > 65535) then exit;
970 if not assigned(knownHosts) then knownHosts := THashStrDWord.Create();
972 if knownHosts.get(hostName, ip) then
973 begin
974 ea.host := ip;
976 else
977 begin
978 if (enet_address_set_host(@ea, PChar(Addr(hostName[1]))) <> 0) then
979 begin
980 knownHosts.put(hostName, 0);
981 exit;
982 end;
983 knownHosts.put(hostName, ea.host);
984 end;
985 ea.Port := port;
986 result := true;
987 end;
989 //==========================================================================
991 // addMasterRecord
993 //==========================================================================
994 procedure addMasterRecord (var ea: ENetAddress; sa: AnsiString);
996 f: Integer;
997 freeIdx: Integer;
998 begin
999 freeIdx := -1;
1000 for f := 0 to High(mlist) do
1001 begin
1002 if (mlist[f].enetAddr.host = ea.host) and (mlist[f].enetAddr.port = ea.port) then
1003 begin
1004 mlist[f].justAdded := true;
1005 exit;
1006 end;
1007 if (freeIdx < 0) and (not mlist[f].isValid()) then freeIdx := f;
1008 end;
1009 if (freeIdx < 0) then
1010 begin
1011 freeIdx := length(mlist);
1012 SetLength(mlist, freeIdx+1);
1013 mlist[freeIdx].Create(ea);
1014 end;
1015 mlist[freeIdx].justAdded := true;
1016 mlist[freeIdx].setAddress(ea, sa);
1017 e_LogWritefln('added masterserver with address [%s]', [sa], TMsgType.Notify);
1018 end;
1020 //==========================================================================
1022 // g_Net_Slist_Set
1024 //==========================================================================
1025 procedure g_Net_Slist_Set (list: AnsiString);
1027 f, dest: Integer;
1028 sa: AnsiString;
1029 ea: ENetAddress;
1030 pp: Integer;
1031 begin
1032 if (not g_Net_IsNetworkAvailable()) then exit;
1034 for f := 0 to High(mlist) do mlist[f].justAdded := false;
1036 list := Trim(list);
1037 //writeln('list=[', list, ']');
1038 while (length(list) > 0) do
1039 begin
1040 pp := Pos(',', list);
1041 if (pp < 1) then pp := length(list)+1;
1042 sa := Trim(Copy(list, 1, pp-1));
1043 Delete(list, 1, pp);
1044 //writeln(' sa=[', sa, ']');
1045 if (length(sa) > 0) and parseAddressPort(ea, sa) then addMasterRecord(ea, sa);
1046 end;
1048 // remove unknown master servers
1049 dest := 0;
1050 for f := 0 to High(mlist) do
1051 begin
1052 if (not mlist[f].justAdded) then mlist[f].cleanup();
1053 if (mlist[f].isValid()) then
1054 begin
1055 if (dest < f) then
1056 begin
1057 mlist[dest].finish();
1058 mlist[dest] := mlist[f];
1059 end;
1060 dest += 1;
1061 end;
1062 end;
1063 SetLength(mlist, dest);
1064 end;
1066 //**************************************************************************
1068 // main pulse
1070 //**************************************************************************
1072 //==========================================================================
1074 // isMasterReportsEnabled
1076 //==========================================================================
1077 function isMasterReportsEnabled (): Boolean;
1078 begin
1079 result := (reportsEnabled and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster);
1080 end;
1082 //==========================================================================
1084 // g_Net_Slist_Pulse
1086 // non-zero timeout ignores current status (used to fetch server list)
1088 //==========================================================================
1089 procedure g_Net_Slist_Pulse (timeout: Integer=0);
1091 f: Integer;
1092 sres: Integer;
1093 idx: Integer;
1094 ct: Int64;
1095 isListQuery: Boolean;
1096 count: Integer;
1097 begin
1098 if (not g_Net_IsNetworkAvailable()) then exit;
1100 if (length(mlist) = 0) then
1101 begin
1102 if (NetMHost <> nil) then
1103 begin
1104 enet_host_destroy(NetMHost);
1105 NetMHost := nil;
1106 exit;
1107 end;
1108 end;
1110 if (NetMHost = nil) then
1111 begin
1112 NetMHost := enet_host_create(nil, 64, NET_MCHANS, 1024*1024, 1024*1024);
1113 if (NetMHost = nil) then
1114 begin
1115 e_LogWriteln(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT] + ' (host_create)', TMsgType.Notify);
1116 for f := 0 to High(mlist) do mlist[f].finish();
1117 SetLength(mlist, 0);
1118 Exit;
1119 end;
1120 end;
1122 isListQuery := (timeout > 0);
1123 ct := GetTimerMS();
1124 // reconnect/disconnect/pulse for each master
1125 for f := 0 to High(mlist) do
1126 begin
1127 if (not mlist[f].isValid()) then continue;
1128 if (not mlist[f].isAlive()) then
1129 begin
1130 // not connected; try to reconnect if we're asking for a host list, or we are in netgame, and we are the host
1131 if (not isListQuery) and isMasterReportsEnabled() then
1132 begin
1133 if (mlist[f].lastDisconnectTime = 0) or (ct < mlist[f].lastDisconnectTime) or (ct-mlist[f].lastDisconnectTime >= 1000*NMASTER_TIMEOUT_RECONNECT) then
1134 begin
1135 e_LogWritefln('reconnecting to master [%s]', [mlist[f].hostName], TMsgType.Notify);
1136 mlist[f].connect();
1138 else
1139 begin
1140 //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);
1141 end;
1142 end;
1144 else
1145 begin
1146 // if we're not in slist query, and not in netgame (or not a host), disconnect
1147 if (not isListQuery) and (not isMasterReportsEnabled()) then
1148 begin
1149 if (mlist[f].isConnected()) and (mlist[f].updateSent) then
1150 begin
1151 e_LogWritefln('removing from master [%s]', [mlist[f].hostName], TMsgType.Notify);
1152 mlist[f].remove();
1153 end;
1154 e_LogWritefln('disconnecting from master [%s]', [mlist[f].hostName], TMsgType.Notify);
1155 mlist[f].disconnect(false);
1156 end;
1157 end;
1158 mlist[f].pulse();
1159 end;
1161 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
1162 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
1163 // thank you, enet. let's ignore failures altogether then.
1164 count := 10; // no more than ten events in a row
1165 sres := enet_host_service(NetMHost, @NetMEvent, timeout);
1166 while (sres > 0) do
1167 begin
1169 if (sres < 0) then
1170 begin
1171 e_LogWriteln(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT] + ' (host_service)', TMsgType.Notify);
1172 for f := 0 to High(mlist) do mlist[f].finish();
1173 SetLength(mlist, 0);
1174 enet_host_destroy(NetMHost);
1175 NetMHost := nil;
1176 exit;
1177 end;
1180 idx := findByPeer(NetMEvent.peer);
1181 if (idx < 0) then
1182 begin
1183 e_LogWriteln('network event from unknown master host. ignored.', TMsgType.Warning);
1184 if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then enet_packet_destroy(NetMEvent.packet);
1186 else
1187 begin
1188 if (NetMEvent.kind = ENET_EVENT_TYPE_CONNECT) then
1189 begin
1190 mlist[idx].connectedEvent();
1192 else if (NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1193 begin
1194 mlist[idx].disconnectedEvent();
1196 else if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1197 begin
1198 mlist[idx].receivedEvent(NetMEvent.packet);
1199 enet_packet_destroy(NetMEvent.packet);
1200 end;
1201 end;
1203 Dec(count);
1204 if (count = 0) then break;
1205 sres := enet_host_service(NetMHost, @NetMEvent, 0);
1206 end;
1207 end;
1209 //**************************************************************************
1211 // gui and server list
1213 //**************************************************************************
1215 //==========================================================================
1217 // PingServer
1219 //==========================================================================
1220 procedure PingServer (var S: TNetServer; Sock: ENetSocket);
1222 Buf: ENetBuffer;
1223 Ping: array [0..9] of Byte;
1224 ClTime: Int64;
1225 begin
1226 ClTime := GetTimerMS();
1228 Buf.data := Addr(Ping[0]);
1229 Buf.dataLength := 2+8;
1231 Ping[0] := Ord('D');
1232 Ping[1] := Ord('F');
1233 Int64(Addr(Ping[2])^) := ClTime;
1235 enet_socket_send(Sock, Addr(S.PingAddr), @Buf, 1);
1236 end;
1238 //==========================================================================
1240 // PingBcast
1242 //==========================================================================
1243 procedure PingBcast (Sock: ENetSocket);
1245 S: TNetServer;
1246 begin
1247 S.IP := '255.255.255.255';
1248 S.Port := NET_PING_PORT;
1249 enet_address_set_host(Addr(S.PingAddr), PChar(Addr(S.IP[1])));
1250 S.Ping := -1;
1251 S.PingAddr.port := S.Port;
1252 PingServer(S, Sock);
1253 end;
1255 //==========================================================================
1257 // g_Net_Slist_Fetch
1259 //==========================================================================
1260 function g_Net_Slist_Fetch (var SL: TNetServerList): Boolean;
1262 Cnt: Byte;
1263 pkt: pENetPacket;
1264 I, RX: Integer;
1265 T: Int64;
1266 Sock: ENetSocket;
1267 Buf: ENetBuffer;
1268 InMsg: TMsg;
1269 SvAddr: ENetAddress;
1270 FromSL: Boolean;
1271 MyVer: AnsiString;
1273 procedure ProcessLocal ();
1274 begin
1275 I := Length(SL);
1276 SetLength(SL, I + 1);
1277 with SL[I] do
1278 begin
1279 IP := DecodeIPV4(SvAddr.host);
1280 Port := InMsg.ReadWord();
1281 Ping := InMsg.ReadInt64();
1282 Ping := GetTimerMS() - Ping;
1283 Name := InMsg.ReadString();
1284 Map := InMsg.ReadString();
1285 GameMode := InMsg.ReadByte();
1286 Players := InMsg.ReadByte();
1287 MaxPlayers := InMsg.ReadByte();
1288 Protocol := InMsg.ReadByte();
1289 Password := InMsg.ReadByte() = 1;
1290 LocalPl := InMsg.ReadByte();
1291 Bots := InMsg.ReadWord();
1292 end;
1293 end;
1295 procedure CheckLocalServers ();
1296 begin
1297 SetLength(SL, 0);
1299 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1300 if Sock = ENET_SOCKET_NULL then Exit;
1301 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
1302 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
1303 PingBcast(Sock);
1305 T := GetTimerMS();
1307 InMsg.Alloc(NET_BUFSIZE);
1308 Buf.data := InMsg.Data;
1309 Buf.dataLength := InMsg.MaxSize;
1310 while GetTimerMS() - T <= 500 do
1311 begin
1312 InMsg.Clear();
1314 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
1315 if RX <= 0 then continue;
1316 InMsg.CurSize := RX;
1318 InMsg.BeginReading();
1320 if InMsg.ReadChar() <> 'D' then continue;
1321 if InMsg.ReadChar() <> 'F' then continue;
1323 ProcessLocal();
1324 end;
1326 InMsg.Free();
1327 enet_socket_destroy(Sock);
1329 if Length(SL) = 0 then SL := nil;
1330 end;
1333 f, c, n, pos: Integer;
1334 aliveCount: Integer;
1335 hasUnanswered: Boolean;
1336 stt, ct: Int64;
1337 tmpsv: TNetServer;
1338 begin
1339 result := false;
1340 SL := nil;
1342 if (not g_Net_IsNetworkAvailable()) then
1343 begin
1344 SetLength(SL, 0);
1345 exit;
1346 end;
1348 g_Net_Slist_Pulse(); // this will create mhost
1350 DisconnectAll(true); // forced disconnect
1352 for f := 0 to High(mlist) do
1353 begin
1354 mlist[f].connectCount := 0;
1355 mlist[f].srvAnswered := 0;
1356 end;
1358 NetOut.Clear();
1359 NetOut.Write(Byte(NET_MMSG_GET));
1361 // TODO: what should we identify the build with?
1362 MyVer := GAME_VERSION;
1363 NetOut.Write(MyVer);
1366 e_WriteLog('Fetching serverlist...', TMsgType.Notify);
1367 g_Console_Add(_lc[I_NET_MSG]+_lc[I_NET_SLIST_FETCH]);
1369 // wait until all servers connected and answered
1370 stt := GetTimerMS();
1371 while true do
1372 begin
1373 aliveCount := 0;
1374 hasUnanswered := false;
1375 for f := 0 to High(mlist) do
1376 begin
1378 e_LogWritefln(' master #%d: [%s] valid=%d; alive=%d; connected=%d; connecting=%d',
1379 [f, mlist[f].hostName, Integer(mlist[f].isValid()), Integer(mlist[f].isAlive()),
1380 Integer(mlist[f].isConnected()), Integer(mlist[f].isConnecting())], TMsgType.Notify);
1382 if (not mlist[f].isValid()) then continue;
1383 if (not mlist[f].isAlive()) then
1384 begin
1385 if (mlist[f].connectCount = 0) then
1386 begin
1387 mlist[f].connect();
1388 if (mlist[f].isAlive()) then
1389 begin
1390 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_WCONN], [mlist[f].hostName]));
1391 hasUnanswered := true;
1392 stt := GetTimerMS();
1393 end;
1395 else if (mlist[f].srvAnswered > 1) then
1396 begin
1397 Inc(aliveCount);
1398 end;
1400 else if (mlist[f].isConnected()) then
1401 begin
1402 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_CONN], [mlist[f].hostName]));
1403 if (mlist[f].srvAnswered = 0) then
1404 begin
1405 pkt := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
1406 if assigned(pkt) then
1407 begin
1408 if (enet_peer_send(mlist[f].peer, NET_MCHAN_MAIN, pkt) = 0) then
1409 begin
1410 hasUnanswered := true;
1411 mlist[f].srvAnswered := 1;
1412 stt := GetTimerMS();
1413 end;
1414 end;
1416 else if (mlist[f].srvAnswered = 1) then
1417 begin
1418 hasUnanswered := true;
1420 else if (mlist[f].srvAnswered > 1) then
1421 begin
1422 Inc(aliveCount);
1423 mlist[f].disconnect(false); // not forced
1424 end;
1426 else if (mlist[f].isConnecting()) then
1427 begin
1428 hasUnanswered := true;
1429 end;
1430 end;
1431 if (not hasUnanswered) then break;
1432 // check for timeout
1433 ct := GetTimerMS();
1434 if (ct < stt) or (ct-stt > 4000) then break;
1435 g_Net_Slist_Pulse(300);
1436 end;
1438 if (aliveCount = 0) then
1439 begin
1440 DisconnectAll();
1441 CheckLocalServers();
1442 exit;
1443 end;
1445 Result := True;
1446 slMOTD := '';
1448 slUrgent := '';
1449 slReadUrgent := true;
1452 SetLength(SL, 0);
1453 for f := 0 to High(mlist) do
1454 begin
1455 if (mlist[f].srvAnswered < 2) then continue;
1456 for n := 0 to High(mlist[f].srvAnswer) do
1457 begin
1458 pos := -1;
1459 for c := 0 to High(SL) do
1460 begin
1461 if (SL[c].IP = mlist[f].srvAnswer[n].IP) and (SL[c].Port = mlist[f].srvAnswer[n].Port) then
1462 begin
1463 pos := c;
1464 break;
1465 end;
1466 end;
1467 if (pos < 0) then
1468 begin
1469 pos := length(SL);
1470 SetLength(SL, pos+1);
1471 SL[pos] := mlist[f].srvAnswer[n];
1472 SL[pos].Number := pos;
1473 end;
1474 end;
1475 if (not mlist[f].slReadUrgent) and (mlist[f].slUrgent <> '') then
1476 begin
1477 if (mlist[f].slUrgent <> slUrgent) then
1478 begin
1479 slUrgent := mlist[f].slUrgent;
1480 slReadUrgent := false;
1481 end;
1482 end;
1483 if (slMOTD <> '') and (mlist[f].slMOTD <> '') then
1484 begin
1485 slMOTD := mlist[f].slMOTD;
1486 end;
1487 end;
1489 DisconnectAll();
1491 if (length(SL) = 0) then
1492 begin
1493 CheckLocalServers();
1494 exit;
1495 end;
1497 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1498 if Sock = ENET_SOCKET_NULL then Exit;
1499 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
1501 for I := Low(SL) to High(SL) do PingServer(SL[I], Sock);
1503 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
1504 PingBcast(Sock);
1506 T := GetTimerMS();
1508 InMsg.Alloc(NET_BUFSIZE);
1509 Buf.data := InMsg.Data;
1510 Buf.dataLength := InMsg.MaxSize;
1511 Cnt := 0;
1512 while GetTimerMS() - T <= 500 do
1513 begin
1514 InMsg.Clear();
1516 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
1517 if RX <= 0 then continue;
1518 InMsg.CurSize := RX;
1520 InMsg.BeginReading();
1522 if InMsg.ReadChar() <> 'D' then continue;
1523 if InMsg.ReadChar() <> 'F' then continue;
1525 with tmpsv do
1526 begin
1527 Port := InMsg.ReadWord();
1528 Ping := InMsg.ReadInt64();
1529 Ping := GetTimerMS() - Ping;
1530 Name := InMsg.ReadString();
1531 Map := InMsg.ReadString();
1532 GameMode := InMsg.ReadByte();
1533 Players := InMsg.ReadByte();
1534 MaxPlayers := InMsg.ReadByte();
1535 Protocol := InMsg.ReadByte();
1536 Password := InMsg.ReadByte() = 1;
1537 LocalPl := InMsg.ReadByte();
1538 Bots := InMsg.ReadWord();
1539 PingAddr := SvAddr;
1540 end;
1542 FromSL := False;
1543 for I := Low(SL) to High(SL) do
1544 if (SL[I].PingAddr.host = SvAddr.host) and
1545 (SL[I].PingAddr.port = SvAddr.port) and
1546 (SL[I].Port = tmpsv.Port) and
1547 (SL[I].Name = tmpsv.Name) then
1548 begin
1549 tmpsv.IP := SL[I].IP;
1550 SL[I] := tmpsv;
1551 FromSL := True;
1552 Inc(Cnt);
1553 break;
1554 end;
1556 if not FromSL then
1557 begin
1558 I := Length(SL);
1559 SetLength(SL, I + 1);
1560 tmpsv.IP := DecodeIPV4(SvAddr.host);
1561 SL[I] := tmpsv;
1562 end;
1563 end;
1565 InMsg.Free();
1566 enet_socket_destroy(Sock);
1567 finally
1568 NetOut.Clear();
1569 end;
1570 end;
1572 //==========================================================================
1574 // GetServerFromTable
1576 //==========================================================================
1577 function GetServerFromTable (Index: Integer; SL: TNetServerList; ST: TNetServerTable): TNetServer;
1578 begin
1579 Result.Number := 0;
1580 Result.Protocol := 0;
1581 Result.Name := '';
1582 Result.IP := '';
1583 Result.Port := 0;
1584 Result.Map := '';
1585 Result.Players := 0;
1586 Result.MaxPlayers := 0;
1587 Result.LocalPl := 0;
1588 Result.Bots := 0;
1589 Result.Ping := 0;
1590 Result.GameMode := 0;
1591 Result.Password := false;
1592 FillChar(Result.PingAddr, SizeOf(ENetAddress), 0);
1593 if ST = nil then
1594 Exit;
1595 if (Index < 0) or (Index >= Length(ST)) then
1596 Exit;
1597 Result := SL[ST[Index].Indices[ST[Index].Current]];
1598 end;
1600 //==========================================================================
1602 // g_Serverlist_Draw
1604 //==========================================================================
1605 procedure g_Serverlist_Draw (var SL: TNetServerList; var ST: TNetServerTable);
1607 Srv: TNetServer;
1608 sy, i, y, mw, mx, l, motdh: Integer;
1609 cw: Byte = 0;
1610 ch: Byte = 0;
1611 ww: Word = 0;
1612 hh: Word = 0;
1613 ip: AnsiString;
1614 begin
1615 ip := '';
1616 sy := 0;
1618 e_CharFont_GetSize(gMenuFont, _lc[I_NET_SLIST], ww, hh);
1619 e_CharFont_Print(gMenuFont, (gScreenWidth div 2) - (ww div 2), 16, _lc[I_NET_SLIST]);
1621 e_TextureFontGetSize(gStdFont, cw, ch);
1623 ip := _lc[I_NET_SLIST_HELP];
1624 mw := (Length(ip) * cw) div 2;
1626 motdh := gScreenHeight - 49 - ch * b_Text_LineCount(slMOTD);
1628 e_DrawFillQuad(16, 64, gScreenWidth-16, motdh, 64, 64, 64, 110);
1629 e_DrawQuad(16, 64, gScreenWidth-16, motdh, 255, 127, 0);
1631 e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
1633 // MOTD
1634 if slMOTD <> '' then
1635 begin
1636 e_DrawFillQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
1637 e_DrawQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
1638 e_TextureFontPrintFmt(20, motdh + 3, slMOTD, gStdFont, False, True);
1639 end;
1641 // Urgent message
1642 if not slReadUrgent and (slUrgent <> '') then
1643 begin
1644 e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
1645 e_DrawFillQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
1646 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 64, 64, 64, 128);
1647 e_DrawQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
1648 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 255, 127, 0);
1649 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 - 40,
1650 gScreenWidth div 2 + 256, gScreenHeight div 2 - 40, 255, 127, 0);
1651 l := Length(_lc[I_NET_SLIST_URGENT]) div 2;
1652 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - 58,
1653 _lc[I_NET_SLIST_URGENT], gStdFont);
1654 l := Length(slUrgent) div 2;
1655 e_TextureFontPrintFmt(gScreenWidth div 2 - 253, gScreenHeight div 2 - 38,
1656 slUrgent, gStdFont, False, True);
1657 l := Length(_lc[I_NET_SLIST_URGENT_CONT]) div 2;
1658 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 + 41,
1659 _lc[I_NET_SLIST_URGENT_CONT], gStdFont);
1660 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 + 40,
1661 gScreenWidth div 2 + 256, gScreenHeight div 2 + 40, 255, 127, 0);
1662 Exit;
1663 end;
1665 if SL = nil then
1666 begin
1667 l := Length(slWaitStr) div 2;
1668 e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
1669 e_DrawQuad(gScreenWidth div 2 - 192, gScreenHeight div 2 - 10,
1670 gScreenWidth div 2 + 192, gScreenHeight div 2 + 11, 255, 127, 0);
1671 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - ch div 2,
1672 slWaitStr, gStdFont);
1673 Exit;
1674 end;
1676 y := 90;
1677 if (slSelection < Length(ST)) then
1678 begin
1679 I := slSelection;
1680 sy := y + 42 * I - 4;
1681 Srv := GetServerFromTable(I, SL, ST);
1682 ip := _lc[I_NET_ADDRESS] + ' ' + Srv.IP + ':' + IntToStr(Srv.Port);
1683 if Srv.Password then
1684 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_YES]
1685 else
1686 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_NO];
1687 end else
1688 if Length(ST) > 0 then
1689 slSelection := 0;
1691 mw := (gScreenWidth - 188);
1692 mx := 16 + mw;
1694 e_DrawFillQuad(16 + 1, sy, gScreenWidth - 16 - 1, sy + 40, 64, 64, 64, 0);
1695 e_DrawLine(1, 16 + 1, sy, gScreenWidth - 16 - 1, sy, 205, 205, 205);
1696 e_DrawLine(1, 16 + 1, sy + 41, gScreenWidth - 16 - 1, sy + 41, 255, 255, 255);
1698 e_DrawLine(1, 16, 85, gScreenWidth - 16, 85, 255, 127, 0);
1699 e_DrawLine(1, 16, motdh-20, gScreenWidth-16, motdh-20, 255, 127, 0);
1701 e_DrawLine(1, mx - 70, 64, mx - 70, motdh, 255, 127, 0);
1702 e_DrawLine(1, mx, 64, mx, motdh-20, 255, 127, 0);
1703 e_DrawLine(1, mx + 52, 64, mx + 52, motdh-20, 255, 127, 0);
1704 e_DrawLine(1, mx + 104, 64, mx + 104, motdh-20, 255, 127, 0);
1706 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
1707 e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
1708 e_TextureFontPrintEx(mx + 2, 68, 'MODE', gStdFont, 255, 127, 0, 1);
1709 e_TextureFontPrintEx(mx + 54, 68, 'PLRS', gStdFont, 255, 127, 0, 1);
1710 e_TextureFontPrintEx(mx + 106, 68, 'VER', gStdFont, 255, 127, 0, 1);
1712 y := 90;
1713 for I := 0 to High(ST) do
1714 begin
1715 Srv := GetServerFromTable(I, SL, ST);
1716 // Name and map
1717 e_TextureFontPrintEx(18, y, Srv.Name, gStdFont, 255, 255, 255, 1);
1718 e_TextureFontPrintEx(18, y + 16, Srv.Map, gStdFont, 210, 210, 210, 1);
1720 // Ping and similar count
1721 if (Srv.Ping < 0) or (Srv.Ping > 999) then
1722 e_TextureFontPrintEx(mx - 68, y, _lc[I_NET_SLIST_NO_ACCESS], gStdFont, 255, 0, 0, 1)
1723 else
1724 if Srv.Ping = 0 then
1725 e_TextureFontPrintEx(mx - 68, y, '<1' + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1)
1726 else
1727 e_TextureFontPrintEx(mx - 68, y, IntToStr(Srv.Ping) + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1);
1729 if Length(ST[I].Indices) > 1 then
1730 e_TextureFontPrintEx(mx - 68, y + 16, '< ' + IntToStr(Length(ST[I].Indices)) + ' >', gStdFont, 210, 210, 210, 1);
1732 // Game mode
1733 e_TextureFontPrintEx(mx + 2, y, g_Game_ModeToText(Srv.GameMode), gStdFont, 255, 255, 255, 1);
1735 // Players
1736 e_TextureFontPrintEx(mx + 54, y, IntToStr(Srv.Players) + '/' + IntToStr(Srv.MaxPlayers), gStdFont, 255, 255, 255, 1);
1737 e_TextureFontPrintEx(mx + 54, y + 16, IntToStr(Srv.LocalPl) + '+' + IntToStr(Srv.Bots), gStdFont, 210, 210, 210, 1);
1739 // Version
1740 e_TextureFontPrintEx(mx + 106, y, IntToStr(Srv.Protocol), gStdFont, 255, 255, 255, 1);
1742 y := y + 42;
1743 end;
1745 e_TextureFontPrintEx(20, motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
1746 ip := IntToStr(Length(ST)) + _lc[I_NET_SLIST_SERVERS];
1747 e_TextureFontPrintEx(gScreenWidth - 48 - (Length(ip) + 1)*cw,
1748 motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
1749 end;
1751 //==========================================================================
1753 // g_Serverlist_GenerateTable
1755 //==========================================================================
1756 procedure g_Serverlist_GenerateTable (SL: TNetServerList; var ST: TNetServerTable);
1758 i, j: Integer;
1760 function FindServerInTable(Name: AnsiString; Port: Word): Integer;
1762 i: Integer;
1763 begin
1764 Result := -1;
1765 if ST = nil then
1766 Exit;
1767 for i := Low(ST) to High(ST) do
1768 begin
1769 if Length(ST[i].Indices) = 0 then
1770 continue;
1771 if (SL[ST[i].Indices[0]].Name = Name) and (SL[ST[i].Indices[0]].Port = Port) then
1772 begin
1773 Result := i;
1774 Exit;
1775 end;
1776 end;
1777 end;
1778 function ComparePing(i1, i2: Integer): Boolean;
1780 p1, p2: Int64;
1781 begin
1782 p1 := SL[i1].Ping;
1783 p2 := SL[i2].Ping;
1784 if (p1 < 0) then p1 := 999;
1785 if (p2 < 0) then p2 := 999;
1786 Result := p1 > p2;
1787 end;
1788 procedure SortIndices(var ind: Array of Integer);
1790 I, J: Integer;
1791 T: Integer;
1792 begin
1793 for I := High(ind) downto Low(ind) do
1794 for J := Low(ind) to High(ind) - 1 do
1795 if ComparePing(ind[j], ind[j+1]) then
1796 begin
1797 T := ind[j];
1798 ind[j] := ind[j+1];
1799 ind[j+1] := T;
1800 end;
1801 end;
1802 procedure SortRows();
1804 I, J: Integer;
1805 T: TNetServerRow;
1806 begin
1807 for I := High(ST) downto Low(ST) do
1808 for J := Low(ST) to High(ST) - 1 do
1809 if ComparePing(ST[j].Indices[0], ST[j+1].Indices[0]) then
1810 begin
1811 T := ST[j];
1812 ST[j] := ST[j+1];
1813 ST[j+1] := T;
1814 end;
1815 end;
1816 begin
1817 ST := nil;
1818 if SL = nil then
1819 Exit;
1821 for i := Low(SL) to High(SL) do
1822 begin
1823 j := FindServerInTable(SL[i].Name, SL[i].Port);
1824 if j = -1 then
1825 begin
1826 j := Length(ST);
1827 SetLength(ST, j + 1);
1828 ST[j].Current := 0;
1829 SetLength(ST[j].Indices, 1);
1830 ST[j].Indices[0] := i;
1832 else
1833 begin
1834 SetLength(ST[j].Indices, Length(ST[j].Indices) + 1);
1835 ST[j].Indices[High(ST[j].Indices)] := i;
1836 end;
1837 end;
1839 for i := Low(ST) to High(ST) do
1840 SortIndices(ST[i].Indices);
1842 SortRows();
1843 end;
1845 //==========================================================================
1847 // g_Serverlist_Control
1849 //==========================================================================
1850 procedure g_Serverlist_Control (var SL: TNetServerList; var ST: TNetServerTable);
1852 qm: Boolean;
1853 Srv: TNetServer;
1854 begin
1855 g_Net_Slist_Pulse();
1857 if gConsoleShow or gChatShow then
1858 Exit;
1860 qm := sys_HandleEvents(); // this updates kbd
1862 if qm or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
1863 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or
1864 e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
1865 begin
1866 SL := nil;
1867 ST := nil;
1868 gState := STATE_MENU;
1869 g_GUI_ShowWindow('MainMenu');
1870 g_GUI_ShowWindow('NetGameMenu');
1871 g_GUI_ShowWindow('NetClientMenu');
1872 {$IFDEF ENABLE_SOUND}
1873 g_Sound_PlayEx(WINDOW_CLOSESOUND);
1874 {$ENDIF}
1875 Exit;
1876 end;
1878 // if there's a message on the screen,
1879 if not slReadUrgent and (slUrgent <> '') then
1880 begin
1881 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(IK_SELECT) or
1882 e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1883 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1884 slReadUrgent := True;
1885 Exit;
1886 end;
1888 if e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_JUMP) or
1889 e_KeyPressed(JOY0_ACTIVATE) or e_KeyPressed(JOY1_ACTIVATE) or e_KeyPressed(JOY2_ACTIVATE) or e_KeyPressed(JOY3_ACTIVATE) then
1890 begin
1891 if not slFetched then
1892 begin
1893 slWaitStr := _lc[I_NET_SLIST_WAIT];
1895 g_Game_Draw;
1896 sys_Repaint;
1898 if g_Net_Slist_Fetch(SL) then
1899 begin
1900 if SL = nil then
1901 slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
1903 else
1904 if SL = nil then
1905 slWaitStr := _lc[I_NET_SLIST_ERROR];
1906 slFetched := True;
1907 slSelection := 0;
1908 g_Serverlist_GenerateTable(SL, ST);
1909 end;
1911 else
1912 slFetched := False;
1914 if SL = nil then Exit;
1916 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(IK_SELECT) or
1917 e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1918 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1919 begin
1920 if not slReturnPressed then
1921 begin
1922 Srv := GetServerFromTable(slSelection, SL, ST);
1923 if Srv.Password then
1924 begin
1925 PromptIP := Srv.IP;
1926 PromptPort := Srv.Port;
1927 gState := STATE_MENU;
1928 g_GUI_ShowWindow('ClientPasswordMenu');
1929 SL := nil;
1930 ST := nil;
1931 slReturnPressed := True;
1932 Exit;
1934 else
1935 g_Game_StartClient(Srv.IP, Srv.Port, '');
1936 SL := nil;
1937 ST := nil;
1938 slReturnPressed := True;
1939 Exit;
1940 end;
1942 else
1943 slReturnPressed := False;
1945 if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) or e_KeyPressed(VK_DOWN) or
1946 e_KeyPressed(JOY0_DOWN) or e_KeyPressed(JOY1_DOWN) or e_KeyPressed(JOY2_DOWN) or e_KeyPressed(JOY3_DOWN) then
1947 begin
1948 if not slDirPressed then
1949 begin
1950 Inc(slSelection);
1951 if slSelection > High(ST) then slSelection := 0;
1952 slDirPressed := True;
1953 end;
1954 end;
1956 if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) or e_KeyPressed(VK_UP) or
1957 e_KeyPressed(JOY0_UP) or e_KeyPressed(JOY1_UP) or e_KeyPressed(JOY2_UP) or e_KeyPressed(JOY3_UP) then
1958 begin
1959 if not slDirPressed then
1960 begin
1961 if slSelection = 0 then slSelection := Length(ST);
1962 Dec(slSelection);
1964 slDirPressed := True;
1965 end;
1966 end;
1968 if e_KeyPressed(IK_RIGHT) or e_KeyPressed(IK_KPRIGHT) or e_KeyPressed(VK_RIGHT) or
1969 e_KeyPressed(JOY0_RIGHT) or e_KeyPressed(JOY1_RIGHT) or e_KeyPressed(JOY2_RIGHT) or e_KeyPressed(JOY3_RIGHT) then
1970 begin
1971 if not slDirPressed then
1972 begin
1973 Inc(ST[slSelection].Current);
1974 if ST[slSelection].Current > High(ST[slSelection].Indices) then ST[slSelection].Current := 0;
1975 slDirPressed := True;
1976 end;
1977 end;
1979 if e_KeyPressed(IK_LEFT) or e_KeyPressed(IK_KPLEFT) or e_KeyPressed(VK_LEFT) or
1980 e_KeyPressed(JOY0_LEFT) or e_KeyPressed(JOY1_LEFT) or e_KeyPressed(JOY2_LEFT) or e_KeyPressed(JOY3_LEFT) then
1981 begin
1982 if not slDirPressed then
1983 begin
1984 if ST[slSelection].Current = 0 then ST[slSelection].Current := Length(ST[slSelection].Indices);
1985 Dec(ST[slSelection].Current);
1987 slDirPressed := True;
1988 end;
1989 end;
1991 if (not e_KeyPressed(IK_DOWN)) and
1992 (not e_KeyPressed(IK_UP)) and
1993 (not e_KeyPressed(IK_RIGHT)) and
1994 (not e_KeyPressed(IK_LEFT)) and
1995 (not e_KeyPressed(IK_KPDOWN)) and
1996 (not e_KeyPressed(IK_KPUP)) and
1997 (not e_KeyPressed(IK_KPRIGHT)) and
1998 (not e_KeyPressed(IK_KPLEFT)) and
1999 (not e_KeyPressed(VK_DOWN)) and
2000 (not e_KeyPressed(VK_UP)) and
2001 (not e_KeyPressed(VK_RIGHT)) and
2002 (not e_KeyPressed(VK_LEFT)) and
2003 (not e_KeyPressed(JOY0_UP)) and (not e_KeyPressed(JOY1_UP)) and (not e_KeyPressed(JOY2_UP)) and (not e_KeyPressed(JOY3_UP)) and
2004 (not e_KeyPressed(JOY0_DOWN)) and (not e_KeyPressed(JOY1_DOWN)) and (not e_KeyPressed(JOY2_DOWN)) and (not e_KeyPressed(JOY3_DOWN)) and
2005 (not e_KeyPressed(JOY0_LEFT)) and (not e_KeyPressed(JOY1_LEFT)) and (not e_KeyPressed(JOY2_LEFT)) and (not e_KeyPressed(JOY3_LEFT)) and
2006 (not e_KeyPressed(JOY0_RIGHT)) and (not e_KeyPressed(JOY1_RIGHT)) and (not e_KeyPressed(JOY2_RIGHT)) and (not e_KeyPressed(JOY3_RIGHT))
2007 then
2008 slDirPressed := False;
2009 end;
2011 end.