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
;
41 Players
, MaxPlayers
, LocalPl
, Bots
: Byte;
45 PingAddr
: ENetAddress
;
47 pTNetServer
= ^TNetServer
;
48 TNetServerRow
= record
49 Indices
: Array of Integer;
53 TNetServerList
= array of TNetServer
;
54 pTNetServerList
= ^TNetServerList
;
55 TNetServerTable
= array of TNetServerRow
;
65 enetAddr
: ENetAddress
;
66 // inside the game, calling `connect()` is disasterous, as it is blocking.
67 // so we'll use this variable to indicate if "connected" event is received.
68 NetHostConnected
: Boolean;
69 NetHostConReqTime
: Int64; // to timeout `connect`; -1 means "waiting for shutdown"
70 NetUpdatePending
: Boolean; // should we send an update after connection completes?
72 lastUpdateTime
: Int64;
73 // server list request working flags
75 srvAnswer
: array of TNetServer
;
78 slReadUrgent
: Boolean;
84 constructor Create (hostandport
: AnsiString);
88 function setAddress (hostandport
: AnsiString): Boolean;
90 function isSameAddress (hostandport
: AnsiString): Boolean;
92 function isValid (): Boolean;
93 function isAlive (): Boolean; // not disconnected
94 function isConnecting (): Boolean; // is connection in progress?
95 function isConnected (): Boolean;
97 // call as often as you want, the object will do the rest
98 // but try to call this at least once in 100 msecs
101 procedure disconnect (forced
: Boolean);
102 function connect (): Boolean;
107 class procedure writeInfo (var msg
: TMsg
); static
;
109 procedure connectedEvent ();
110 procedure disconnectedEvent ();
111 procedure receivedEvent (pkt
: pENetPacket
); // `pkt` is never `nil`
116 slCurrent
: TNetServerList
= nil;
117 slTable
: TNetServerTable
= nil;
118 slWaitStr
: AnsiString = '';
119 slReturnPressed
: Boolean = True;
121 slMOTD
: AnsiString = '';
122 slUrgent
: AnsiString = '';
125 procedure g_Net_Slist_Set (IP
: AnsiString; Port
: Word);
126 function g_Net_Slist_Fetch (var SL
: TNetServerList
): Boolean;
128 // make this server private
129 procedure g_Net_Slist_Private ();
130 // make this server public
131 procedure g_Net_Slist_Public ();
133 // called on network mode init
134 procedure g_Net_Slist_NetworkStarted ();
135 // called on network mode shutdown
136 procedure g_Net_Slist_NetworkStopped ();
138 procedure g_Net_Slist_Pulse (timeout
: Integer=0);
140 procedure g_Serverlist_GenerateTable (SL
: TNetServerList
; var ST
: TNetServerTable
);
141 procedure g_Serverlist_Draw (var SL
: TNetServerList
; var ST
: TNetServerTable
);
142 procedure g_Serverlist_Control (var SL
: TNetServerList
; var ST
: TNetServerTable
);
144 function GetTimerMS (): Int64;
150 e_input
, e_graphics
, e_log
, g_window
, g_net
, g_console
,
151 g_map
, g_game
, g_sound
, g_gui
, g_menu
, g_options
, g_language
, g_basic
,
152 wadreader
, g_system
, utils
;
154 // make this server private
155 procedure g_Net_Slist_Private ();
160 // make this server public
161 procedure g_Net_Slist_Public ();
166 // called on network mode init
167 procedure g_Net_Slist_NetworkStarted ();
171 // called on network mode shutdown
172 procedure g_Net_Slist_NetworkStopped ();
178 NetMHost
: pENetHost
= nil;
179 NetMEvent
: ENetEvent
;
180 mlist
: array of TMasterHost
= nil;
182 slSelection
: Byte = 0;
183 slFetched
: Boolean = False;
184 slDirPressed
: Boolean = False;
185 slReadUrgent
: Boolean = False;
188 //==========================================================================
192 //==========================================================================
193 function GetTimerMS (): Int64;
195 Result
:= sys_GetTicks() {div 1000};
199 //==========================================================================
203 //==========================================================================
204 function findByPeer (peer
: pENetPeer
): Integer;
208 for f
:= 0 to High(mlist
) do if (mlist
[f
].peer
= peer
) then begin result
:= f
; exit
; end;
213 //==========================================================================
215 // TMasterHost.Create
217 //==========================================================================
218 constructor TMasterHost
.Create (hostandport
: AnsiString);
221 NetHostConnected
:= false;
222 NetHostConReqTime
:= 0;
223 NetUpdatePending
:= false;
227 SetLength(srvAnswer
, 0);
231 slReadUrgent
:= true;
232 netmsg
.Alloc(NET_BUFSIZE
);
233 setAddress(hostandport
);
237 //==========================================================================
241 //==========================================================================
242 procedure TMasterHost
.clear ();
244 updateSent
:= false; // do not send 'remove'
249 SetLength(srvAnswer
, 0);
253 slReadUrgent
:= true;
257 //==========================================================================
259 // TMasterHost.isSameAddress
261 //==========================================================================
262 function TMasterHost
.isSameAddress (hostandport
: AnsiString): Boolean;
268 if not isValid() then exit
;
269 hostandport
:= Trim(hostandport
);
270 if (length(hostandport
) = 0) then exit
;
272 cp
:= Pos(':', hostandport
);
275 hn
:= Copy(hostandport
, 1, cp
-1);
276 Delete(hostandport
, 1, cp
);
277 if (length(hostandport
) > 0) then
280 pp
:= StrToInt(hostandport
);
290 result
:= strEquCI1251(hn
, hostName
) and (hostPort
= pp
);
294 //==========================================================================
296 // TMasterHost.setAddress
298 //==========================================================================
299 function TMasterHost
.setAddress (hostandport
: AnsiString): Boolean;
304 SetLength(srvAnswer
, 0);
308 slReadUrgent
:= true;
309 updateSent
:= false; // do not send 'remove'
314 if (not g_Net_IsNetworkAvailable()) then exit
;
316 hostandport
:= Trim(hostandport
);
317 if (length(hostandport
) > 0) then
319 hostName
:= hostandport
;
320 cp
:= Pos(':', hostandport
);
323 hostName
:= Copy(hostandport
, 1, cp
-1);
324 Delete(hostandport
, 1, cp
);
325 if (length(hostandport
) > 0) then
328 pp
:= StrToInt(hostandport
);
332 if (pp
> 0) and (pp
< 65536) then hostPort
:= pp
else hostPort
:= 0;
337 if not isValid() then exit
;
339 if (enet_address_set_host(@enetAddr
, PChar(Addr(hostName
[1]))) <> 0) then
345 enetAddr
.Port
:= hostPort
;
348 //writeln('*********************: ', hostandport, ' [', hostName, ':', hostPort, '] ', result);
352 //==========================================================================
354 // TMasterHost.isValid
356 //==========================================================================
357 function TMasterHost
.isValid (): Boolean;
359 result
:= (length(hostName
) > 0) and (hostPort
> 0);
363 //==========================================================================
365 // TMasterHost.isAlive
369 //==========================================================================
370 function TMasterHost
.isAlive (): Boolean;
372 result
:= (NetMHost
<> nil) and (peer
<> nil);
376 //==========================================================================
378 // TMasterHost.isConnecting
380 // is connection in progress?
382 //==========================================================================
383 function TMasterHost
.isConnecting (): Boolean;
385 result
:= isAlive() and (not NetHostConnected
) and (NetHostConReqTime
<> -1);
389 //==========================================================================
391 // TMasterHost.isConnected
393 //==========================================================================
394 function TMasterHost
.isConnected (): Boolean;
396 result
:= isAlive() and (NetHostConnected
) and (NetHostConReqTime
<> -1);
400 //==========================================================================
402 // TMasterHost.connectedEvent
404 //==========================================================================
405 procedure TMasterHost
.connectedEvent ();
407 if not isAlive() then exit
;
408 if NetHostConnected
then exit
;
409 NetHostConnected
:= true;
410 e_LogWritefln('connected to master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
414 //==========================================================================
416 // TMasterHost.disconnectedEvent
418 //==========================================================================
419 procedure TMasterHost
.disconnectedEvent ();
421 if not isAlive() then exit
;
422 e_LogWritefln('disconnected from master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
424 //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
428 //==========================================================================
430 // TMasterHost.receivedEvent
432 // `pkt` is never `nil`
434 //==========================================================================
435 procedure TMasterHost
.receivedEvent (pkt
: pENetPacket
);
443 e_LogWritefln('received packed from master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
444 if not msg
.Init(pkt
^.data
, pkt
^.dataLength
, True) then exit
;
446 MID
:= msg
.ReadByte();
447 if (MID
<> NET_MMSG_GET
) then exit
;
448 e_LogWritefln('received list packet from master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
449 SetLength(srvAnswer
, 0);
450 if (srvAnswered
> 0) then Inc(srvAnswered
);
453 slReadUrgent
:= true;
455 Cnt
:= msg
.ReadByte();
456 g_Console_Add(_lc
[I_NET_MSG
]+Format(_lc
[I_NET_SLIST_RETRIEVED
], [Cnt
]), True);
459 SetLength(srvAnswer
, Cnt
);
460 for f
:= 0 to Cnt
-1 do
462 srvAnswer
[f
].Number
:= f
;
463 srvAnswer
[f
].IP
:= msg
.ReadString();
464 srvAnswer
[f
].Port
:= msg
.ReadWord();
465 srvAnswer
[f
].Name
:= msg
.ReadString();
466 srvAnswer
[f
].Map
:= msg
.ReadString();
467 srvAnswer
[f
].GameMode
:= msg
.ReadByte();
468 srvAnswer
[f
].Players
:= msg
.ReadByte();
469 srvAnswer
[f
].MaxPlayers
:= msg
.ReadByte();
470 srvAnswer
[f
].Protocol
:= msg
.ReadByte();
471 srvAnswer
[f
].Password
:= msg
.ReadByte() = 1;
472 enet_address_set_host(Addr(srvAnswer
[f
].PingAddr
), PChar(Addr(srvAnswer
[f
].IP
[1])));
473 srvAnswer
[f
].Ping
:= -1;
474 srvAnswer
[f
].PingAddr
.port
:= NET_PING_PORT
;
478 if (msg
.ReadCount
< msg
.CurSize
) then
480 // new master, supports version reports
481 s
:= msg
.ReadString();
482 if (s
<> {MyVer}GAME_VERSION
) then
485 g_Console_Add('!!! UpdVer = `'+s
+'`');
487 // even newer master, supports extra info
488 if (msg
.ReadCount
< msg
.CurSize
) then
490 slMOTD
:= b_Text_Format(msg
.ReadString());
491 s
:= b_Text_Format(msg
.ReadString());
492 // check if the message has updated and the user has to read it again
493 if (slUrgent
<> s
) then slReadUrgent
:= false;
500 //==========================================================================
504 // this performs various scheduled tasks, if necessary
506 //==========================================================================
507 procedure TMasterHost
.pulse ();
511 if not isAlive() then exit
;
512 if (NetHostConReqTime
= -1) then exit
; // waiting for shutdown (disconnect in progress)
513 // process pending connection timeout
514 if (not NetHostConnected
) then
517 if (ct
< NetHostConReqTime
) or (ct
-NetHostConReqTime
>= 3000) then
519 e_LogWritefln('failed to connect to master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
520 // do not spam with error messages, it looks like the master is down
521 //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
522 enet_peer_disconnect(peer
, 0);
523 // main pulse will take care of the rest
530 //==========================================================================
532 // TMasterHost.disconnect
534 //==========================================================================
535 procedure TMasterHost
.disconnect (forced
: Boolean);
537 if not isAlive() then exit
;
538 //if (NetMode = NET_SERVER) and isConnected() and updateSent then remove();
542 enet_peer_reset(peer
);
544 NetHostConReqTime
:= 0;
548 enet_peer_disconnect_later(peer
, 0);
549 // main pulse will take care of the rest
550 NetHostConReqTime
:= -1;
553 NetHostConnected
:= false;
554 NetUpdatePending
:= false;
556 //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
560 //==========================================================================
562 // TMasterHost.connect
564 //==========================================================================
565 function TMasterHost
.connect (): Boolean;
568 if not isValid() then exit
;
569 if (NetHostConReqTime
= -1) then
575 if isAlive() then begin result
:= true; exit
; end;
578 SetLength(srvAnswer
, 0);
580 NetHostConnected
:= false;
581 NetHostConReqTime
:= 0;
582 NetUpdatePending
:= false;
585 peer
:= enet_host_connect(NetMHost
, @enetAddr
, NET_MCHANS
, 0);
588 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], true);
592 NetHostConReqTime
:= GetTimerMS();
593 e_LogWritefln('connecting to master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
597 //==========================================================================
599 // TMasterHost.writeInfo
601 //==========================================================================
602 class procedure TMasterHost
.writeInfo (var msg
: TMsg
);
604 wad
, map
: AnsiString;
606 wad
:= g_ExtractWadNameNoPath(gMapInfo
.Map
);
607 map
:= g_ExtractFileName(gMapInfo
.Map
);
609 msg
.Write(NetServerName
);
611 msg
.Write(wad
+':/'+map
);
612 msg
.Write(gGameSettings
.GameMode
);
614 msg
.Write(Byte(NetClientCount
));
616 msg
.Write(NetMaxClients
);
618 msg
.Write(Byte(NET_PROTOCOL_VER
));
619 msg
.Write(Byte(NetPassword
<> ''));
623 //==========================================================================
625 // TMasterHost.update
627 //==========================================================================
628 procedure TMasterHost
.update ();
632 if not isAlive() then exit
;
633 if not isConnected() then
635 NetUpdatePending
:= isConnecting();
641 netmsg
.Write(Byte(NET_MMSG_UPD
));
642 netmsg
.Write(NetAddr
.port
);
646 pkt
:= enet_packet_create(netmsg
.Data
, netmsg
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
647 if assigned(pkt
) then
649 if (enet_peer_send(peer
, NET_MCHAN_UPD
, pkt
) = 0) then NetUpdatePending
:= false;
657 //==========================================================================
659 // TMasterHost.remove
661 //==========================================================================
662 procedure TMasterHost
.remove ();
666 NetUpdatePending
:= false;
667 if not isAlive() then exit
;
668 if not isConnected() then exit
;
672 netmsg
.Write(Byte(NET_MMSG_DEL
));
673 netmsg
.Write(NetAddr
.port
);
675 pkt
:= enet_packet_create(netmsg
.Data
, netmsg
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
676 if assigned(pkt
) then
678 enet_peer_send(peer
, NET_MCHAN_MAIN
, pkt
);
686 //**************************************************************************
690 //**************************************************************************
692 procedure g_Net_Slist_Set (IP
: AnsiString; Port
: Word);
697 if (not g_Net_IsNetworkAvailable()) then exit
;
699 if (length(IP
) = 0) or (Port
= 0) then exit
;
700 sa
:= IP
+':'+IntToStr(Port
);
701 for f
:= 0 to High(mlist
) do if (mlist
[f
].isSameAddress(sa
)) then exit
;
702 SetLength(mlist
, length(mlist
)+1);
703 mlist
[High(mlist
)].Create(sa
);
704 mlist
[High(mlist
)].setAddress(sa
);
705 e_LogWritefln('Masterserver address set to [%s:%u]', [IP
, Port
], TMsgType
.Notify
);
709 //**************************************************************************
713 //**************************************************************************
714 procedure g_Net_Slist_Pulse (timeout
: Integer=0);
720 if (not g_Net_IsNetworkAvailable()) then exit
;
722 if (length(mlist
) = 0) then
724 if (NetMHost
<> nil) then
726 enet_host_destroy(NetMHost
);
732 if (NetMHost
= nil) then
734 NetMHost
:= enet_host_create(nil, 1, NET_MCHANS
, 0, 0);
735 if (NetMHost
= nil) then
737 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], True);
738 for f
:= 0 to High(mlist
) do mlist
[f
].clear();
744 for f
:= 0 to High(mlist
) do mlist
[f
].pulse();
748 sres
:= enet_host_service(NetMHost
, @NetMEvent
, timeout
);
751 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], True);
752 for f
:= 0 to High(mlist
) do mlist
[f
].clear();
754 enet_host_destroy(NetMHost
);
759 if (sres
= 0) then break
;
760 idx
:= findByPeer(NetMEvent
.peer
);
763 e_LogWriteln('network event from unknown master host. ignored.', TMsgType
.Warning
);
764 if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then enet_packet_destroy(NetMEvent
.packet
);
768 if (NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
770 mlist
[idx
].connectedEvent();
772 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
774 mlist
[idx
].disconnectedEvent();
776 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
778 mlist
[idx
].receivedEvent(NetMEvent
.packet
);
779 enet_packet_destroy(NetMEvent
.packet
);
785 //**************************************************************************
787 // gui and server list
789 //**************************************************************************
791 //==========================================================================
795 //==========================================================================
796 procedure PingServer (var S
: TNetServer
; Sock
: ENetSocket
);
799 Ping
: array [0..9] of Byte;
802 ClTime
:= GetTimerMS();
804 Buf
.data
:= Addr(Ping
[0]);
805 Buf
.dataLength
:= 2+8;
809 Int64(Addr(Ping
[2])^) := ClTime
;
811 enet_socket_send(Sock
, Addr(S
.PingAddr
), @Buf
, 1);
815 //==========================================================================
819 //==========================================================================
820 procedure PingBcast (Sock
: ENetSocket
);
824 S
.IP
:= '255.255.255.255';
825 S
.Port
:= NET_PING_PORT
;
826 enet_address_set_host(Addr(S
.PingAddr
), PChar(Addr(S
.IP
[1])));
828 S
.PingAddr
.port
:= S
.Port
;
833 //==========================================================================
837 //==========================================================================
838 function g_Net_Slist_Fetch (var SL
: TNetServerList
): Boolean;
851 procedure DisconnectAll ();
858 while (length(mlist
) > 0) do
861 for f
:= 0 to High(mlist
) do
863 if (mlist
[f
].isAlive()) then
866 mlist
[f
].disconnect(false);
869 if not hasAlive
then break
;
870 g_Net_Slist_Pulse(100);
872 if (ct
< stt
) or (ct
-stt
> 800) then break
;
876 procedure ProcessLocal ();
879 SetLength(SL
, I
+ 1);
882 IP
:= DecodeIPV4(SvAddr
.host
);
883 Port
:= InMsg
.ReadWord();
884 Ping
:= InMsg
.ReadInt64();
885 Ping
:= GetTimerMS() - Ping
;
886 Name
:= InMsg
.ReadString();
887 Map
:= InMsg
.ReadString();
888 GameMode
:= InMsg
.ReadByte();
889 Players
:= InMsg
.ReadByte();
890 MaxPlayers
:= InMsg
.ReadByte();
891 Protocol
:= InMsg
.ReadByte();
892 Password
:= InMsg
.ReadByte() = 1;
893 LocalPl
:= InMsg
.ReadByte();
894 Bots
:= InMsg
.ReadWord();
898 procedure CheckLocalServers ();
902 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
903 if Sock
= ENET_SOCKET_NULL
then Exit
;
904 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
905 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
910 InMsg
.Alloc(NET_BUFSIZE
);
911 Buf
.data
:= InMsg
.Data
;
912 Buf
.dataLength
:= InMsg
.MaxSize
;
913 while GetTimerMS() - T
<= 500 do
917 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
918 if RX
<= 0 then continue
;
921 InMsg
.BeginReading();
923 if InMsg
.ReadChar() <> 'D' then continue
;
924 if InMsg
.ReadChar() <> 'F' then continue
;
930 enet_socket_destroy(Sock
);
932 if Length(SL
) = 0 then SL
:= nil;
936 f
, c
, n
, pos
: Integer;
938 hasUnanswered
: Boolean;
944 if (not g_Net_IsNetworkAvailable()) then
950 g_Net_Slist_Pulse(); // this will create mhost
953 NetOut
.Write(Byte(NET_MMSG_GET
));
955 // TODO: what should we identify the build with?
956 MyVer
:= GAME_VERSION
;
960 e_WriteLog('Fetching serverlist...', TMsgType
.Notify
);
961 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_FETCH
]);
963 // wait until all servers connected and answered
967 g_Net_Slist_Pulse(300);
969 hasUnanswered
:= false;
970 for f
:= 0 to High(mlist
) do
973 e_LogWritefln(' master #%d: [%s:%u] valid=%d; alive=%d; connected=%d; connecting=%d',
974 [f, mlist[f].hostName, mlist[f].hostPort, Integer(mlist[f].isValid()), Integer(mlist[f].isAlive()),
975 Integer(mlist[f].isConnected()), Integer(mlist[f].isConnecting())], TMsgType.Notify);
977 if (not mlist
[f
].isValid()) then continue
;
978 if (not mlist
[f
].isAlive()) then
981 if (mlist
[f
].isAlive()) then
983 hasUnanswered
:= true;
987 else if (mlist
[f
].isConnected()) then
989 if (mlist
[f
].srvAnswered
= 0) then
991 pkt
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
992 if assigned(pkt
) then
994 if (enet_peer_send(mlist
[f
].peer
, NET_MCHAN_MAIN
, pkt
) = 0) then
996 hasUnanswered
:= true;
997 mlist
[f
].srvAnswered
:= 1;
1002 else if (mlist
[f
].srvAnswered
= 1) then
1004 hasUnanswered
:= true;
1006 else if (mlist
[f
].srvAnswered
> 1) then
1011 else if (mlist
[f
].isConnecting()) then
1013 hasUnanswered
:= true;
1016 if (not hasUnanswered
) then break
;
1017 // check for timeout
1019 if (ct
< stt
) or (ct
-stt
> 4000) then break
;
1022 if (aliveCount
= 0) then
1025 CheckLocalServers();
1032 slReadUrgent := true;
1036 for f
:= 0 to High(mlist
) do
1038 if (mlist
[f
].srvAnswered
< 2) then continue
;
1039 for n
:= 0 to High(mlist
[f
].srvAnswer
) do
1042 for c
:= 0 to High(SL
) do
1044 if (SL
[c
].IP
= mlist
[f
].srvAnswer
[n
].IP
) and (SL
[c
].Port
= mlist
[f
].srvAnswer
[n
].Port
) then
1053 SetLength(SL
, pos
+1);
1054 SL
[pos
] := mlist
[f
].srvAnswer
[n
];
1055 SL
[pos
].Number
:= pos
;
1058 if (not mlist
[f
].slReadUrgent
) and (mlist
[f
].slUrgent
<> '') then
1060 if (mlist
[f
].slUrgent
<> slUrgent
) then
1062 slUrgent
:= mlist
[f
].slUrgent
;
1063 slReadUrgent
:= false;
1066 if (slMOTD
<> '') and (mlist
[f
].slMOTD
<> '') then
1068 slMOTD
:= mlist
[f
].slMOTD
;
1074 if (length(SL
) = 0) then
1076 CheckLocalServers();
1080 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
1081 if Sock
= ENET_SOCKET_NULL
then Exit
;
1082 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
1084 for I
:= Low(SL
) to High(SL
) do PingServer(SL
[I
], Sock
);
1086 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
1091 InMsg
.Alloc(NET_BUFSIZE
);
1092 Buf
.data
:= InMsg
.Data
;
1093 Buf
.dataLength
:= InMsg
.MaxSize
;
1095 while GetTimerMS() - T
<= 500 do
1099 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
1100 if RX
<= 0 then continue
;
1101 InMsg
.CurSize
:= RX
;
1103 InMsg
.BeginReading();
1105 if InMsg
.ReadChar() <> 'D' then continue
;
1106 if InMsg
.ReadChar() <> 'F' then continue
;
1109 for I
:= Low(SL
) to High(SL
) do
1110 if (SL
[I
].PingAddr
.host
= SvAddr
.host
) and
1111 (SL
[I
].PingAddr
.port
= SvAddr
.port
) then
1115 Port
:= InMsg
.ReadWord();
1116 Ping
:= InMsg
.ReadInt64();
1117 Ping
:= GetTimerMS() - Ping
;
1118 Name
:= InMsg
.ReadString();
1119 Map
:= InMsg
.ReadString();
1120 GameMode
:= InMsg
.ReadByte();
1121 Players
:= InMsg
.ReadByte();
1122 MaxPlayers
:= InMsg
.ReadByte();
1123 Protocol
:= InMsg
.ReadByte();
1124 Password
:= InMsg
.ReadByte() = 1;
1125 LocalPl
:= InMsg
.ReadByte();
1126 Bots
:= InMsg
.ReadWord();
1137 enet_socket_destroy(Sock
);
1144 //==========================================================================
1146 // GetServerFromTable
1148 //==========================================================================
1149 function GetServerFromTable (Index
: Integer; SL
: TNetServerList
; ST
: TNetServerTable
): TNetServer
;
1152 Result
.Protocol
:= 0;
1157 Result
.Players
:= 0;
1158 Result
.MaxPlayers
:= 0;
1159 Result
.LocalPl
:= 0;
1162 Result
.GameMode
:= 0;
1163 Result
.Password
:= false;
1164 FillChar(Result
.PingAddr
, SizeOf(ENetAddress
), 0);
1167 if (Index
< 0) or (Index
>= Length(ST
)) then
1169 Result
:= SL
[ST
[Index
].Indices
[ST
[Index
].Current
]];
1173 //==========================================================================
1175 // g_Serverlist_Draw
1177 //==========================================================================
1178 procedure g_Serverlist_Draw (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1181 sy
, i
, y
, mw
, mx
, l
, motdh
: Integer;
1191 e_CharFont_GetSize(gMenuFont
, _lc
[I_NET_SLIST
], ww
, hh
);
1192 e_CharFont_Print(gMenuFont
, (gScreenWidth
div 2) - (ww
div 2), 16, _lc
[I_NET_SLIST
]);
1194 e_TextureFontGetSize(gStdFont
, cw
, ch
);
1196 ip
:= _lc
[I_NET_SLIST_HELP
];
1197 mw
:= (Length(ip
) * cw
) div 2;
1199 motdh
:= gScreenHeight
- 49 - ch
* b_Text_LineCount(slMOTD
);
1201 e_DrawFillQuad(16, 64, gScreenWidth
-16, motdh
, 64, 64, 64, 110);
1202 e_DrawQuad(16, 64, gScreenWidth
-16, motdh
, 255, 127, 0);
1204 e_TextureFontPrintEx(gScreenWidth
div 2 - mw
, gScreenHeight
-24, ip
, gStdFont
, 225, 225, 225, 1);
1207 if slMOTD
<> '' then
1209 e_DrawFillQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 110);
1210 e_DrawQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 255, 127, 0);
1211 e_TextureFontPrintFmt(20, motdh
+ 3, slMOTD
, gStdFont
, False, True);
1215 if not slReadUrgent
and (slUrgent
<> '') then
1217 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
1218 e_DrawFillQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
1219 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 64, 64, 64, 128);
1220 e_DrawQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
1221 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 255, 127, 0);
1222 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 40,
1223 gScreenWidth
div 2 + 256, gScreenHeight
div 2 - 40, 255, 127, 0);
1224 l
:= Length(_lc
[I_NET_SLIST_URGENT
]) div 2;
1225 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - 58,
1226 _lc
[I_NET_SLIST_URGENT
], gStdFont
);
1227 l
:= Length(slUrgent
) div 2;
1228 e_TextureFontPrintFmt(gScreenWidth
div 2 - 253, gScreenHeight
div 2 - 38,
1229 slUrgent
, gStdFont
, False, True);
1230 l
:= Length(_lc
[I_NET_SLIST_URGENT_CONT
]) div 2;
1231 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 + 41,
1232 _lc
[I_NET_SLIST_URGENT_CONT
], gStdFont
);
1233 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 + 40,
1234 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 40, 255, 127, 0);
1240 l
:= Length(slWaitStr
) div 2;
1241 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
1242 e_DrawQuad(gScreenWidth
div 2 - 192, gScreenHeight
div 2 - 10,
1243 gScreenWidth
div 2 + 192, gScreenHeight
div 2 + 11, 255, 127, 0);
1244 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - ch
div 2,
1245 slWaitStr
, gStdFont
);
1250 if (slSelection
< Length(ST
)) then
1253 sy
:= y
+ 42 * I
- 4;
1254 Srv
:= GetServerFromTable(I
, SL
, ST
);
1255 ip
:= _lc
[I_NET_ADDRESS
] + ' ' + Srv
.IP
+ ':' + IntToStr(Srv
.Port
);
1256 if Srv
.Password
then
1257 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_YES
]
1259 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_NO
];
1261 if Length(ST
) > 0 then
1264 mw
:= (gScreenWidth
- 188);
1267 e_DrawFillQuad(16 + 1, sy
, gScreenWidth
- 16 - 1, sy
+ 40, 64, 64, 64, 0);
1268 e_DrawLine(1, 16 + 1, sy
, gScreenWidth
- 16 - 1, sy
, 205, 205, 205);
1269 e_DrawLine(1, 16 + 1, sy
+ 41, gScreenWidth
- 16 - 1, sy
+ 41, 255, 255, 255);
1271 e_DrawLine(1, 16, 85, gScreenWidth
- 16, 85, 255, 127, 0);
1272 e_DrawLine(1, 16, motdh
-20, gScreenWidth
-16, motdh
-20, 255, 127, 0);
1274 e_DrawLine(1, mx
- 70, 64, mx
- 70, motdh
, 255, 127, 0);
1275 e_DrawLine(1, mx
, 64, mx
, motdh
-20, 255, 127, 0);
1276 e_DrawLine(1, mx
+ 52, 64, mx
+ 52, motdh
-20, 255, 127, 0);
1277 e_DrawLine(1, mx
+ 104, 64, mx
+ 104, motdh
-20, 255, 127, 0);
1279 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont
, 255, 127, 0, 1);
1280 e_TextureFontPrintEx(mx
- 68, 68, 'PING', gStdFont
, 255, 127, 0, 1);
1281 e_TextureFontPrintEx(mx
+ 2, 68, 'MODE', gStdFont
, 255, 127, 0, 1);
1282 e_TextureFontPrintEx(mx
+ 54, 68, 'PLRS', gStdFont
, 255, 127, 0, 1);
1283 e_TextureFontPrintEx(mx
+ 106, 68, 'VER', gStdFont
, 255, 127, 0, 1);
1286 for I
:= 0 to High(ST
) do
1288 Srv
:= GetServerFromTable(I
, SL
, ST
);
1290 e_TextureFontPrintEx(18, y
, Srv
.Name
, gStdFont
, 255, 255, 255, 1);
1291 e_TextureFontPrintEx(18, y
+ 16, Srv
.Map
, gStdFont
, 210, 210, 210, 1);
1293 // Ping and similar count
1294 if (Srv
.Ping
< 0) or (Srv
.Ping
> 999) then
1295 e_TextureFontPrintEx(mx
- 68, y
, _lc
[I_NET_SLIST_NO_ACCESS
], gStdFont
, 255, 0, 0, 1)
1297 if Srv
.Ping
= 0 then
1298 e_TextureFontPrintEx(mx
- 68, y
, '<1' + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1)
1300 e_TextureFontPrintEx(mx
- 68, y
, IntToStr(Srv
.Ping
) + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1);
1302 if Length(ST
[I
].Indices
) > 1 then
1303 e_TextureFontPrintEx(mx
- 68, y
+ 16, '< ' + IntToStr(Length(ST
[I
].Indices
)) + ' >', gStdFont
, 210, 210, 210, 1);
1306 e_TextureFontPrintEx(mx
+ 2, y
, g_Game_ModeToText(Srv
.GameMode
), gStdFont
, 255, 255, 255, 1);
1309 e_TextureFontPrintEx(mx
+ 54, y
, IntToStr(Srv
.Players
) + '/' + IntToStr(Srv
.MaxPlayers
), gStdFont
, 255, 255, 255, 1);
1310 e_TextureFontPrintEx(mx
+ 54, y
+ 16, IntToStr(Srv
.LocalPl
) + '+' + IntToStr(Srv
.Bots
), gStdFont
, 210, 210, 210, 1);
1313 e_TextureFontPrintEx(mx
+ 106, y
, IntToStr(Srv
.Protocol
), gStdFont
, 255, 255, 255, 1);
1318 e_TextureFontPrintEx(20, motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
1319 ip
:= IntToStr(Length(ST
)) + _lc
[I_NET_SLIST_SERVERS
];
1320 e_TextureFontPrintEx(gScreenWidth
- 48 - (Length(ip
) + 1)*cw
,
1321 motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
1325 //==========================================================================
1327 // g_Serverlist_GenerateTable
1329 //==========================================================================
1330 procedure g_Serverlist_GenerateTable (SL
: TNetServerList
; var ST
: TNetServerTable
);
1334 function FindServerInTable(Name
: AnsiString): Integer;
1341 for i
:= Low(ST
) to High(ST
) do
1343 if Length(ST
[i
].Indices
) = 0 then
1345 if SL
[ST
[i
].Indices
[0]].Name
= Name
then
1352 function ComparePing(i1
, i2
: Integer): Boolean;
1358 if (p1
< 0) then p1
:= 999;
1359 if (p2
< 0) then p2
:= 999;
1362 procedure SortIndices(var ind
: Array of Integer);
1367 for I
:= High(ind
) downto Low(ind
) do
1368 for J
:= Low(ind
) to High(ind
) - 1 do
1369 if ComparePing(ind
[j
], ind
[j
+1]) then
1376 procedure SortRows();
1381 for I
:= High(ST
) downto Low(ST
) do
1382 for J
:= Low(ST
) to High(ST
) - 1 do
1383 if ComparePing(ST
[j
].Indices
[0], ST
[j
+1].Indices
[0]) then
1394 for i
:= Low(SL
) to High(SL
) do
1396 j
:= FindServerInTable(SL
[i
].Name
);
1400 SetLength(ST
, j
+ 1);
1402 SetLength(ST
[j
].Indices
, 1);
1403 ST
[j
].Indices
[0] := i
;
1407 SetLength(ST
[j
].Indices
, Length(ST
[j
].Indices
) + 1);
1408 ST
[j
].Indices
[High(ST
[j
].Indices
)] := i
;
1412 for i
:= Low(ST
) to High(ST
) do
1413 SortIndices(ST
[i
].Indices
);
1419 //==========================================================================
1421 // g_Serverlist_Control
1423 //==========================================================================
1424 procedure g_Serverlist_Control (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1429 if gConsoleShow
or gChatShow
then
1432 qm
:= sys_HandleInput(); // this updates kbd
1434 if qm
or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) or
1435 e_KeyPressed(JOY0_JUMP
) or e_KeyPressed(JOY1_JUMP
) or
1436 e_KeyPressed(JOY2_JUMP
) or e_KeyPressed(JOY3_JUMP
) then
1440 gState
:= STATE_MENU
;
1441 g_GUI_ShowWindow('MainMenu');
1442 g_GUI_ShowWindow('NetGameMenu');
1443 g_GUI_ShowWindow('NetClientMenu');
1444 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
1448 // if there's a message on the screen,
1449 if not slReadUrgent
and (slUrgent
<> '') then
1451 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
1452 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
1453 slReadUrgent
:= True;
1457 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(VK_JUMP
) or
1458 e_KeyPressed(JOY0_ACTIVATE
) or e_KeyPressed(JOY1_ACTIVATE
) or e_KeyPressed(JOY2_ACTIVATE
) or e_KeyPressed(JOY3_ACTIVATE
) then
1460 if not slFetched
then
1462 slWaitStr
:= _lc
[I_NET_SLIST_WAIT
];
1467 if g_Net_Slist_Fetch(SL
) then
1470 slWaitStr
:= _lc
[I_NET_SLIST_NOSERVERS
];
1474 slWaitStr
:= _lc
[I_NET_SLIST_ERROR
];
1477 g_Serverlist_GenerateTable(SL
, ST
);
1483 if SL
= nil then Exit
;
1485 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
1486 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
1488 if not slReturnPressed
then
1490 Srv
:= GetServerFromTable(slSelection
, SL
, ST
);
1491 if Srv
.Password
then
1494 PromptPort
:= Srv
.Port
;
1495 gState
:= STATE_MENU
;
1496 g_GUI_ShowWindow('ClientPasswordMenu');
1499 slReturnPressed
:= True;
1503 g_Game_StartClient(Srv
.IP
, Srv
.Port
, '');
1506 slReturnPressed
:= True;
1511 slReturnPressed
:= False;
1513 if e_KeyPressed(IK_DOWN
) or e_KeyPressed(IK_KPDOWN
) or e_KeyPressed(VK_DOWN
) or
1514 e_KeyPressed(JOY0_DOWN
) or e_KeyPressed(JOY1_DOWN
) or e_KeyPressed(JOY2_DOWN
) or e_KeyPressed(JOY3_DOWN
) then
1516 if not slDirPressed
then
1519 if slSelection
> High(ST
) then slSelection
:= 0;
1520 slDirPressed
:= True;
1524 if e_KeyPressed(IK_UP
) or e_KeyPressed(IK_KPUP
) or e_KeyPressed(VK_UP
) or
1525 e_KeyPressed(JOY0_UP
) or e_KeyPressed(JOY1_UP
) or e_KeyPressed(JOY2_UP
) or e_KeyPressed(JOY3_UP
) then
1527 if not slDirPressed
then
1529 if slSelection
= 0 then slSelection
:= Length(ST
);
1532 slDirPressed
:= True;
1536 if e_KeyPressed(IK_RIGHT
) or e_KeyPressed(IK_KPRIGHT
) or e_KeyPressed(VK_RIGHT
) or
1537 e_KeyPressed(JOY0_RIGHT
) or e_KeyPressed(JOY1_RIGHT
) or e_KeyPressed(JOY2_RIGHT
) or e_KeyPressed(JOY3_RIGHT
) then
1539 if not slDirPressed
then
1541 Inc(ST
[slSelection
].Current
);
1542 if ST
[slSelection
].Current
> High(ST
[slSelection
].Indices
) then ST
[slSelection
].Current
:= 0;
1543 slDirPressed
:= True;
1547 if e_KeyPressed(IK_LEFT
) or e_KeyPressed(IK_KPLEFT
) or e_KeyPressed(VK_LEFT
) or
1548 e_KeyPressed(JOY0_LEFT
) or e_KeyPressed(JOY1_LEFT
) or e_KeyPressed(JOY2_LEFT
) or e_KeyPressed(JOY3_LEFT
) then
1550 if not slDirPressed
then
1552 if ST
[slSelection
].Current
= 0 then ST
[slSelection
].Current
:= Length(ST
[slSelection
].Indices
);
1553 Dec(ST
[slSelection
].Current
);
1555 slDirPressed
:= True;
1559 if (not e_KeyPressed(IK_DOWN
)) and
1560 (not e_KeyPressed(IK_UP
)) and
1561 (not e_KeyPressed(IK_RIGHT
)) and
1562 (not e_KeyPressed(IK_LEFT
)) and
1563 (not e_KeyPressed(IK_KPDOWN
)) and
1564 (not e_KeyPressed(IK_KPUP
)) and
1565 (not e_KeyPressed(IK_KPRIGHT
)) and
1566 (not e_KeyPressed(IK_KPLEFT
)) and
1567 (not e_KeyPressed(VK_DOWN
)) and
1568 (not e_KeyPressed(VK_UP
)) and
1569 (not e_KeyPressed(VK_RIGHT
)) and
1570 (not e_KeyPressed(VK_LEFT
)) and
1571 (not e_KeyPressed(JOY0_UP
)) and (not e_KeyPressed(JOY1_UP
)) and (not e_KeyPressed(JOY2_UP
)) and (not e_KeyPressed(JOY3_UP
)) and
1572 (not e_KeyPressed(JOY0_DOWN
)) and (not e_KeyPressed(JOY1_DOWN
)) and (not e_KeyPressed(JOY2_DOWN
)) and (not e_KeyPressed(JOY3_DOWN
)) and
1573 (not e_KeyPressed(JOY0_LEFT
)) and (not e_KeyPressed(JOY1_LEFT
)) and (not e_KeyPressed(JOY2_LEFT
)) and (not e_KeyPressed(JOY3_LEFT
)) and
1574 (not e_KeyPressed(JOY0_RIGHT
)) and (not e_KeyPressed(JOY1_RIGHT
)) and (not e_KeyPressed(JOY2_RIGHT
)) and (not e_KeyPressed(JOY3_RIGHT
))
1576 slDirPressed
:= False;