1 (* Copyright (C) Doom 2D: Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE ../shared/a_modes.inc}
21 ENet
, SysUtils
, e_msg
;
34 // all timeouts in seconds
35 NMASTER_TIMEOUT_CONNECT
= 3; // 3 seconds
36 NMASTER_TIMEOUT_RECONNECT
= 5*60; // 5 minutes
37 //NMASTER_TIMEOUT_RECONNECT = 30; // 5 minutes
38 //NMASTER_FORCE_UPDATE_TIMEOUT = 20;
39 //NMASTER_FORCE_UPDATE_TIMEOUT = 0;
49 Players
, MaxPlayers
, LocalPl
, Bots
: Byte;
53 PingAddr
: ENetAddress
;
55 pTNetServer
= ^TNetServer
;
56 TNetServerRow
= record
57 Indices
: Array of Integer;
61 TNetServerList
= array of TNetServer
;
62 pTNetServerList
= ^TNetServerList
;
63 TNetServerTable
= array of TNetServerRow
;
72 enetAddr
: ENetAddress
;
73 // inside the game, calling `connect()` is disasterous, as it is blocking.
74 // so we'll use this variable to indicate if "connected" event is received.
75 NetHostConnected
: Boolean;
76 NetHostConReqTime
: Int64; // to timeout `connect`; -1 means "waiting for shutdown"
77 NetUpdatePending
: Boolean; // should we send an update after connection completes?
78 lastDisconnectTime
: Int64; // last real disconnect time; <0: do not reconnect
79 updateSent
: Boolean; // was at least one update sent? (used to decide if we should call `remove()`)
80 lastUpdateTime
: Int64;
81 // server list request working flags
83 srvAnswer
: array of TNetServer
;
86 slReadUrgent
: Boolean;
89 connectCount
: Integer;
95 constructor Create (var ea
: ENetAddress
);
99 function setAddress (var ea
: ENetAddress
; hostStr
: AnsiString
): Boolean;
101 function isValid (): Boolean;
102 function isAlive (): Boolean; // not disconnected
103 function isConnecting (): Boolean; // is connection in progress?
104 function isConnected (): Boolean;
106 // call as often as you want, the object will do the rest
107 // but try to call this at least once in 100 msecs
110 procedure disconnect (forced
: Boolean);
111 function connect (): Boolean;
116 class procedure writeInfo (var msg
: TMsg
); static
;
118 procedure connectedEvent ();
119 procedure disconnectedEvent ();
120 procedure receivedEvent (pkt
: pENetPacket
); // `pkt` is never `nil`
125 slCurrent
: TNetServerList
= nil;
126 slTable
: TNetServerTable
= nil;
127 slWaitStr
: AnsiString
= '';
128 slReturnPressed
: Boolean = True;
130 slMOTD
: AnsiString
= '';
131 slUrgent
: AnsiString
= '';
133 NMASTER_FORCE_UPDATE_TIMEOUT
: Integer = 0; // fuck you, fpc, and your idiotic "diagnostics"
136 procedure g_Net_Slist_Set (list
: AnsiString
);
137 function g_Net_Slist_Fetch (var SL
: TNetServerList
): Boolean;
139 // make this server private
140 procedure g_Net_Slist_Private ();
141 // make this server public
142 procedure g_Net_Slist_Public ();
144 // called while the server is running
145 procedure g_Net_Slist_ServerUpdate ();
146 // called when the server is started
147 procedure g_Net_Slist_ServerStarted ();
148 // called when the server is stopped
149 procedure g_Net_Slist_ServerClosed ();
151 // called when new netword player comes
152 procedure g_Net_Slist_ServerPlayerComes ();
153 // called when new netword player comes
154 procedure g_Net_Slist_ServerPlayerLeaves ();
156 procedure g_Net_Slist_ServerMapStarted ();
157 // this server renamed (or password mode changed, or other params changed)
158 procedure g_Net_Slist_ServerRenamed ();
160 // non-zero timeout ignores current status (used to fetch server list)
161 procedure g_Net_Slist_Pulse (timeout
: Integer=0);
163 procedure g_Net_Slist_ShutdownAll ();
165 procedure g_Serverlist_GenerateTable (SL
: TNetServerList
; var ST
: TNetServerTable
);
166 procedure g_Serverlist_Draw (var SL
: TNetServerList
; var ST
: TNetServerTable
);
167 procedure g_Serverlist_Control (var SL
: TNetServerList
; var ST
: TNetServerTable
);
169 function GetTimerMS (): Int64;
175 e_input
, e_graphics
, e_log
, g_window
, g_net
, g_console
,
176 g_map
, g_game
, g_sound
, g_gui
, g_menu
, g_options
, g_language
, g_basic
,
177 wadreader
, g_system
, utils
, hashtable
;
180 // ////////////////////////////////////////////////////////////////////////// //
182 NetMHost
: pENetHost
= nil;
183 NetMEvent
: ENetEvent
;
184 mlist
: array of TMasterHost
= nil;
186 slSelection
: Byte = 0;
187 slFetched
: Boolean = False;
188 slDirPressed
: Boolean = False;
189 slReadUrgent
: Boolean = False;
191 reportsEnabled
: Boolean = true;
194 //==========================================================================
198 //==========================================================================
199 function GetTimerMS (): Int64;
201 Result
:= sys_GetTicks() {div 1000};
205 //==========================================================================
209 //==========================================================================
210 function findByPeer (peer
: pENetPeer
): Integer;
214 for f
:= 0 to High(mlist
) do if (mlist
[f
].peer
= peer
) then begin result
:= f
; exit
; end;
219 //==========================================================================
223 //==========================================================================
224 procedure g_Net_Slist_ShutdownAll ();
226 f
, sres
, idx
: Integer;
228 activeCount
: Integer = 0;
230 if (NetMHost
= nil) then exit
;
231 for f
:= 0 to High(mlist
) do
233 if (mlist
[f
].isAlive()) then
236 if (mlist
[f
].isConnected() and mlist
[f
].updateSent
) then
238 writeln('unregistering from [', mlist
[f
].hostName
, ']');
241 //mlist[f].disconnect(false);
242 enet_peer_disconnect_later(mlist
[f
].peer
, 0);
245 if (activeCount
= 0) then exit
;
247 while (activeCount
> 0) do
250 if (ct
< stt
) or (ct
-stt
>= 1500) then break
;
252 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
253 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
254 // thank you, enet. let's ignore failures altogether then.
255 sres
:= enet_host_service(NetMHost
, @NetMEvent
, 100);
256 // if (sres < 0) then break;
257 if (sres
<= 0) then continue
;
259 idx
:= findByPeer(NetMEvent
.peer
);
262 if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then enet_packet_destroy(NetMEvent
.packet
);
266 if (NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
268 mlist
[idx
].connectedEvent();
269 //mlist[idx].disconnect(false);
270 enet_peer_disconnect(mlist
[f
].peer
, 0);
272 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
274 mlist
[idx
].disconnectedEvent();
277 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
279 mlist
[idx
].receivedEvent(NetMEvent
.packet
);
280 enet_packet_destroy(NetMEvent
.packet
);
283 enet_host_destroy(NetMHost
);
288 //==========================================================================
292 //==========================================================================
293 procedure DisconnectAll (forced
: Boolean=false);
297 for f
:= 0 to High(mlist
) do
299 if (mlist
[f
].isAlive()) then mlist
[f
].disconnect(forced
);
304 //==========================================================================
308 //==========================================================================
309 procedure ConnectAll (sendUpdate
: Boolean);
313 // set flags; pulse will take care of the rest
314 for f
:= 0 to High(mlist
) do
317 mlist
[f
].lastDisconnectTime
:= 0;
321 mlist
[f
].NetUpdatePending
:= true;
322 mlist
[f
].lastUpdateTime
:= 0;
328 //==========================================================================
332 //==========================================================================
333 procedure UpdateAll (force
: Boolean);
337 // set flags; pulse will take care of the rest
338 for f
:= 0 to High(mlist
) do
340 if (not mlist
[f
].isAlive()) then continue
;
341 mlist
[f
].NetUpdatePending
:= true;
342 if (force
) then mlist
[f
].lastUpdateTime
:= 0;
347 //**************************************************************************
351 //**************************************************************************
353 //==========================================================================
355 // g_Net_Slist_Private
357 // make this server private
359 //==========================================================================
360 procedure g_Net_Slist_Private ();
363 reportsEnabled
:= false;
367 //==========================================================================
369 // g_Net_Slist_Public
371 // make this server public
373 //==========================================================================
374 procedure g_Net_Slist_Public ();
376 if (not reportsEnabled
) then
378 reportsEnabled
:= true;
384 //==========================================================================
386 // g_Net_Slist_ServerUpdate
388 // called while the server is running
390 //==========================================================================
391 procedure g_Net_Slist_ServerUpdate ();
397 // called when the server is started
398 procedure g_Net_Slist_ServerStarted ();
400 reportsEnabled
:= NetUseMaster
;
401 if reportsEnabled
and g_Game_IsServer() and g_Game_IsNet() then
403 writeln('*** server started; reporting to master...');
409 //==========================================================================
411 // g_Net_Slist_ServerClosed
413 // called when the server is stopped
415 //==========================================================================
416 procedure g_Net_Slist_ServerClosed ();
420 if reportsEnabled
then
422 reportsEnabled
:= false;
423 for f
:= 0 to High(mlist
) do
425 if (mlist
[f
].isConnected()) then mlist
[f
].remove();
432 //==========================================================================
434 // g_Net_Slist_ServerPlayerComes
436 // called when new netword player comes
438 //==========================================================================
439 procedure g_Net_Slist_ServerPlayerComes ();
445 //==========================================================================
447 // g_Net_Slist_ServerPlayerLeaves
449 // called when new netword player comes
451 //==========================================================================
452 procedure g_Net_Slist_ServerPlayerLeaves ();
458 //==========================================================================
460 // g_Net_Slist_ServerMapStarted
464 //==========================================================================
465 procedure g_Net_Slist_ServerMapStarted ();
471 //==========================================================================
473 // g_Net_Slist_ServerRenamed
475 // this server renamed (or password mode changed, or other params changed)
477 //==========================================================================
478 procedure g_Net_Slist_ServerRenamed ();
484 //**************************************************************************
488 //**************************************************************************
490 //==========================================================================
492 // TMasterHost.Create
494 //==========================================================================
495 constructor TMasterHost
.Create (var ea
: ENetAddress
);
498 NetHostConnected
:= false;
499 NetHostConReqTime
:= 0;
500 NetUpdatePending
:= false;
501 lastDisconnectTime
:= 0;
505 ZeroMemory(@enetAddr
, sizeof(enetAddr
));
506 SetLength(srvAnswer
, 0);
510 slReadUrgent
:= true;
513 netmsg
.Alloc(NET_BUFSIZE
);
518 //==========================================================================
522 //==========================================================================
523 procedure TMasterHost
.clear ();
525 updateSent
:= false; // do not send 'remove'
529 SetLength(srvAnswer
, 0);
533 slReadUrgent
:= true;
534 ZeroMemory(@enetAddr
, sizeof(enetAddr
));
538 //==========================================================================
540 // TMasterHost.setAddress
542 //==========================================================================
543 function TMasterHost
.setAddress (var ea
: ENetAddress
; hostStr
: AnsiString
): Boolean;
546 SetLength(srvAnswer
, 0);
550 slReadUrgent
:= true;
551 updateSent
:= false; // do not send 'remove'
555 if (not g_Net_IsNetworkAvailable()) then exit
;
558 if (enetAddr
.host
= 0) or (enetAddr
.port
= 0) then exit
;
560 if (length(hostStr
) > 0) then hostName
:= hostStr
else hostName
:= IntToStr(enetAddr
.host
)+':'+IntToStr(ea
.port
);
566 //==========================================================================
568 // TMasterHost.isValid
570 //==========================================================================
571 function TMasterHost
.isValid (): Boolean;
573 result
:= (enetAddr
.host
<> 0) and (enetAddr
.port
<> 0);
577 //==========================================================================
579 // TMasterHost.isAlive
583 //==========================================================================
584 function TMasterHost
.isAlive (): Boolean;
586 result
:= (NetMHost
<> nil) and (peer
<> nil);
590 //==========================================================================
592 // TMasterHost.isConnecting
594 // is connection in progress?
596 //==========================================================================
597 function TMasterHost
.isConnecting (): Boolean;
599 result
:= isAlive() and (not NetHostConnected
) and (NetHostConReqTime
<> -1);
603 //==========================================================================
605 // TMasterHost.isConnected
607 //==========================================================================
608 function TMasterHost
.isConnected (): Boolean;
610 result
:= isAlive() and (NetHostConnected
) and (NetHostConReqTime
<> -1);
614 //==========================================================================
616 // TMasterHost.connectedEvent
618 //==========================================================================
619 procedure TMasterHost
.connectedEvent ();
621 if not isAlive() then exit
;
622 if NetHostConnected
then exit
;
623 NetHostConnected
:= true;
624 NetHostConReqTime
:= 0; // just in case
625 e_LogWritefln('connected to master at [%s]', [hostName
], TMsgType
.Notify
);
626 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_CONN], [mlist[f].hostName]));
630 //==========================================================================
632 // TMasterHost.disconnectedEvent
634 //==========================================================================
635 procedure TMasterHost
.disconnectedEvent ();
637 if not isAlive() then exit
;
638 e_LogWritefln('disconnected from master at [%s]', [hostName
], TMsgType
.Notify
);
640 //if (spamConsole) then g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_DISC], [hostName]));
644 //==========================================================================
646 // TMasterHost.receivedEvent
648 // `pkt` is never `nil`
650 //==========================================================================
651 procedure TMasterHost
.receivedEvent (pkt
: pENetPacket
);
659 e_LogWritefln('received packed from master at [%s]', [hostName
], TMsgType
.Notify
);
660 if not msg
.Init(pkt
^.data
, pkt
^.dataLength
, True) then exit
;
662 MID
:= msg
.ReadByte();
663 if (MID
<> NET_MMSG_GET
) then exit
;
664 e_LogWritefln('received list packet from master at [%s]', [hostName
], TMsgType
.Notify
);
665 SetLength(srvAnswer
, 0);
666 if (srvAnswered
> 0) then Inc(srvAnswered
);
669 slReadUrgent
:= true;
671 Cnt
:= msg
.ReadByte();
672 //g_Console_Add(_lc[I_NET_MSG]+Format(_lc[I_NET_SLIST_RETRIEVED], [Cnt, hostName]), True);
673 e_LogWritefln('got %u server(s) from master at [%s]', [Cnt
, hostName
], TMsgType
.Notify
);
676 SetLength(srvAnswer
, Cnt
);
677 for f
:= 0 to Cnt
-1 do
679 srvAnswer
[f
].Number
:= f
;
680 srvAnswer
[f
].IP
:= msg
.ReadString();
681 srvAnswer
[f
].Port
:= msg
.ReadWord();
682 srvAnswer
[f
].Name
:= msg
.ReadString();
683 srvAnswer
[f
].Map
:= msg
.ReadString();
684 srvAnswer
[f
].GameMode
:= msg
.ReadByte();
685 srvAnswer
[f
].Players
:= msg
.ReadByte();
686 srvAnswer
[f
].MaxPlayers
:= msg
.ReadByte();
687 srvAnswer
[f
].Protocol
:= msg
.ReadByte();
688 srvAnswer
[f
].Password
:= msg
.ReadByte() = 1;
689 enet_address_set_host(Addr(srvAnswer
[f
].PingAddr
), PChar(Addr(srvAnswer
[f
].IP
[1])));
690 srvAnswer
[f
].Ping
:= -1;
691 srvAnswer
[f
].PingAddr
.port
:= NET_PING_PORT
;
695 if (msg
.ReadCount
< msg
.CurSize
) then
697 // new master, supports version reports
698 s
:= msg
.ReadString();
699 if (s
<> {MyVer}GAME_VERSION
) then
702 g_Console_Add('!!! UpdVer = `'+s
+'`');
704 // even newer master, supports extra info
705 if (msg
.ReadCount
< msg
.CurSize
) then
707 slMOTD
:= b_Text_Format(msg
.ReadString());
708 if (slMOTD
<> '') then e_LogWritefln('got MOTD from master at [%s]: %s', [hostName
, slMOTD
], TMsgType
.Notify
);
709 s
:= b_Text_Format(msg
.ReadString());
710 // check if the message has updated and the user has to read it again
711 if (slUrgent
<> s
) then slReadUrgent
:= false;
713 if (s
<> '') then e_LogWritefln('got urgent from master at [%s]: %s', [hostName
, s
], TMsgType
.Notify
);
719 //==========================================================================
721 // TMasterHost.disconnect
723 //==========================================================================
724 procedure TMasterHost
.disconnect (forced
: Boolean);
728 lastDisconnectTime
:= GetTimerMS();
729 if forced
or (not NetHostConnected
) or (NetHostConReqTime
= -1) then
731 enet_peer_reset(peer
);
733 NetHostConReqTime
:= 0;
738 enet_peer_disconnect_later(peer
, 0);
739 // main pulse will take care of the rest
740 NetHostConReqTime
:= -1;
746 NetHostConReqTime
:= 0;
750 NetHostConnected
:= false;
751 NetUpdatePending
:= false;
753 //if (spamConsole) then g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_DISC], [hostName]));
757 //==========================================================================
759 // TMasterHost.connect
761 //==========================================================================
762 function TMasterHost
.connect (): Boolean;
765 if not isValid() then exit
;
766 if (NetHostConReqTime
= -1) then
769 if (NetHostConReqTime
= -1) then e_LogWritefln('ketmar broke master [%s] logic! (000)', [hostName
], TMsgType
.Notify
);
770 if (isAlive()) then e_LogWritefln('ketmar broke master [%s] logic! (001)', [hostName
], TMsgType
.Notify
);
774 if isAlive() then begin result
:= true; exit
; end;
777 lastDisconnectTime
:= GetTimerMS(); // why not?
778 SetLength(srvAnswer
, 0);
780 NetHostConnected
:= false;
781 NetHostConReqTime
:= 0;
782 NetUpdatePending
:= false;
787 peer
:= enet_host_connect(NetMHost
, @enetAddr
, NET_MCHANS
, 0);
790 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], true);
794 NetHostConReqTime
:= lastDisconnectTime
;
795 e_LogWritefln('connecting to master at [%s]', [hostName
], TMsgType
.Notify
);
799 //==========================================================================
801 // TMasterHost.writeInfo
803 //==========================================================================
804 class procedure TMasterHost
.writeInfo (var msg
: TMsg
);
806 wad
, map
: AnsiString
;
808 wad
:= g_ExtractWadNameNoPath(gMapInfo
.Map
);
809 map
:= g_ExtractFileName(gMapInfo
.Map
);
811 msg
.Write(NetServerName
);
813 msg
.Write(wad
+':/'+map
);
814 msg
.Write(gGameSettings
.GameMode
);
816 msg
.Write(Byte(NetClientCount
));
818 msg
.Write(NetMaxClients
);
820 msg
.Write(Byte(NET_PROTOCOL_VER
));
821 msg
.Write(Byte(NetPassword
<> ''));
825 //==========================================================================
827 // TMasterHost.update
829 //==========================================================================
830 procedure TMasterHost
.update ();
834 if not isAlive() then exit
;
835 if not isConnected() then
837 NetUpdatePending
:= isConnecting();
843 if reportsEnabled
and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster
then
846 netmsg
.Write(Byte(NET_MMSG_UPD
));
847 netmsg
.Write(NetAddr
.port
);
848 //writeln(formatstrf('%08x', [NetAddr.host]), ' : ', NetAddr.host);
852 pkt
:= enet_packet_create(netmsg
.Data
, netmsg
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
853 if assigned(pkt
) then
855 if (enet_peer_send(peer
, NET_MCHAN_UPD
, pkt
) = 0) then
857 e_LogWritefln('sent update to master at [%s]', [hostName
], TMsgType
.Notify
);
858 NetUpdatePending
:= false;
868 NetUpdatePending
:= false;
873 //==========================================================================
875 // TMasterHost.remove
877 //==========================================================================
878 procedure TMasterHost
.remove ();
882 NetUpdatePending
:= false;
885 if not isAlive() then exit
;
886 if not isConnected() then exit
;
890 netmsg
.Write(Byte(NET_MMSG_DEL
));
891 netmsg
.Write(NetAddr
.port
);
893 pkt
:= enet_packet_create(netmsg
.Data
, netmsg
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
894 if assigned(pkt
) then
896 enet_peer_send(peer
, NET_MCHAN_MAIN
, pkt
);
904 //==========================================================================
908 // this performs various scheduled tasks, if necessary
910 //==========================================================================
911 procedure TMasterHost
.pulse ();
916 if not isAlive() then exit
;
917 if (NetHostConReqTime
= -1) then exit
; // waiting for shutdown (disconnect in progress)
919 // process pending connection timeout
920 if (not NetHostConnected
) then
922 if (ct
< NetHostConReqTime
) or (ct
-NetHostConReqTime
>= 1000*NMASTER_TIMEOUT_CONNECT
) then
924 e_LogWritefln('failed to connect to master at [%s]', [hostName
], TMsgType
.Notify
);
925 // do not spam with error messages, it looks like the master is down
926 //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
931 // send update, if necessary
932 if (NetUpdatePending
) then
934 mrate
:= NetMasterRate
;
935 if (mrate
< 10000) then mrate
:= 10000
936 else if (mrate
> 1000*60*10) then mrate
:= 1000*60*10;
937 if (NMASTER_FORCE_UPDATE_TIMEOUT
> 0) then mrate
:= NMASTER_FORCE_UPDATE_TIMEOUT
*1000;
938 if (lastUpdateTime
= 0) or (ct
< lastUpdateTime
) or (ct
-lastUpdateTime
>= mrate
) then
940 //e_LogWritefln('update timeout: %d', [Integer(mrate)], TMsgType.Notify);
941 lastUpdateTime
:= ct
;
948 //**************************************************************************
952 //**************************************************************************
954 THashStrDWord
= specialize THashBase
<AnsiString
, LongWord
, THashKeyStrAnsiCI
>;
957 knownHosts
: THashStrDWord
= nil;
960 //==========================================================================
964 //==========================================================================
965 function parseAddressPort (var ea
: ENetAddress
; hostandport
: AnsiString
): Boolean;
968 hostName
: AnsiString
;
972 if (not g_Net_IsNetworkAvailable()) then exit
;
974 hostandport
:= Trim(hostandport
);
975 if (length(hostandport
) = 0) then exit
;
977 hostName
:= hostandport
;
980 cp
:= Pos(':', hostandport
);
983 hostName
:= Trim(Copy(hostandport
, 1, cp
-1));
984 Delete(hostandport
, 1, cp
);
985 hostandport
:= Trim(hostandport
);
986 if (length(hostandport
) > 0) then
989 port
:= StrToInt(hostandport
);
996 if (length(hostName
) = 0) then exit
;
997 if (port
< 1) or (port
> 65535) then exit
;
999 if not assigned(knownHosts
) then knownHosts
:= THashStrDWord
.Create();
1001 if knownHosts
.get(hostName
, ip
) then
1007 if (enet_address_set_host(@ea
, PChar(Addr(hostName
[1]))) <> 0) then
1009 knownHosts
.put(hostName
, 0);
1012 knownHosts
.put(hostName
, ea
.host
);
1019 //==========================================================================
1023 //==========================================================================
1024 procedure addMasterRecord (var ea
: ENetAddress
; sa
: AnsiString
);
1030 for f
:= 0 to High(mlist
) do
1032 if (mlist
[f
].enetAddr
.host
= ea
.host
) and (mlist
[f
].enetAddr
.port
= ea
.port
) then
1034 mlist
[f
].justAdded
:= true;
1037 if (freeIdx
< 0) and (not mlist
[f
].isValid()) then freeIdx
:= f
;
1039 if (freeIdx
< 0) then
1041 freeIdx
:= length(mlist
);
1042 SetLength(mlist
, freeIdx
+1);
1043 mlist
[freeIdx
].Create(ea
);
1045 mlist
[freeIdx
].justAdded
:= true;
1046 mlist
[freeIdx
].setAddress(ea
, sa
);
1047 e_LogWritefln('added masterserver with address [%s]', [sa
], TMsgType
.Notify
);
1051 //==========================================================================
1055 //==========================================================================
1056 procedure g_Net_Slist_Set (list
: AnsiString
);
1063 if (not g_Net_IsNetworkAvailable()) then exit
;
1065 for f
:= 0 to High(mlist
) do mlist
[f
].justAdded
:= false;
1068 //writeln('list=[', list, ']');
1069 while (length(list
) > 0) do
1071 pp
:= Pos(',', list
);
1072 if (pp
< 1) then pp
:= length(list
)+1;
1073 sa
:= Trim(Copy(list
, 1, pp
-1));
1074 Delete(list
, 1, pp
);
1075 //writeln(' sa=[', sa, ']');
1076 if (length(sa
) > 0) and parseAddressPort(ea
, sa
) then addMasterRecord(ea
, sa
);
1079 // remove unknown master servers
1081 for f
:= 0 to High(mlist
) do
1083 if (not mlist
[f
].justAdded
) then mlist
[f
].clear();
1084 if (mlist
[f
].isValid()) then
1086 if (dest
<> f
) then mlist
[dest
] := mlist
[f
];
1090 if (dest
<> length(mlist
)) then SetLength(mlist
, dest
);
1094 //**************************************************************************
1098 //**************************************************************************
1100 //==========================================================================
1102 // isMasterReportsEnabled
1104 //==========================================================================
1105 function isMasterReportsEnabled (): Boolean;
1107 result
:= (reportsEnabled
and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster
);
1111 //==========================================================================
1113 // g_Net_Slist_Pulse
1115 // non-zero timeout ignores current status (used to fetch server list)
1117 //==========================================================================
1118 procedure g_Net_Slist_Pulse (timeout
: Integer=0);
1124 isListQuery
: Boolean;
1127 if (not g_Net_IsNetworkAvailable()) then exit
;
1129 if (length(mlist
) = 0) then
1131 if (NetMHost
<> nil) then
1133 enet_host_destroy(NetMHost
);
1139 if (NetMHost
= nil) then
1141 NetMHost
:= enet_host_create(nil, 64, NET_MCHANS
, 1024*1024, 1024*1024);
1142 if (NetMHost
= nil) then
1144 e_LogWriteln(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
] + ' (host_create)', TMsgType
.Notify
);
1145 for f
:= 0 to High(mlist
) do mlist
[f
].clear();
1146 SetLength(mlist
, 0);
1151 isListQuery
:= (timeout
> 0);
1153 // reconnect/disconnect/pulse for each master
1154 for f
:= 0 to High(mlist
) do
1156 if (not mlist
[f
].isValid()) then continue
;
1157 if (not mlist
[f
].isAlive()) then
1159 // not connected; try to reconnect if we're asking for a host list, or we are in netgame, and we are the host
1160 if (not isListQuery
) and isMasterReportsEnabled() then
1162 if (mlist
[f
].lastDisconnectTime
= 0) or (ct
< mlist
[f
].lastDisconnectTime
) or (ct
-mlist
[f
].lastDisconnectTime
>= 1000*NMASTER_TIMEOUT_RECONNECT
) then
1164 e_LogWritefln('reconnecting to master [%s]', [mlist
[f
].hostName
], TMsgType
.Notify
);
1169 //e_LogWritefln('DEAD master [%s]: ct=%d; ldt=%d; diff=%d', [mlist[f].hostName, Integer(ct), Integer(mlist[f].lastDisconnectTime), Integer(ct-mlist[f].lastDisconnectTime)], TMsgType.Notify);
1175 // if we're not in slist query, and not in netgame (or not a host), disconnect
1176 if (not isListQuery
) and (not isMasterReportsEnabled()) then
1178 if (mlist
[f
].isConnected()) and (mlist
[f
].updateSent
) then
1180 e_LogWritefln('removing from master [%s]', [mlist
[f
].hostName
], TMsgType
.Notify
);
1183 e_LogWritefln('disconnecting from master [%s]', [mlist
[f
].hostName
], TMsgType
.Notify
);
1184 mlist
[f
].disconnect(false);
1190 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
1191 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
1192 // thank you, enet. let's ignore failures altogether then.
1193 count
:= 10; // no more than ten events in a row
1194 sres
:= enet_host_service(NetMHost
, @NetMEvent
, timeout
);
1200 e_LogWriteln(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT] + ' (host_service)', TMsgType.Notify);
1201 for f := 0 to High(mlist) do mlist[f].clear();
1202 SetLength(mlist, 0);
1203 enet_host_destroy(NetMHost);
1209 idx
:= findByPeer(NetMEvent
.peer
);
1212 e_LogWriteln('network event from unknown master host. ignored.', TMsgType
.Warning
);
1213 if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then enet_packet_destroy(NetMEvent
.packet
);
1217 if (NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
1219 mlist
[idx
].connectedEvent();
1221 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
1223 mlist
[idx
].disconnectedEvent();
1225 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
1227 mlist
[idx
].receivedEvent(NetMEvent
.packet
);
1228 enet_packet_destroy(NetMEvent
.packet
);
1233 if (count
= 0) then break
;
1234 sres
:= enet_host_service(NetMHost
, @NetMEvent
, 0);
1239 //**************************************************************************
1241 // gui and server list
1243 //**************************************************************************
1245 //==========================================================================
1249 //==========================================================================
1250 procedure PingServer (var S
: TNetServer
; Sock
: ENetSocket
);
1253 Ping
: array [0..9] of Byte;
1256 ClTime
:= GetTimerMS();
1258 Buf
.data
:= Addr(Ping
[0]);
1259 Buf
.dataLength
:= 2+8;
1261 Ping
[0] := Ord('D');
1262 Ping
[1] := Ord('F');
1263 Int64(Addr(Ping
[2])^) := ClTime
;
1265 enet_socket_send(Sock
, Addr(S
.PingAddr
), @Buf
, 1);
1269 //==========================================================================
1273 //==========================================================================
1274 procedure PingBcast (Sock
: ENetSocket
);
1278 S
.IP
:= '255.255.255.255';
1279 S
.Port
:= NET_PING_PORT
;
1280 enet_address_set_host(Addr(S
.PingAddr
), PChar(Addr(S
.IP
[1])));
1282 S
.PingAddr
.port
:= S
.Port
;
1283 PingServer(S
, Sock
);
1287 //==========================================================================
1289 // g_Net_Slist_Fetch
1291 //==========================================================================
1292 function g_Net_Slist_Fetch (var SL
: TNetServerList
): Boolean;
1301 SvAddr
: ENetAddress
;
1305 procedure ProcessLocal ();
1308 SetLength(SL
, I
+ 1);
1311 IP
:= DecodeIPV4(SvAddr
.host
);
1312 Port
:= InMsg
.ReadWord();
1313 Ping
:= InMsg
.ReadInt64();
1314 Ping
:= GetTimerMS() - Ping
;
1315 Name
:= InMsg
.ReadString();
1316 Map
:= InMsg
.ReadString();
1317 GameMode
:= InMsg
.ReadByte();
1318 Players
:= InMsg
.ReadByte();
1319 MaxPlayers
:= InMsg
.ReadByte();
1320 Protocol
:= InMsg
.ReadByte();
1321 Password
:= InMsg
.ReadByte() = 1;
1322 LocalPl
:= InMsg
.ReadByte();
1323 Bots
:= InMsg
.ReadWord();
1327 procedure CheckLocalServers ();
1331 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
1332 if Sock
= ENET_SOCKET_NULL
then Exit
;
1333 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
1334 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
1339 InMsg
.Alloc(NET_BUFSIZE
);
1340 Buf
.data
:= InMsg
.Data
;
1341 Buf
.dataLength
:= InMsg
.MaxSize
;
1342 while GetTimerMS() - T
<= 500 do
1346 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
1347 if RX
<= 0 then continue
;
1348 InMsg
.CurSize
:= RX
;
1350 InMsg
.BeginReading();
1352 if InMsg
.ReadChar() <> 'D' then continue
;
1353 if InMsg
.ReadChar() <> 'F' then continue
;
1359 enet_socket_destroy(Sock
);
1361 if Length(SL
) = 0 then SL
:= nil;
1365 f
, c
, n
, pos
: Integer;
1366 aliveCount
: Integer;
1367 hasUnanswered
: Boolean;
1374 if (not g_Net_IsNetworkAvailable()) then
1380 g_Net_Slist_Pulse(); // this will create mhost
1382 DisconnectAll(true); // forced disconnect
1384 for f
:= 0 to High(mlist
) do
1386 mlist
[f
].connectCount
:= 0;
1387 mlist
[f
].srvAnswered
:= 0;
1391 NetOut
.Write(Byte(NET_MMSG_GET
));
1393 // TODO: what should we identify the build with?
1394 MyVer
:= GAME_VERSION
;
1395 NetOut
.Write(MyVer
);
1398 e_WriteLog('Fetching serverlist...', TMsgType
.Notify
);
1399 g_Console_Add(_lc
[I_NET_MSG
]+_lc
[I_NET_SLIST_FETCH
]);
1401 // wait until all servers connected and answered
1402 stt
:= GetTimerMS();
1406 hasUnanswered
:= false;
1407 for f
:= 0 to High(mlist
) do
1410 e_LogWritefln(' master #%d: [%s] valid=%d; alive=%d; connected=%d; connecting=%d',
1411 [f, mlist[f].hostName, Integer(mlist[f].isValid()), Integer(mlist[f].isAlive()),
1412 Integer(mlist[f].isConnected()), Integer(mlist[f].isConnecting())], TMsgType.Notify);
1414 if (not mlist
[f
].isValid()) then continue
;
1415 if (not mlist
[f
].isAlive()) then
1417 if (mlist
[f
].connectCount
= 0) then
1420 if (mlist
[f
].isAlive()) then
1422 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_WCONN], [mlist[f].hostName]));
1423 hasUnanswered
:= true;
1424 stt
:= GetTimerMS();
1427 else if (mlist
[f
].srvAnswered
> 1) then
1432 else if (mlist
[f
].isConnected()) then
1434 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_CONN], [mlist[f].hostName]));
1435 if (mlist
[f
].srvAnswered
= 0) then
1437 pkt
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
1438 if assigned(pkt
) then
1440 if (enet_peer_send(mlist
[f
].peer
, NET_MCHAN_MAIN
, pkt
) = 0) then
1442 hasUnanswered
:= true;
1443 mlist
[f
].srvAnswered
:= 1;
1444 stt
:= GetTimerMS();
1448 else if (mlist
[f
].srvAnswered
= 1) then
1450 hasUnanswered
:= true;
1452 else if (mlist
[f
].srvAnswered
> 1) then
1455 mlist
[f
].disconnect(false); // not forced
1458 else if (mlist
[f
].isConnecting()) then
1460 hasUnanswered
:= true;
1463 if (not hasUnanswered
) then break
;
1464 // check for timeout
1466 if (ct
< stt
) or (ct
-stt
> 4000) then break
;
1467 g_Net_Slist_Pulse(300);
1470 if (aliveCount
= 0) then
1473 CheckLocalServers();
1481 slReadUrgent := true;
1485 for f
:= 0 to High(mlist
) do
1487 if (mlist
[f
].srvAnswered
< 2) then continue
;
1488 for n
:= 0 to High(mlist
[f
].srvAnswer
) do
1491 for c
:= 0 to High(SL
) do
1493 if (SL
[c
].IP
= mlist
[f
].srvAnswer
[n
].IP
) and (SL
[c
].Port
= mlist
[f
].srvAnswer
[n
].Port
) then
1502 SetLength(SL
, pos
+1);
1503 SL
[pos
] := mlist
[f
].srvAnswer
[n
];
1504 SL
[pos
].Number
:= pos
;
1507 if (not mlist
[f
].slReadUrgent
) and (mlist
[f
].slUrgent
<> '') then
1509 if (mlist
[f
].slUrgent
<> slUrgent
) then
1511 slUrgent
:= mlist
[f
].slUrgent
;
1512 slReadUrgent
:= false;
1515 if (slMOTD
<> '') and (mlist
[f
].slMOTD
<> '') then
1517 slMOTD
:= mlist
[f
].slMOTD
;
1523 if (length(SL
) = 0) then
1525 CheckLocalServers();
1529 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
1530 if Sock
= ENET_SOCKET_NULL
then Exit
;
1531 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
1533 for I
:= Low(SL
) to High(SL
) do PingServer(SL
[I
], Sock
);
1535 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
1540 InMsg
.Alloc(NET_BUFSIZE
);
1541 Buf
.data
:= InMsg
.Data
;
1542 Buf
.dataLength
:= InMsg
.MaxSize
;
1544 while GetTimerMS() - T
<= 500 do
1548 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
1549 if RX
<= 0 then continue
;
1550 InMsg
.CurSize
:= RX
;
1552 InMsg
.BeginReading();
1554 if InMsg
.ReadChar() <> 'D' then continue
;
1555 if InMsg
.ReadChar() <> 'F' then continue
;
1559 Port
:= InMsg
.ReadWord();
1560 Ping
:= InMsg
.ReadInt64();
1561 Ping
:= GetTimerMS() - Ping
;
1562 Name
:= InMsg
.ReadString();
1563 Map
:= InMsg
.ReadString();
1564 GameMode
:= InMsg
.ReadByte();
1565 Players
:= InMsg
.ReadByte();
1566 MaxPlayers
:= InMsg
.ReadByte();
1567 Protocol
:= InMsg
.ReadByte();
1568 Password
:= InMsg
.ReadByte() = 1;
1569 LocalPl
:= InMsg
.ReadByte();
1570 Bots
:= InMsg
.ReadWord();
1575 for I
:= Low(SL
) to High(SL
) do
1576 if (SL
[I
].PingAddr
.host
= SvAddr
.host
) and
1577 (SL
[I
].PingAddr
.port
= SvAddr
.port
) and
1578 (SL
[I
].Port
= tmpsv
.Port
) and
1579 (SL
[I
].Name
= tmpsv
.Name
) then
1581 tmpsv
.IP
:= SL
[I
].IP
;
1591 SetLength(SL
, I
+ 1);
1592 tmpsv
.IP
:= DecodeIPV4(SvAddr
.host
);
1598 enet_socket_destroy(Sock
);
1605 //==========================================================================
1607 // GetServerFromTable
1609 //==========================================================================
1610 function GetServerFromTable (Index
: Integer; SL
: TNetServerList
; ST
: TNetServerTable
): TNetServer
;
1613 Result
.Protocol
:= 0;
1618 Result
.Players
:= 0;
1619 Result
.MaxPlayers
:= 0;
1620 Result
.LocalPl
:= 0;
1623 Result
.GameMode
:= 0;
1624 Result
.Password
:= false;
1625 FillChar(Result
.PingAddr
, SizeOf(ENetAddress
), 0);
1628 if (Index
< 0) or (Index
>= Length(ST
)) then
1630 Result
:= SL
[ST
[Index
].Indices
[ST
[Index
].Current
]];
1634 //==========================================================================
1636 // g_Serverlist_Draw
1638 //==========================================================================
1639 procedure g_Serverlist_Draw (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1642 sy
, i
, y
, mw
, mx
, l
, motdh
: Integer;
1652 e_CharFont_GetSize(gMenuFont
, _lc
[I_NET_SLIST
], ww
, hh
);
1653 e_CharFont_Print(gMenuFont
, (gScreenWidth
div 2) - (ww
div 2), 16, _lc
[I_NET_SLIST
]);
1655 e_TextureFontGetSize(gStdFont
, cw
, ch
);
1657 ip
:= _lc
[I_NET_SLIST_HELP
];
1658 mw
:= (Length(ip
) * cw
) div 2;
1660 motdh
:= gScreenHeight
- 49 - ch
* b_Text_LineCount(slMOTD
);
1662 e_DrawFillQuad(16, 64, gScreenWidth
-16, motdh
, 64, 64, 64, 110);
1663 e_DrawQuad(16, 64, gScreenWidth
-16, motdh
, 255, 127, 0);
1665 e_TextureFontPrintEx(gScreenWidth
div 2 - mw
, gScreenHeight
-24, ip
, gStdFont
, 225, 225, 225, 1);
1668 if slMOTD
<> '' then
1670 e_DrawFillQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 110);
1671 e_DrawQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 255, 127, 0);
1672 e_TextureFontPrintFmt(20, motdh
+ 3, slMOTD
, gStdFont
, False, True);
1676 if not slReadUrgent
and (slUrgent
<> '') then
1678 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
1679 e_DrawFillQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
1680 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 64, 64, 64, 128);
1681 e_DrawQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
1682 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 255, 127, 0);
1683 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 40,
1684 gScreenWidth
div 2 + 256, gScreenHeight
div 2 - 40, 255, 127, 0);
1685 l
:= Length(_lc
[I_NET_SLIST_URGENT
]) div 2;
1686 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - 58,
1687 _lc
[I_NET_SLIST_URGENT
], gStdFont
);
1688 l
:= Length(slUrgent
) div 2;
1689 e_TextureFontPrintFmt(gScreenWidth
div 2 - 253, gScreenHeight
div 2 - 38,
1690 slUrgent
, gStdFont
, False, True);
1691 l
:= Length(_lc
[I_NET_SLIST_URGENT_CONT
]) div 2;
1692 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 + 41,
1693 _lc
[I_NET_SLIST_URGENT_CONT
], gStdFont
);
1694 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 + 40,
1695 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 40, 255, 127, 0);
1701 l
:= Length(slWaitStr
) div 2;
1702 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
1703 e_DrawQuad(gScreenWidth
div 2 - 192, gScreenHeight
div 2 - 10,
1704 gScreenWidth
div 2 + 192, gScreenHeight
div 2 + 11, 255, 127, 0);
1705 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - ch
div 2,
1706 slWaitStr
, gStdFont
);
1711 if (slSelection
< Length(ST
)) then
1714 sy
:= y
+ 42 * I
- 4;
1715 Srv
:= GetServerFromTable(I
, SL
, ST
);
1716 ip
:= _lc
[I_NET_ADDRESS
] + ' ' + Srv
.IP
+ ':' + IntToStr(Srv
.Port
);
1717 if Srv
.Password
then
1718 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_YES
]
1720 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_NO
];
1722 if Length(ST
) > 0 then
1725 mw
:= (gScreenWidth
- 188);
1728 e_DrawFillQuad(16 + 1, sy
, gScreenWidth
- 16 - 1, sy
+ 40, 64, 64, 64, 0);
1729 e_DrawLine(1, 16 + 1, sy
, gScreenWidth
- 16 - 1, sy
, 205, 205, 205);
1730 e_DrawLine(1, 16 + 1, sy
+ 41, gScreenWidth
- 16 - 1, sy
+ 41, 255, 255, 255);
1732 e_DrawLine(1, 16, 85, gScreenWidth
- 16, 85, 255, 127, 0);
1733 e_DrawLine(1, 16, motdh
-20, gScreenWidth
-16, motdh
-20, 255, 127, 0);
1735 e_DrawLine(1, mx
- 70, 64, mx
- 70, motdh
, 255, 127, 0);
1736 e_DrawLine(1, mx
, 64, mx
, motdh
-20, 255, 127, 0);
1737 e_DrawLine(1, mx
+ 52, 64, mx
+ 52, motdh
-20, 255, 127, 0);
1738 e_DrawLine(1, mx
+ 104, 64, mx
+ 104, motdh
-20, 255, 127, 0);
1740 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont
, 255, 127, 0, 1);
1741 e_TextureFontPrintEx(mx
- 68, 68, 'PING', gStdFont
, 255, 127, 0, 1);
1742 e_TextureFontPrintEx(mx
+ 2, 68, 'MODE', gStdFont
, 255, 127, 0, 1);
1743 e_TextureFontPrintEx(mx
+ 54, 68, 'PLRS', gStdFont
, 255, 127, 0, 1);
1744 e_TextureFontPrintEx(mx
+ 106, 68, 'VER', gStdFont
, 255, 127, 0, 1);
1747 for I
:= 0 to High(ST
) do
1749 Srv
:= GetServerFromTable(I
, SL
, ST
);
1751 e_TextureFontPrintEx(18, y
, Srv
.Name
, gStdFont
, 255, 255, 255, 1);
1752 e_TextureFontPrintEx(18, y
+ 16, Srv
.Map
, gStdFont
, 210, 210, 210, 1);
1754 // Ping and similar count
1755 if (Srv
.Ping
< 0) or (Srv
.Ping
> 999) then
1756 e_TextureFontPrintEx(mx
- 68, y
, _lc
[I_NET_SLIST_NO_ACCESS
], gStdFont
, 255, 0, 0, 1)
1758 if Srv
.Ping
= 0 then
1759 e_TextureFontPrintEx(mx
- 68, y
, '<1' + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1)
1761 e_TextureFontPrintEx(mx
- 68, y
, IntToStr(Srv
.Ping
) + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1);
1763 if Length(ST
[I
].Indices
) > 1 then
1764 e_TextureFontPrintEx(mx
- 68, y
+ 16, '< ' + IntToStr(Length(ST
[I
].Indices
)) + ' >', gStdFont
, 210, 210, 210, 1);
1767 e_TextureFontPrintEx(mx
+ 2, y
, g_Game_ModeToText(Srv
.GameMode
), gStdFont
, 255, 255, 255, 1);
1770 e_TextureFontPrintEx(mx
+ 54, y
, IntToStr(Srv
.Players
) + '/' + IntToStr(Srv
.MaxPlayers
), gStdFont
, 255, 255, 255, 1);
1771 e_TextureFontPrintEx(mx
+ 54, y
+ 16, IntToStr(Srv
.LocalPl
) + '+' + IntToStr(Srv
.Bots
), gStdFont
, 210, 210, 210, 1);
1774 e_TextureFontPrintEx(mx
+ 106, y
, IntToStr(Srv
.Protocol
), gStdFont
, 255, 255, 255, 1);
1779 e_TextureFontPrintEx(20, motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
1780 ip
:= IntToStr(Length(ST
)) + _lc
[I_NET_SLIST_SERVERS
];
1781 e_TextureFontPrintEx(gScreenWidth
- 48 - (Length(ip
) + 1)*cw
,
1782 motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
1786 //==========================================================================
1788 // g_Serverlist_GenerateTable
1790 //==========================================================================
1791 procedure g_Serverlist_GenerateTable (SL
: TNetServerList
; var ST
: TNetServerTable
);
1795 function FindServerInTable(Name
: AnsiString
; Port
: Word): Integer;
1802 for i
:= Low(ST
) to High(ST
) do
1804 if Length(ST
[i
].Indices
) = 0 then
1806 if (SL
[ST
[i
].Indices
[0]].Name
= Name
) and (SL
[ST
[i
].Indices
[0]].Port
= Port
) then
1813 function ComparePing(i1
, i2
: Integer): Boolean;
1819 if (p1
< 0) then p1
:= 999;
1820 if (p2
< 0) then p2
:= 999;
1823 procedure SortIndices(var ind
: Array of Integer);
1828 for I
:= High(ind
) downto Low(ind
) do
1829 for J
:= Low(ind
) to High(ind
) - 1 do
1830 if ComparePing(ind
[j
], ind
[j
+1]) then
1837 procedure SortRows();
1842 for I
:= High(ST
) downto Low(ST
) do
1843 for J
:= Low(ST
) to High(ST
) - 1 do
1844 if ComparePing(ST
[j
].Indices
[0], ST
[j
+1].Indices
[0]) then
1856 for i
:= Low(SL
) to High(SL
) do
1858 j
:= FindServerInTable(SL
[i
].Name
, SL
[i
].Port
);
1862 SetLength(ST
, j
+ 1);
1864 SetLength(ST
[j
].Indices
, 1);
1865 ST
[j
].Indices
[0] := i
;
1869 SetLength(ST
[j
].Indices
, Length(ST
[j
].Indices
) + 1);
1870 ST
[j
].Indices
[High(ST
[j
].Indices
)] := i
;
1874 for i
:= Low(ST
) to High(ST
) do
1875 SortIndices(ST
[i
].Indices
);
1881 //==========================================================================
1883 // g_Serverlist_Control
1885 //==========================================================================
1886 procedure g_Serverlist_Control (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1891 g_Net_Slist_Pulse();
1893 if gConsoleShow
or gChatShow
then
1896 qm
:= sys_HandleEvents(); // this updates kbd
1898 if qm
or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) or
1899 e_KeyPressed(JOY0_JUMP
) or e_KeyPressed(JOY1_JUMP
) or
1900 e_KeyPressed(JOY2_JUMP
) or e_KeyPressed(JOY3_JUMP
) then
1904 gState
:= STATE_MENU
;
1905 g_GUI_ShowWindow('MainMenu');
1906 g_GUI_ShowWindow('NetGameMenu');
1907 g_GUI_ShowWindow('NetClientMenu');
1908 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
1912 // if there's a message on the screen,
1913 if not slReadUrgent
and (slUrgent
<> '') then
1915 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
1916 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
1917 slReadUrgent
:= True;
1921 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(VK_JUMP
) or
1922 e_KeyPressed(JOY0_ACTIVATE
) or e_KeyPressed(JOY1_ACTIVATE
) or e_KeyPressed(JOY2_ACTIVATE
) or e_KeyPressed(JOY3_ACTIVATE
) then
1924 if not slFetched
then
1926 slWaitStr
:= _lc
[I_NET_SLIST_WAIT
];
1931 if g_Net_Slist_Fetch(SL
) then
1934 slWaitStr
:= _lc
[I_NET_SLIST_NOSERVERS
];
1938 slWaitStr
:= _lc
[I_NET_SLIST_ERROR
];
1941 g_Serverlist_GenerateTable(SL
, ST
);
1947 if SL
= nil then Exit
;
1949 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
1950 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
1952 if not slReturnPressed
then
1954 Srv
:= GetServerFromTable(slSelection
, SL
, ST
);
1955 if Srv
.Password
then
1958 PromptPort
:= Srv
.Port
;
1959 gState
:= STATE_MENU
;
1960 g_GUI_ShowWindow('ClientPasswordMenu');
1963 slReturnPressed
:= True;
1967 g_Game_StartClient(Srv
.IP
, Srv
.Port
, '');
1970 slReturnPressed
:= True;
1975 slReturnPressed
:= False;
1977 if e_KeyPressed(IK_DOWN
) or e_KeyPressed(IK_KPDOWN
) or e_KeyPressed(VK_DOWN
) or
1978 e_KeyPressed(JOY0_DOWN
) or e_KeyPressed(JOY1_DOWN
) or e_KeyPressed(JOY2_DOWN
) or e_KeyPressed(JOY3_DOWN
) then
1980 if not slDirPressed
then
1983 if slSelection
> High(ST
) then slSelection
:= 0;
1984 slDirPressed
:= True;
1988 if e_KeyPressed(IK_UP
) or e_KeyPressed(IK_KPUP
) or e_KeyPressed(VK_UP
) or
1989 e_KeyPressed(JOY0_UP
) or e_KeyPressed(JOY1_UP
) or e_KeyPressed(JOY2_UP
) or e_KeyPressed(JOY3_UP
) then
1991 if not slDirPressed
then
1993 if slSelection
= 0 then slSelection
:= Length(ST
);
1996 slDirPressed
:= True;
2000 if e_KeyPressed(IK_RIGHT
) or e_KeyPressed(IK_KPRIGHT
) or e_KeyPressed(VK_RIGHT
) or
2001 e_KeyPressed(JOY0_RIGHT
) or e_KeyPressed(JOY1_RIGHT
) or e_KeyPressed(JOY2_RIGHT
) or e_KeyPressed(JOY3_RIGHT
) then
2003 if not slDirPressed
then
2005 Inc(ST
[slSelection
].Current
);
2006 if ST
[slSelection
].Current
> High(ST
[slSelection
].Indices
) then ST
[slSelection
].Current
:= 0;
2007 slDirPressed
:= True;
2011 if e_KeyPressed(IK_LEFT
) or e_KeyPressed(IK_KPLEFT
) or e_KeyPressed(VK_LEFT
) or
2012 e_KeyPressed(JOY0_LEFT
) or e_KeyPressed(JOY1_LEFT
) or e_KeyPressed(JOY2_LEFT
) or e_KeyPressed(JOY3_LEFT
) then
2014 if not slDirPressed
then
2016 if ST
[slSelection
].Current
= 0 then ST
[slSelection
].Current
:= Length(ST
[slSelection
].Indices
);
2017 Dec(ST
[slSelection
].Current
);
2019 slDirPressed
:= True;
2023 if (not e_KeyPressed(IK_DOWN
)) and
2024 (not e_KeyPressed(IK_UP
)) and
2025 (not e_KeyPressed(IK_RIGHT
)) and
2026 (not e_KeyPressed(IK_LEFT
)) and
2027 (not e_KeyPressed(IK_KPDOWN
)) and
2028 (not e_KeyPressed(IK_KPUP
)) and
2029 (not e_KeyPressed(IK_KPRIGHT
)) and
2030 (not e_KeyPressed(IK_KPLEFT
)) and
2031 (not e_KeyPressed(VK_DOWN
)) and
2032 (not e_KeyPressed(VK_UP
)) and
2033 (not e_KeyPressed(VK_RIGHT
)) and
2034 (not e_KeyPressed(VK_LEFT
)) and
2035 (not e_KeyPressed(JOY0_UP
)) and (not e_KeyPressed(JOY1_UP
)) and (not e_KeyPressed(JOY2_UP
)) and (not e_KeyPressed(JOY3_UP
)) and
2036 (not e_KeyPressed(JOY0_DOWN
)) and (not e_KeyPressed(JOY1_DOWN
)) and (not e_KeyPressed(JOY2_DOWN
)) and (not e_KeyPressed(JOY3_DOWN
)) and
2037 (not e_KeyPressed(JOY0_LEFT
)) and (not e_KeyPressed(JOY1_LEFT
)) and (not e_KeyPressed(JOY2_LEFT
)) and (not e_KeyPressed(JOY3_LEFT
)) and
2038 (not e_KeyPressed(JOY0_RIGHT
)) and (not e_KeyPressed(JOY1_RIGHT
)) and (not e_KeyPressed(JOY2_RIGHT
)) and (not e_KeyPressed(JOY3_RIGHT
))
2040 slDirPressed
:= False;