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
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}
22 ENet
, SysUtils
, e_msg
;
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;
50 Players
, MaxPlayers
, LocalPl
, Bots
: Byte;
54 PingAddr
: ENetAddress
;
56 pTNetServer
= ^TNetServer
;
57 TNetServerRow
= record
58 Indices
: Array of Integer;
62 TNetServerList
= array of TNetServer
;
63 pTNetServerList
= ^TNetServerList
;
64 TNetServerTable
= array of TNetServerRow
;
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
84 srvAnswer
: array of TNetServer
;
87 slReadUrgent
: Boolean;
90 connectCount
: Integer;
96 constructor Create (var ea
: ENetAddress
);
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
111 procedure disconnect (forced
: Boolean);
112 function connect (): Boolean;
117 class procedure writeInfo (var msg
: TMsg
); static
;
119 procedure connectedEvent ();
120 procedure disconnectedEvent ();
121 procedure receivedEvent (pkt
: pENetPacket
); // `pkt` is never `nil`
126 slCurrent
: TNetServerList
;
127 slTable
: TNetServerTable
;
128 slWaitStr
: AnsiString
;
129 slReturnPressed
: Boolean = True;
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 ();
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;
176 {$IFDEF ENABLE_SOUND}
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 // ////////////////////////////////////////////////////////////////////////// //
186 THashStrDWord
= specialize THashBase
<AnsiString
, LongWord
, THashKeyStrAnsiCI
>;
190 NetMEvent
: ENetEvent
;
191 mlist
: array of TMasterHost
;
195 slDirPressed
: Boolean;
196 slReadUrgent
: Boolean;
198 reportsEnabled
: Boolean = True;
199 knownHosts
: THashStrDWord
;
201 //==========================================================================
205 //==========================================================================
206 function GetTimerMS (): Int64;
208 Result
:= sys_GetTicks() {div 1000};
211 //==========================================================================
215 //==========================================================================
216 function findByPeer (peer
: pENetPeer
): Integer;
220 for f
:= 0 to High(mlist
) do
221 if (mlist
[f
].peer
= peer
) then
227 //==========================================================================
231 //==========================================================================
232 procedure g_Net_Slist_ShutdownAll ();
234 f
, sres
, idx
: Integer;
236 activeCount
: Integer = 0;
237 label // all this code is retarded anyway, so I feel no shame
240 if (NetMHost
= nil) then goto discard
;
241 for f
:= 0 to High(mlist
) do
243 if (mlist
[f
].isAlive()) then
246 if (mlist
[f
].isConnected() and mlist
[f
].updateSent
) then
248 writeln('unregistering from [', mlist
[f
].hostName
, ']');
251 //mlist[f].disconnect(false);
252 enet_peer_disconnect_later(mlist
[f
].peer
, 0);
255 if (activeCount
= 0) then goto discard
;
257 while (activeCount
> 0) do
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
);
272 if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then enet_packet_destroy(NetMEvent
.packet
);
276 if (NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
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
284 mlist
[idx
].disconnectedEvent();
287 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
289 mlist
[idx
].receivedEvent(NetMEvent
.packet
);
290 enet_packet_destroy(NetMEvent
.packet
);
293 enet_host_destroy(NetMHost
);
297 for f
:= 0 to High(mlist
) do
301 FreeAndNil(knownHosts
);
304 //==========================================================================
308 //==========================================================================
309 procedure DisconnectAll (forced
: Boolean=false);
313 for f
:= 0 to High(mlist
) do
315 if (mlist
[f
].isAlive()) then mlist
[f
].disconnect(forced
);
319 //==========================================================================
323 //==========================================================================
324 procedure ConnectAll (sendUpdate
: Boolean);
328 // set flags; pulse will take care of the rest
329 for f
:= 0 to High(mlist
) do
332 mlist
[f
].lastDisconnectTime
:= 0;
336 mlist
[f
].NetUpdatePending
:= true;
337 mlist
[f
].lastUpdateTime
:= 0;
342 //==========================================================================
346 //==========================================================================
347 procedure UpdateAll (force
: Boolean);
351 // set flags; pulse will take care of the rest
352 for f
:= 0 to High(mlist
) do
354 if (not mlist
[f
].isAlive()) then continue
;
355 mlist
[f
].NetUpdatePending
:= true;
356 if (force
) then mlist
[f
].lastUpdateTime
:= 0;
360 //**************************************************************************
364 //**************************************************************************
366 //==========================================================================
368 // g_Net_Slist_Private
370 // make this server private
372 //==========================================================================
373 procedure g_Net_Slist_Private ();
376 reportsEnabled
:= false;
379 //==========================================================================
381 // g_Net_Slist_Public
383 // make this server public
385 //==========================================================================
386 procedure g_Net_Slist_Public ();
388 if (not reportsEnabled
) then
390 reportsEnabled
:= true;
395 //==========================================================================
397 // g_Net_Slist_ServerUpdate
399 // called while the server is running
401 //==========================================================================
402 procedure g_Net_Slist_ServerUpdate ();
407 // called when the server is started
408 procedure g_Net_Slist_ServerStarted ();
410 reportsEnabled
:= NetUseMaster
;
411 if reportsEnabled
and g_Game_IsServer() and g_Game_IsNet() then
413 writeln('*** server started; reporting to master...');
418 //==========================================================================
420 // g_Net_Slist_ServerClosed
422 // called when the server is stopped
424 //==========================================================================
425 procedure g_Net_Slist_ServerClosed ();
429 if reportsEnabled
then
431 reportsEnabled
:= false;
432 for f
:= 0 to High(mlist
) do
434 if (mlist
[f
].isConnected()) then mlist
[f
].remove();
440 //==========================================================================
442 // g_Net_Slist_ServerPlayerComes
444 // called when new netword player comes
446 //==========================================================================
447 procedure g_Net_Slist_ServerPlayerComes ();
452 //==========================================================================
454 // g_Net_Slist_ServerPlayerLeaves
456 // called when new netword player comes
458 //==========================================================================
459 procedure g_Net_Slist_ServerPlayerLeaves ();
464 //==========================================================================
466 // g_Net_Slist_ServerMapStarted
470 //==========================================================================
471 procedure g_Net_Slist_ServerMapStarted ();
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 ();
488 //**************************************************************************
492 //**************************************************************************
494 constructor TMasterHost
.Create (var ea
: ENetAddress
);
497 NetHostConnected
:= false;
498 NetHostConReqTime
:= 0;
499 NetUpdatePending
:= false;
500 lastDisconnectTime
:= 0;
504 ZeroMemory(@enetAddr
, sizeof(enetAddr
));
505 SetLength(srvAnswer
, 0);
509 slReadUrgent
:= true;
512 netmsg
.Alloc(NET_BUFSIZE
);
516 procedure TMasterHost
.finish ();
521 procedure TMasterHost
.cleanup ();
523 updateSent
:= False; // do not send 'remove'
527 SetLength(srvAnswer
, 0);
531 slReadUrgent
:= True;
532 ZeroMemory(@enetAddr
, sizeof(enetAddr
));
535 //==========================================================================
537 // TMasterHost.setAddress
539 //==========================================================================
540 function TMasterHost
.setAddress (var ea
: ENetAddress
; hostStr
: AnsiString
): Boolean;
543 SetLength(srvAnswer
, 0);
547 slReadUrgent
:= true;
548 updateSent
:= false; // do not send 'remove'
552 if (not g_Net_IsNetworkAvailable()) then exit
;
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
);
562 //==========================================================================
564 // TMasterHost.isValid
566 //==========================================================================
567 function TMasterHost
.isValid (): Boolean;
569 result
:= (enetAddr
.host
<> 0) and (enetAddr
.port
<> 0);
572 //==========================================================================
574 // TMasterHost.isAlive
578 //==========================================================================
579 function TMasterHost
.isAlive (): Boolean;
581 result
:= (NetMHost
<> nil) and (peer
<> nil);
584 //==========================================================================
586 // TMasterHost.isConnecting
588 // is connection in progress?
590 //==========================================================================
591 function TMasterHost
.isConnecting (): Boolean;
593 result
:= isAlive() and (not NetHostConnected
) and (NetHostConReqTime
<> -1);
596 //==========================================================================
598 // TMasterHost.isConnected
600 //==========================================================================
601 function TMasterHost
.isConnected (): Boolean;
603 result
:= isAlive() and (NetHostConnected
) and (NetHostConReqTime
<> -1);
606 //==========================================================================
608 // TMasterHost.connectedEvent
610 //==========================================================================
611 procedure TMasterHost
.connectedEvent ();
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]));
621 //==========================================================================
623 // TMasterHost.disconnectedEvent
625 //==========================================================================
626 procedure TMasterHost
.disconnectedEvent ();
628 if not isAlive() then exit
;
629 e_LogWritefln('disconnected from master at [%s]', [hostName
], TMsgType
.Notify
);
631 //if (spamConsole) then g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_DISC], [hostName]));
634 //==========================================================================
636 // TMasterHost.receivedEvent
638 // `pkt` is never `nil`
640 //==========================================================================
641 procedure TMasterHost
.receivedEvent (pkt
: pENetPacket
);
649 e_LogWritefln('received packed from master at [%s]', [hostName
], TMsgType
.Notify
);
650 if not msg
.Init(pkt
^.data
, pkt
^.dataLength
, True) then exit
;
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
);
659 slReadUrgent
:= true;
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
);
666 SetLength(srvAnswer
, Cnt
);
667 for f
:= 0 to Cnt
-1 do
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
;
685 if (msg
.ReadCount
< msg
.CurSize
) then
687 // new master, supports version reports
688 s
:= msg
.ReadString();
689 if (s
<> {MyVer}GAME_VERSION
) then
692 g_Console_Add('!!! UpdVer = `'+s
+'`');
694 // even newer master, supports extra info
695 if (msg
.ReadCount
< msg
.CurSize
) then
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;
703 if (s
<> '') then e_LogWritefln('got urgent from master at [%s]: %s', [hostName
, s
], TMsgType
.Notify
);
708 //==========================================================================
710 // TMasterHost.disconnect
712 //==========================================================================
713 procedure TMasterHost
.disconnect (forced
: Boolean);
717 lastDisconnectTime
:= GetTimerMS();
718 if forced
or (not NetHostConnected
) or (NetHostConReqTime
= -1) then
720 enet_peer_reset(peer
);
722 NetHostConReqTime
:= 0;
727 enet_peer_disconnect_later(peer
, 0);
728 // main pulse will take care of the rest
729 NetHostConReqTime
:= -1;
735 NetHostConReqTime
:= 0;
739 NetHostConnected
:= false;
740 NetUpdatePending
:= false;
742 //if (spamConsole) then g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_DISC], [hostName]));
745 //==========================================================================
747 // TMasterHost.connect
749 //==========================================================================
750 function TMasterHost
.connect (): Boolean;
753 if not isValid() then exit
;
754 if (NetHostConReqTime
= -1) then
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
);
762 if isAlive() then begin result
:= true; exit
; end;
765 lastDisconnectTime
:= GetTimerMS(); // why not?
766 SetLength(srvAnswer
, 0);
768 NetHostConnected
:= false;
769 NetHostConReqTime
:= 0;
770 NetUpdatePending
:= false;
775 peer
:= enet_host_connect(NetMHost
, @enetAddr
, NET_MCHANS
, 0);
778 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], true);
782 NetHostConReqTime
:= lastDisconnectTime
;
783 e_LogWritefln('connecting to master at [%s]', [hostName
], TMsgType
.Notify
);
786 //==========================================================================
788 // TMasterHost.writeInfo
790 //==========================================================================
791 class procedure TMasterHost
.writeInfo (var msg
: TMsg
);
793 wad
, map
: AnsiString
;
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
<> ''));
811 //==========================================================================
813 // TMasterHost.update
815 //==========================================================================
816 procedure TMasterHost
.update ();
820 if not isAlive() then exit
;
821 if not isConnected() then
823 NetUpdatePending
:= isConnecting();
829 if reportsEnabled
and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster
then
832 netmsg
.Write(Byte(NET_MMSG_UPD
));
833 netmsg
.Write(NetAddr
.port
);
834 //writeln(formatstrf('%08x', [NetAddr.host]), ' : ', NetAddr.host);
838 pkt
:= enet_packet_create(netmsg
.Data
, netmsg
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
839 if assigned(pkt
) then
841 if (enet_peer_send(peer
, NET_MCHAN_UPD
, pkt
) = 0) then
843 e_LogWritefln('sent update to master at [%s]', [hostName
], TMsgType
.Notify
);
844 NetUpdatePending
:= false;
854 NetUpdatePending
:= false;
858 //==========================================================================
860 // TMasterHost.remove
862 //==========================================================================
863 procedure TMasterHost
.remove ();
867 NetUpdatePending
:= false;
870 if not isAlive() then exit
;
871 if not isConnected() then exit
;
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
881 enet_peer_send(peer
, NET_MCHAN_MAIN
, pkt
);
888 //==========================================================================
892 // this performs various scheduled tasks, if necessary
894 //==========================================================================
895 procedure TMasterHost
.pulse ();
900 if not isAlive() then exit
;
901 if (NetHostConReqTime
= -1) then exit
; // waiting for shutdown (disconnect in progress)
903 // process pending connection timeout
904 if (not NetHostConnected
) then
906 if (ct
< NetHostConReqTime
) or (ct
-NetHostConReqTime
>= 1000*NMASTER_TIMEOUT_CONNECT
) then
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);
915 // send update, if necessary
916 if (NetUpdatePending
) then
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
924 //e_LogWritefln('update timeout: %d', [Integer(mrate)], TMsgType.Notify);
925 lastUpdateTime
:= ct
;
931 //==========================================================================
935 //==========================================================================
936 function parseAddressPort (var ea
: ENetAddress
; hostandport
: AnsiString
): Boolean;
939 hostName
: AnsiString
;
943 if (not g_Net_IsNetworkAvailable()) then exit
;
945 hostandport
:= Trim(hostandport
);
946 if (length(hostandport
) = 0) then exit
;
948 hostName
:= hostandport
;
951 cp
:= Pos(':', hostandport
);
954 hostName
:= Trim(Copy(hostandport
, 1, cp
-1));
955 Delete(hostandport
, 1, cp
);
956 hostandport
:= Trim(hostandport
);
957 if (length(hostandport
) > 0) then
960 port
:= StrToInt(hostandport
);
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
978 if (enet_address_set_host(@ea
, PChar(Addr(hostName
[1]))) <> 0) then
980 knownHosts
.put(hostName
, 0);
983 knownHosts
.put(hostName
, ea
.host
);
989 //==========================================================================
993 //==========================================================================
994 procedure addMasterRecord (var ea
: ENetAddress
; sa
: AnsiString
);
1000 for f
:= 0 to High(mlist
) do
1002 if (mlist
[f
].enetAddr
.host
= ea
.host
) and (mlist
[f
].enetAddr
.port
= ea
.port
) then
1004 mlist
[f
].justAdded
:= true;
1007 if (freeIdx
< 0) and (not mlist
[f
].isValid()) then freeIdx
:= f
;
1009 if (freeIdx
< 0) then
1011 freeIdx
:= length(mlist
);
1012 SetLength(mlist
, freeIdx
+1);
1013 mlist
[freeIdx
].Create(ea
);
1015 mlist
[freeIdx
].justAdded
:= true;
1016 mlist
[freeIdx
].setAddress(ea
, sa
);
1017 e_LogWritefln('added masterserver with address [%s]', [sa
], TMsgType
.Notify
);
1020 //==========================================================================
1024 //==========================================================================
1025 procedure g_Net_Slist_Set (list
: AnsiString
);
1032 if (not g_Net_IsNetworkAvailable()) then exit
;
1034 for f
:= 0 to High(mlist
) do mlist
[f
].justAdded
:= false;
1037 //writeln('list=[', list, ']');
1038 while (length(list
) > 0) do
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
);
1048 // remove unknown master servers
1050 for f
:= 0 to High(mlist
) do
1052 if (not mlist
[f
].justAdded
) then mlist
[f
].cleanup();
1053 if (mlist
[f
].isValid()) then
1057 mlist
[dest
].finish();
1058 mlist
[dest
] := mlist
[f
];
1063 SetLength(mlist
, dest
);
1066 //**************************************************************************
1070 //**************************************************************************
1072 //==========================================================================
1074 // isMasterReportsEnabled
1076 //==========================================================================
1077 function isMasterReportsEnabled (): Boolean;
1079 result
:= (reportsEnabled
and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster
);
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);
1095 isListQuery
: Boolean;
1098 if (not g_Net_IsNetworkAvailable()) then exit
;
1100 if (length(mlist
) = 0) then
1102 if (NetMHost
<> nil) then
1104 enet_host_destroy(NetMHost
);
1110 if (NetMHost
= nil) then
1112 NetMHost
:= enet_host_create(nil, 64, NET_MCHANS
, 1024*1024, 1024*1024);
1113 if (NetMHost
= nil) then
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);
1122 isListQuery
:= (timeout
> 0);
1124 // reconnect/disconnect/pulse for each master
1125 for f
:= 0 to High(mlist
) do
1127 if (not mlist
[f
].isValid()) then continue
;
1128 if (not mlist
[f
].isAlive()) then
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
1133 if (mlist
[f
].lastDisconnectTime
= 0) or (ct
< mlist
[f
].lastDisconnectTime
) or (ct
-mlist
[f
].lastDisconnectTime
>= 1000*NMASTER_TIMEOUT_RECONNECT
) then
1135 e_LogWritefln('reconnecting to master [%s]', [mlist
[f
].hostName
], TMsgType
.Notify
);
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);
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
1149 if (mlist
[f
].isConnected()) and (mlist
[f
].updateSent
) then
1151 e_LogWritefln('removing from master [%s]', [mlist
[f
].hostName
], TMsgType
.Notify
);
1154 e_LogWritefln('disconnecting from master [%s]', [mlist
[f
].hostName
], TMsgType
.Notify
);
1155 mlist
[f
].disconnect(false);
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
);
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);
1180 idx
:= findByPeer(NetMEvent
.peer
);
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
);
1188 if (NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
1190 mlist
[idx
].connectedEvent();
1192 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
1194 mlist
[idx
].disconnectedEvent();
1196 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
1198 mlist
[idx
].receivedEvent(NetMEvent
.packet
);
1199 enet_packet_destroy(NetMEvent
.packet
);
1204 if (count
= 0) then break
;
1205 sres
:= enet_host_service(NetMHost
, @NetMEvent
, 0);
1209 //**************************************************************************
1211 // gui and server list
1213 //**************************************************************************
1215 //==========================================================================
1219 //==========================================================================
1220 procedure PingServer (var S
: TNetServer
; Sock
: ENetSocket
);
1223 Ping
: array [0..9] of Byte;
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);
1238 //==========================================================================
1242 //==========================================================================
1243 procedure PingBcast (Sock
: ENetSocket
);
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])));
1251 S
.PingAddr
.port
:= S
.Port
;
1252 PingServer(S
, Sock
);
1255 //==========================================================================
1257 // g_Net_Slist_Fetch
1259 //==========================================================================
1260 function g_Net_Slist_Fetch (var SL
: TNetServerList
): Boolean;
1269 SvAddr
: ENetAddress
;
1273 procedure ProcessLocal ();
1276 SetLength(SL
, I
+ 1);
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();
1295 procedure CheckLocalServers ();
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);
1307 InMsg
.Alloc(NET_BUFSIZE
);
1308 Buf
.data
:= InMsg
.Data
;
1309 Buf
.dataLength
:= InMsg
.MaxSize
;
1310 while GetTimerMS() - T
<= 500 do
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
;
1327 enet_socket_destroy(Sock
);
1329 if Length(SL
) = 0 then SL
:= nil;
1333 f
, c
, n
, pos
: Integer;
1334 aliveCount
: Integer;
1335 hasUnanswered
: Boolean;
1342 if (not g_Net_IsNetworkAvailable()) then
1348 g_Net_Slist_Pulse(); // this will create mhost
1350 DisconnectAll(true); // forced disconnect
1352 for f
:= 0 to High(mlist
) do
1354 mlist
[f
].connectCount
:= 0;
1355 mlist
[f
].srvAnswered
:= 0;
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();
1374 hasUnanswered
:= false;
1375 for f
:= 0 to High(mlist
) do
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
1385 if (mlist
[f
].connectCount
= 0) then
1388 if (mlist
[f
].isAlive()) then
1390 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_WCONN], [mlist[f].hostName]));
1391 hasUnanswered
:= true;
1392 stt
:= GetTimerMS();
1395 else if (mlist
[f
].srvAnswered
> 1) then
1400 else if (mlist
[f
].isConnected()) then
1402 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_CONN], [mlist[f].hostName]));
1403 if (mlist
[f
].srvAnswered
= 0) then
1405 pkt
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
1406 if assigned(pkt
) then
1408 if (enet_peer_send(mlist
[f
].peer
, NET_MCHAN_MAIN
, pkt
) = 0) then
1410 hasUnanswered
:= true;
1411 mlist
[f
].srvAnswered
:= 1;
1412 stt
:= GetTimerMS();
1416 else if (mlist
[f
].srvAnswered
= 1) then
1418 hasUnanswered
:= true;
1420 else if (mlist
[f
].srvAnswered
> 1) then
1423 mlist
[f
].disconnect(false); // not forced
1426 else if (mlist
[f
].isConnecting()) then
1428 hasUnanswered
:= true;
1431 if (not hasUnanswered
) then break
;
1432 // check for timeout
1434 if (ct
< stt
) or (ct
-stt
> 4000) then break
;
1435 g_Net_Slist_Pulse(300);
1438 if (aliveCount
= 0) then
1441 CheckLocalServers();
1449 slReadUrgent := true;
1453 for f
:= 0 to High(mlist
) do
1455 if (mlist
[f
].srvAnswered
< 2) then continue
;
1456 for n
:= 0 to High(mlist
[f
].srvAnswer
) do
1459 for c
:= 0 to High(SL
) do
1461 if (SL
[c
].IP
= mlist
[f
].srvAnswer
[n
].IP
) and (SL
[c
].Port
= mlist
[f
].srvAnswer
[n
].Port
) then
1470 SetLength(SL
, pos
+1);
1471 SL
[pos
] := mlist
[f
].srvAnswer
[n
];
1472 SL
[pos
].Number
:= pos
;
1475 if (not mlist
[f
].slReadUrgent
) and (mlist
[f
].slUrgent
<> '') then
1477 if (mlist
[f
].slUrgent
<> slUrgent
) then
1479 slUrgent
:= mlist
[f
].slUrgent
;
1480 slReadUrgent
:= false;
1483 if (slMOTD
<> '') and (mlist
[f
].slMOTD
<> '') then
1485 slMOTD
:= mlist
[f
].slMOTD
;
1491 if (length(SL
) = 0) then
1493 CheckLocalServers();
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);
1508 InMsg
.Alloc(NET_BUFSIZE
);
1509 Buf
.data
:= InMsg
.Data
;
1510 Buf
.dataLength
:= InMsg
.MaxSize
;
1512 while GetTimerMS() - T
<= 500 do
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
;
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();
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
1549 tmpsv
.IP
:= SL
[I
].IP
;
1559 SetLength(SL
, I
+ 1);
1560 tmpsv
.IP
:= DecodeIPV4(SvAddr
.host
);
1566 enet_socket_destroy(Sock
);
1572 //==========================================================================
1574 // GetServerFromTable
1576 //==========================================================================
1577 function GetServerFromTable (Index
: Integer; SL
: TNetServerList
; ST
: TNetServerTable
): TNetServer
;
1580 Result
.Protocol
:= 0;
1585 Result
.Players
:= 0;
1586 Result
.MaxPlayers
:= 0;
1587 Result
.LocalPl
:= 0;
1590 Result
.GameMode
:= 0;
1591 Result
.Password
:= false;
1592 FillChar(Result
.PingAddr
, SizeOf(ENetAddress
), 0);
1595 if (Index
< 0) or (Index
>= Length(ST
)) then
1597 Result
:= SL
[ST
[Index
].Indices
[ST
[Index
].Current
]];
1600 //==========================================================================
1602 // g_Serverlist_Draw
1604 //==========================================================================
1605 procedure g_Serverlist_Draw (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1608 sy
, i
, y
, mw
, mx
, l
, motdh
: Integer;
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);
1634 if slMOTD
<> '' then
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);
1642 if not slReadUrgent
and (slUrgent
<> '') then
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);
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
);
1677 if (slSelection
< Length(ST
)) then
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
]
1686 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_NO
];
1688 if Length(ST
) > 0 then
1691 mw
:= (gScreenWidth
- 188);
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);
1713 for I
:= 0 to High(ST
) do
1715 Srv
:= GetServerFromTable(I
, SL
, ST
);
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)
1724 if Srv
.Ping
= 0 then
1725 e_TextureFontPrintEx(mx
- 68, y
, '<1' + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1)
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);
1733 e_TextureFontPrintEx(mx
+ 2, y
, g_Game_ModeToText(Srv
.GameMode
), gStdFont
, 255, 255, 255, 1);
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);
1740 e_TextureFontPrintEx(mx
+ 106, y
, IntToStr(Srv
.Protocol
), gStdFont
, 255, 255, 255, 1);
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);
1751 //==========================================================================
1753 // g_Serverlist_GenerateTable
1755 //==========================================================================
1756 procedure g_Serverlist_GenerateTable (SL
: TNetServerList
; var ST
: TNetServerTable
);
1760 function FindServerInTable(Name
: AnsiString
; Port
: Word): Integer;
1767 for i
:= Low(ST
) to High(ST
) do
1769 if Length(ST
[i
].Indices
) = 0 then
1771 if (SL
[ST
[i
].Indices
[0]].Name
= Name
) and (SL
[ST
[i
].Indices
[0]].Port
= Port
) then
1778 function ComparePing(i1
, i2
: Integer): Boolean;
1784 if (p1
< 0) then p1
:= 999;
1785 if (p2
< 0) then p2
:= 999;
1788 procedure SortIndices(var ind
: Array of Integer);
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
1802 procedure SortRows();
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
1821 for i
:= Low(SL
) to High(SL
) do
1823 j
:= FindServerInTable(SL
[i
].Name
, SL
[i
].Port
);
1827 SetLength(ST
, j
+ 1);
1829 SetLength(ST
[j
].Indices
, 1);
1830 ST
[j
].Indices
[0] := i
;
1834 SetLength(ST
[j
].Indices
, Length(ST
[j
].Indices
) + 1);
1835 ST
[j
].Indices
[High(ST
[j
].Indices
)] := i
;
1839 for i
:= Low(ST
) to High(ST
) do
1840 SortIndices(ST
[i
].Indices
);
1845 //==========================================================================
1847 // g_Serverlist_Control
1849 //==========================================================================
1850 procedure g_Serverlist_Control (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1855 g_Net_Slist_Pulse();
1857 if gConsoleShow
or gChatShow
then
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
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
);
1878 // if there's a message on the screen,
1879 if not slReadUrgent
and (slUrgent
<> '') then
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;
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
1891 if not slFetched
then
1893 slWaitStr
:= _lc
[I_NET_SLIST_WAIT
];
1898 if g_Net_Slist_Fetch(SL
) then
1901 slWaitStr
:= _lc
[I_NET_SLIST_NOSERVERS
];
1905 slWaitStr
:= _lc
[I_NET_SLIST_ERROR
];
1908 g_Serverlist_GenerateTable(SL
, ST
);
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
1920 if not slReturnPressed
then
1922 Srv
:= GetServerFromTable(slSelection
, SL
, ST
);
1923 if Srv
.Password
then
1926 PromptPort
:= Srv
.Port
;
1927 gState
:= STATE_MENU
;
1928 g_GUI_ShowWindow('ClientPasswordMenu');
1931 slReturnPressed
:= True;
1935 g_Game_StartClient(Srv
.IP
, Srv
.Port
, '');
1938 slReturnPressed
:= True;
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
1948 if not slDirPressed
then
1951 if slSelection
> High(ST
) then slSelection
:= 0;
1952 slDirPressed
:= True;
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
1959 if not slDirPressed
then
1961 if slSelection
= 0 then slSelection
:= Length(ST
);
1964 slDirPressed
:= True;
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
1971 if not slDirPressed
then
1973 Inc(ST
[slSelection
].Current
);
1974 if ST
[slSelection
].Current
> High(ST
[slSelection
].Indices
) then ST
[slSelection
].Current
:= 0;
1975 slDirPressed
:= True;
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
1982 if not slDirPressed
then
1984 if ST
[slSelection
].Current
= 0 then ST
[slSelection
].Current
:= Length(ST
[slSelection
].Indices
);
1985 Dec(ST
[slSelection
].Current
);
1987 slDirPressed
:= True;
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
))
2008 slDirPressed
:= False;