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 while the server is running
134 procedure g_Net_Slist_ServerUpdate ();
135 // called when the server is started
136 procedure g_Net_Slist_ServerStarted ();
137 // called when the server is stopped
138 procedure g_Net_Slist_ServerClosed ();
140 // called when new netword player comes
141 procedure g_Net_Slist_ServerPlayerComes ();
142 // called when new netword player comes
143 procedure g_Net_Slist_ServerPlayerLeaves ();
145 procedure g_Net_Slist_ServerMapStarted ();
146 // this server renamed (or password mode changed, or other params changed)
147 procedure g_Net_Slist_ServerRenamed ();
149 procedure g_Net_Slist_Pulse (timeout
: Integer=0);
151 procedure g_Serverlist_GenerateTable (SL
: TNetServerList
; var ST
: TNetServerTable
);
152 procedure g_Serverlist_Draw (var SL
: TNetServerList
; var ST
: TNetServerTable
);
153 procedure g_Serverlist_Control (var SL
: TNetServerList
; var ST
: TNetServerTable
);
155 function GetTimerMS (): Int64;
161 e_input
, e_graphics
, e_log
, g_window
, g_net
, g_console
,
162 g_map
, g_game
, g_sound
, g_gui
, g_menu
, g_options
, g_language
, g_basic
,
163 wadreader
, g_system
, utils
;
165 // if g_Game_IsServer and g_Game_IsNet and NetUseMaster then
167 // make this server private
168 procedure g_Net_Slist_Private ();
172 // make this server public
173 procedure g_Net_Slist_Public ();
177 // called while the server is running
178 procedure g_Net_Slist_ServerUpdate ();
182 // called when the server is started
183 procedure g_Net_Slist_ServerStarted ();
187 // called when the server is stopped
188 procedure g_Net_Slist_ServerClosed ();
192 // called when new netword player comes
193 procedure g_Net_Slist_ServerPlayerComes ();
197 // called when new netword player comes
198 procedure g_Net_Slist_ServerPlayerLeaves ();
203 procedure g_Net_Slist_ServerMapStarted ();
207 // this server renamed (or password mode changed, or other params changed)
208 procedure g_Net_Slist_ServerRenamed ();
213 // ////////////////////////////////////////////////////////////////////////// //
215 NetMHost
: pENetHost
= nil;
216 NetMEvent
: ENetEvent
;
217 mlist
: array of TMasterHost
= nil;
219 slSelection
: Byte = 0;
220 slFetched
: Boolean = False;
221 slDirPressed
: Boolean = False;
222 slReadUrgent
: Boolean = False;
225 //==========================================================================
229 //==========================================================================
230 function GetTimerMS (): Int64;
232 Result
:= sys_GetTicks() {div 1000};
236 //==========================================================================
240 //==========================================================================
241 function findByPeer (peer
: pENetPeer
): Integer;
245 for f
:= 0 to High(mlist
) do if (mlist
[f
].peer
= peer
) then begin result
:= f
; exit
; end;
250 //==========================================================================
252 // TMasterHost.Create
254 //==========================================================================
255 constructor TMasterHost
.Create (hostandport
: AnsiString);
258 NetHostConnected
:= false;
259 NetHostConReqTime
:= 0;
260 NetUpdatePending
:= false;
264 SetLength(srvAnswer
, 0);
268 slReadUrgent
:= true;
269 netmsg
.Alloc(NET_BUFSIZE
);
270 setAddress(hostandport
);
274 //==========================================================================
278 //==========================================================================
279 procedure TMasterHost
.clear ();
281 updateSent
:= false; // do not send 'remove'
286 SetLength(srvAnswer
, 0);
290 slReadUrgent
:= true;
294 //==========================================================================
296 // TMasterHost.isSameAddress
298 //==========================================================================
299 function TMasterHost
.isSameAddress (hostandport
: AnsiString): Boolean;
305 if not isValid() then exit
;
306 hostandport
:= Trim(hostandport
);
307 if (length(hostandport
) = 0) then exit
;
309 cp
:= Pos(':', hostandport
);
312 hn
:= Copy(hostandport
, 1, cp
-1);
313 Delete(hostandport
, 1, cp
);
314 if (length(hostandport
) > 0) then
317 pp
:= StrToInt(hostandport
);
327 result
:= strEquCI1251(hn
, hostName
) and (hostPort
= pp
);
331 //==========================================================================
333 // TMasterHost.setAddress
335 //==========================================================================
336 function TMasterHost
.setAddress (hostandport
: AnsiString): Boolean;
341 SetLength(srvAnswer
, 0);
345 slReadUrgent
:= true;
346 updateSent
:= false; // do not send 'remove'
351 if (not g_Net_IsNetworkAvailable()) then exit
;
353 hostandport
:= Trim(hostandport
);
354 if (length(hostandport
) > 0) then
356 hostName
:= hostandport
;
357 cp
:= Pos(':', hostandport
);
360 hostName
:= Copy(hostandport
, 1, cp
-1);
361 Delete(hostandport
, 1, cp
);
362 if (length(hostandport
) > 0) then
365 pp
:= StrToInt(hostandport
);
369 if (pp
> 0) and (pp
< 65536) then hostPort
:= pp
else hostPort
:= 0;
374 if not isValid() then exit
;
376 if (enet_address_set_host(@enetAddr
, PChar(Addr(hostName
[1]))) <> 0) then
382 enetAddr
.Port
:= hostPort
;
385 //writeln('*********************: ', hostandport, ' [', hostName, ':', hostPort, '] ', result);
389 //==========================================================================
391 // TMasterHost.isValid
393 //==========================================================================
394 function TMasterHost
.isValid (): Boolean;
396 result
:= (length(hostName
) > 0) and (hostPort
> 0);
400 //==========================================================================
402 // TMasterHost.isAlive
406 //==========================================================================
407 function TMasterHost
.isAlive (): Boolean;
409 result
:= (NetMHost
<> nil) and (peer
<> nil);
413 //==========================================================================
415 // TMasterHost.isConnecting
417 // is connection in progress?
419 //==========================================================================
420 function TMasterHost
.isConnecting (): Boolean;
422 result
:= isAlive() and (not NetHostConnected
) and (NetHostConReqTime
<> -1);
426 //==========================================================================
428 // TMasterHost.isConnected
430 //==========================================================================
431 function TMasterHost
.isConnected (): Boolean;
433 result
:= isAlive() and (NetHostConnected
) and (NetHostConReqTime
<> -1);
437 //==========================================================================
439 // TMasterHost.connectedEvent
441 //==========================================================================
442 procedure TMasterHost
.connectedEvent ();
444 if not isAlive() then exit
;
445 if NetHostConnected
then exit
;
446 NetHostConnected
:= true;
447 e_LogWritefln('connected to master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
451 //==========================================================================
453 // TMasterHost.disconnectedEvent
455 //==========================================================================
456 procedure TMasterHost
.disconnectedEvent ();
458 if not isAlive() then exit
;
459 e_LogWritefln('disconnected from master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
461 //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
465 //==========================================================================
467 // TMasterHost.receivedEvent
469 // `pkt` is never `nil`
471 //==========================================================================
472 procedure TMasterHost
.receivedEvent (pkt
: pENetPacket
);
480 e_LogWritefln('received packed from master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
481 if not msg
.Init(pkt
^.data
, pkt
^.dataLength
, True) then exit
;
483 MID
:= msg
.ReadByte();
484 if (MID
<> NET_MMSG_GET
) then exit
;
485 e_LogWritefln('received list packet from master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
486 SetLength(srvAnswer
, 0);
487 if (srvAnswered
> 0) then Inc(srvAnswered
);
490 slReadUrgent
:= true;
492 Cnt
:= msg
.ReadByte();
493 g_Console_Add(_lc
[I_NET_MSG
]+Format(_lc
[I_NET_SLIST_RETRIEVED
], [Cnt
]), True);
496 SetLength(srvAnswer
, Cnt
);
497 for f
:= 0 to Cnt
-1 do
499 srvAnswer
[f
].Number
:= f
;
500 srvAnswer
[f
].IP
:= msg
.ReadString();
501 srvAnswer
[f
].Port
:= msg
.ReadWord();
502 srvAnswer
[f
].Name
:= msg
.ReadString();
503 srvAnswer
[f
].Map
:= msg
.ReadString();
504 srvAnswer
[f
].GameMode
:= msg
.ReadByte();
505 srvAnswer
[f
].Players
:= msg
.ReadByte();
506 srvAnswer
[f
].MaxPlayers
:= msg
.ReadByte();
507 srvAnswer
[f
].Protocol
:= msg
.ReadByte();
508 srvAnswer
[f
].Password
:= msg
.ReadByte() = 1;
509 enet_address_set_host(Addr(srvAnswer
[f
].PingAddr
), PChar(Addr(srvAnswer
[f
].IP
[1])));
510 srvAnswer
[f
].Ping
:= -1;
511 srvAnswer
[f
].PingAddr
.port
:= NET_PING_PORT
;
515 if (msg
.ReadCount
< msg
.CurSize
) then
517 // new master, supports version reports
518 s
:= msg
.ReadString();
519 if (s
<> {MyVer}GAME_VERSION
) then
522 g_Console_Add('!!! UpdVer = `'+s
+'`');
524 // even newer master, supports extra info
525 if (msg
.ReadCount
< msg
.CurSize
) then
527 slMOTD
:= b_Text_Format(msg
.ReadString());
528 s
:= b_Text_Format(msg
.ReadString());
529 // check if the message has updated and the user has to read it again
530 if (slUrgent
<> s
) then slReadUrgent
:= false;
537 //==========================================================================
541 // this performs various scheduled tasks, if necessary
543 //==========================================================================
544 procedure TMasterHost
.pulse ();
548 if not isAlive() then exit
;
549 if (NetHostConReqTime
= -1) then exit
; // waiting for shutdown (disconnect in progress)
550 // process pending connection timeout
551 if (not NetHostConnected
) then
554 if (ct
< NetHostConReqTime
) or (ct
-NetHostConReqTime
>= 3000) then
556 e_LogWritefln('failed to connect to master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
557 // do not spam with error messages, it looks like the master is down
558 //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
559 enet_peer_disconnect(peer
, 0);
560 // main pulse will take care of the rest
567 //==========================================================================
569 // TMasterHost.disconnect
571 //==========================================================================
572 procedure TMasterHost
.disconnect (forced
: Boolean);
574 if not isAlive() then exit
;
575 //if (NetMode = NET_SERVER) and isConnected() and updateSent then remove();
579 enet_peer_reset(peer
);
581 NetHostConReqTime
:= 0;
585 enet_peer_disconnect_later(peer
, 0);
586 // main pulse will take care of the rest
587 NetHostConReqTime
:= -1;
590 NetHostConnected
:= false;
591 NetUpdatePending
:= false;
593 //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
597 //==========================================================================
599 // TMasterHost.connect
601 //==========================================================================
602 function TMasterHost
.connect (): Boolean;
605 if not isValid() then exit
;
606 if (NetHostConReqTime
= -1) then
612 if isAlive() then begin result
:= true; exit
; end;
615 SetLength(srvAnswer
, 0);
617 NetHostConnected
:= false;
618 NetHostConReqTime
:= 0;
619 NetUpdatePending
:= false;
622 peer
:= enet_host_connect(NetMHost
, @enetAddr
, NET_MCHANS
, 0);
625 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], true);
629 NetHostConReqTime
:= GetTimerMS();
630 e_LogWritefln('connecting to master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
634 //==========================================================================
636 // TMasterHost.writeInfo
638 //==========================================================================
639 class procedure TMasterHost
.writeInfo (var msg
: TMsg
);
641 wad
, map
: AnsiString;
643 wad
:= g_ExtractWadNameNoPath(gMapInfo
.Map
);
644 map
:= g_ExtractFileName(gMapInfo
.Map
);
646 msg
.Write(NetServerName
);
648 msg
.Write(wad
+':/'+map
);
649 msg
.Write(gGameSettings
.GameMode
);
651 msg
.Write(Byte(NetClientCount
));
653 msg
.Write(NetMaxClients
);
655 msg
.Write(Byte(NET_PROTOCOL_VER
));
656 msg
.Write(Byte(NetPassword
<> ''));
660 //==========================================================================
662 // TMasterHost.update
664 //==========================================================================
665 procedure TMasterHost
.update ();
669 if not isAlive() then exit
;
670 if not isConnected() then
672 NetUpdatePending
:= isConnecting();
678 netmsg
.Write(Byte(NET_MMSG_UPD
));
679 netmsg
.Write(NetAddr
.port
);
683 pkt
:= enet_packet_create(netmsg
.Data
, netmsg
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
684 if assigned(pkt
) then
686 if (enet_peer_send(peer
, NET_MCHAN_UPD
, pkt
) = 0) then NetUpdatePending
:= false;
694 //==========================================================================
696 // TMasterHost.remove
698 //==========================================================================
699 procedure TMasterHost
.remove ();
703 NetUpdatePending
:= false;
704 if not isAlive() then exit
;
705 if not isConnected() then exit
;
709 netmsg
.Write(Byte(NET_MMSG_DEL
));
710 netmsg
.Write(NetAddr
.port
);
712 pkt
:= enet_packet_create(netmsg
.Data
, netmsg
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
713 if assigned(pkt
) then
715 enet_peer_send(peer
, NET_MCHAN_MAIN
, pkt
);
723 //**************************************************************************
727 //**************************************************************************
729 procedure g_Net_Slist_Set (IP
: AnsiString; Port
: Word);
734 if (not g_Net_IsNetworkAvailable()) then exit
;
736 if (length(IP
) = 0) or (Port
= 0) then exit
;
737 sa
:= IP
+':'+IntToStr(Port
);
738 for f
:= 0 to High(mlist
) do if (mlist
[f
].isSameAddress(sa
)) then exit
;
739 SetLength(mlist
, length(mlist
)+1);
740 mlist
[High(mlist
)].Create(sa
);
741 mlist
[High(mlist
)].setAddress(sa
);
742 e_LogWritefln('Masterserver address set to [%s:%u]', [IP
, Port
], TMsgType
.Notify
);
746 //**************************************************************************
750 //**************************************************************************
751 procedure g_Net_Slist_Pulse (timeout
: Integer=0);
757 if (not g_Net_IsNetworkAvailable()) then exit
;
759 if (length(mlist
) = 0) then
761 if (NetMHost
<> nil) then
763 enet_host_destroy(NetMHost
);
769 if (NetMHost
= nil) then
771 NetMHost
:= enet_host_create(nil, 1, NET_MCHANS
, 0, 0);
772 if (NetMHost
= nil) then
774 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], True);
775 for f
:= 0 to High(mlist
) do mlist
[f
].clear();
781 for f
:= 0 to High(mlist
) do mlist
[f
].pulse();
785 sres
:= enet_host_service(NetMHost
, @NetMEvent
, timeout
);
788 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], True);
789 for f
:= 0 to High(mlist
) do mlist
[f
].clear();
791 enet_host_destroy(NetMHost
);
796 if (sres
= 0) then break
;
797 idx
:= findByPeer(NetMEvent
.peer
);
800 e_LogWriteln('network event from unknown master host. ignored.', TMsgType
.Warning
);
801 if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then enet_packet_destroy(NetMEvent
.packet
);
805 if (NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
807 mlist
[idx
].connectedEvent();
809 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
811 mlist
[idx
].disconnectedEvent();
813 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
815 mlist
[idx
].receivedEvent(NetMEvent
.packet
);
816 enet_packet_destroy(NetMEvent
.packet
);
822 //**************************************************************************
824 // gui and server list
826 //**************************************************************************
828 //==========================================================================
832 //==========================================================================
833 procedure PingServer (var S
: TNetServer
; Sock
: ENetSocket
);
836 Ping
: array [0..9] of Byte;
839 ClTime
:= GetTimerMS();
841 Buf
.data
:= Addr(Ping
[0]);
842 Buf
.dataLength
:= 2+8;
846 Int64(Addr(Ping
[2])^) := ClTime
;
848 enet_socket_send(Sock
, Addr(S
.PingAddr
), @Buf
, 1);
852 //==========================================================================
856 //==========================================================================
857 procedure PingBcast (Sock
: ENetSocket
);
861 S
.IP
:= '255.255.255.255';
862 S
.Port
:= NET_PING_PORT
;
863 enet_address_set_host(Addr(S
.PingAddr
), PChar(Addr(S
.IP
[1])));
865 S
.PingAddr
.port
:= S
.Port
;
870 //==========================================================================
874 //==========================================================================
875 function g_Net_Slist_Fetch (var SL
: TNetServerList
): Boolean;
888 procedure DisconnectAll ();
894 //stt := GetTimerMS();
895 while (length(mlist
) > 0) do
898 for f
:= 0 to High(mlist
) do
900 if (mlist
[f
].isAlive()) then
903 mlist
[f
].disconnect(false);
906 if not hasAlive
then break
;
909 g_Net_Slist_Pulse(100);
911 if (ct < stt) or (ct-stt > 800) then break;
916 procedure ProcessLocal ();
919 SetLength(SL
, I
+ 1);
922 IP
:= DecodeIPV4(SvAddr
.host
);
923 Port
:= InMsg
.ReadWord();
924 Ping
:= InMsg
.ReadInt64();
925 Ping
:= GetTimerMS() - Ping
;
926 Name
:= InMsg
.ReadString();
927 Map
:= InMsg
.ReadString();
928 GameMode
:= InMsg
.ReadByte();
929 Players
:= InMsg
.ReadByte();
930 MaxPlayers
:= InMsg
.ReadByte();
931 Protocol
:= InMsg
.ReadByte();
932 Password
:= InMsg
.ReadByte() = 1;
933 LocalPl
:= InMsg
.ReadByte();
934 Bots
:= InMsg
.ReadWord();
938 procedure CheckLocalServers ();
942 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
943 if Sock
= ENET_SOCKET_NULL
then Exit
;
944 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
945 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
950 InMsg
.Alloc(NET_BUFSIZE
);
951 Buf
.data
:= InMsg
.Data
;
952 Buf
.dataLength
:= InMsg
.MaxSize
;
953 while GetTimerMS() - T
<= 500 do
957 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
958 if RX
<= 0 then continue
;
961 InMsg
.BeginReading();
963 if InMsg
.ReadChar() <> 'D' then continue
;
964 if InMsg
.ReadChar() <> 'F' then continue
;
970 enet_socket_destroy(Sock
);
972 if Length(SL
) = 0 then SL
:= nil;
976 f
, c
, n
, pos
: Integer;
978 hasUnanswered
: Boolean;
984 if (not g_Net_IsNetworkAvailable()) then
990 g_Net_Slist_Pulse(); // this will create mhost
993 NetOut
.Write(Byte(NET_MMSG_GET
));
995 // TODO: what should we identify the build with?
996 MyVer
:= GAME_VERSION
;
1000 e_WriteLog('Fetching serverlist...', TMsgType
.Notify
);
1001 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_FETCH
]);
1003 // wait until all servers connected and answered
1004 stt
:= GetTimerMS();
1007 g_Net_Slist_Pulse(300);
1009 hasUnanswered
:= false;
1010 for f
:= 0 to High(mlist
) do
1013 e_LogWritefln(' master #%d: [%s:%u] valid=%d; alive=%d; connected=%d; connecting=%d',
1014 [f, mlist[f].hostName, mlist[f].hostPort, Integer(mlist[f].isValid()), Integer(mlist[f].isAlive()),
1015 Integer(mlist[f].isConnected()), Integer(mlist[f].isConnecting())], TMsgType.Notify);
1017 if (not mlist
[f
].isValid()) then continue
;
1018 if (not mlist
[f
].isAlive()) then
1021 if (mlist
[f
].isAlive()) then
1023 hasUnanswered
:= true;
1024 stt
:= GetTimerMS();
1027 else if (mlist
[f
].isConnected()) then
1029 if (mlist
[f
].srvAnswered
= 0) then
1031 pkt
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
1032 if assigned(pkt
) then
1034 if (enet_peer_send(mlist
[f
].peer
, NET_MCHAN_MAIN
, pkt
) = 0) then
1036 hasUnanswered
:= true;
1037 mlist
[f
].srvAnswered
:= 1;
1038 stt
:= GetTimerMS();
1042 else if (mlist
[f
].srvAnswered
= 1) then
1044 hasUnanswered
:= true;
1046 else if (mlist
[f
].srvAnswered
> 1) then
1051 else if (mlist
[f
].isConnecting()) then
1053 hasUnanswered
:= true;
1056 if (not hasUnanswered
) then break
;
1057 // check for timeout
1059 if (ct
< stt
) or (ct
-stt
> 4000) then break
;
1062 if (aliveCount
= 0) then
1065 CheckLocalServers();
1072 slReadUrgent := true;
1076 for f
:= 0 to High(mlist
) do
1078 if (mlist
[f
].srvAnswered
< 2) then continue
;
1079 for n
:= 0 to High(mlist
[f
].srvAnswer
) do
1082 for c
:= 0 to High(SL
) do
1084 if (SL
[c
].IP
= mlist
[f
].srvAnswer
[n
].IP
) and (SL
[c
].Port
= mlist
[f
].srvAnswer
[n
].Port
) then
1093 SetLength(SL
, pos
+1);
1094 SL
[pos
] := mlist
[f
].srvAnswer
[n
];
1095 SL
[pos
].Number
:= pos
;
1098 if (not mlist
[f
].slReadUrgent
) and (mlist
[f
].slUrgent
<> '') then
1100 if (mlist
[f
].slUrgent
<> slUrgent
) then
1102 slUrgent
:= mlist
[f
].slUrgent
;
1103 slReadUrgent
:= false;
1106 if (slMOTD
<> '') and (mlist
[f
].slMOTD
<> '') then
1108 slMOTD
:= mlist
[f
].slMOTD
;
1114 if (length(SL
) = 0) then
1116 CheckLocalServers();
1120 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
1121 if Sock
= ENET_SOCKET_NULL
then Exit
;
1122 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
1124 for I
:= Low(SL
) to High(SL
) do PingServer(SL
[I
], Sock
);
1126 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
1131 InMsg
.Alloc(NET_BUFSIZE
);
1132 Buf
.data
:= InMsg
.Data
;
1133 Buf
.dataLength
:= InMsg
.MaxSize
;
1135 while GetTimerMS() - T
<= 500 do
1139 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
1140 if RX
<= 0 then continue
;
1141 InMsg
.CurSize
:= RX
;
1143 InMsg
.BeginReading();
1145 if InMsg
.ReadChar() <> 'D' then continue
;
1146 if InMsg
.ReadChar() <> 'F' then continue
;
1149 for I
:= Low(SL
) to High(SL
) do
1150 if (SL
[I
].PingAddr
.host
= SvAddr
.host
) and
1151 (SL
[I
].PingAddr
.port
= SvAddr
.port
) then
1155 Port
:= InMsg
.ReadWord();
1156 Ping
:= InMsg
.ReadInt64();
1157 Ping
:= GetTimerMS() - Ping
;
1158 Name
:= InMsg
.ReadString();
1159 Map
:= InMsg
.ReadString();
1160 GameMode
:= InMsg
.ReadByte();
1161 Players
:= InMsg
.ReadByte();
1162 MaxPlayers
:= InMsg
.ReadByte();
1163 Protocol
:= InMsg
.ReadByte();
1164 Password
:= InMsg
.ReadByte() = 1;
1165 LocalPl
:= InMsg
.ReadByte();
1166 Bots
:= InMsg
.ReadWord();
1177 enet_socket_destroy(Sock
);
1184 //==========================================================================
1186 // GetServerFromTable
1188 //==========================================================================
1189 function GetServerFromTable (Index
: Integer; SL
: TNetServerList
; ST
: TNetServerTable
): TNetServer
;
1192 Result
.Protocol
:= 0;
1197 Result
.Players
:= 0;
1198 Result
.MaxPlayers
:= 0;
1199 Result
.LocalPl
:= 0;
1202 Result
.GameMode
:= 0;
1203 Result
.Password
:= false;
1204 FillChar(Result
.PingAddr
, SizeOf(ENetAddress
), 0);
1207 if (Index
< 0) or (Index
>= Length(ST
)) then
1209 Result
:= SL
[ST
[Index
].Indices
[ST
[Index
].Current
]];
1213 //==========================================================================
1215 // g_Serverlist_Draw
1217 //==========================================================================
1218 procedure g_Serverlist_Draw (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1221 sy
, i
, y
, mw
, mx
, l
, motdh
: Integer;
1231 e_CharFont_GetSize(gMenuFont
, _lc
[I_NET_SLIST
], ww
, hh
);
1232 e_CharFont_Print(gMenuFont
, (gScreenWidth
div 2) - (ww
div 2), 16, _lc
[I_NET_SLIST
]);
1234 e_TextureFontGetSize(gStdFont
, cw
, ch
);
1236 ip
:= _lc
[I_NET_SLIST_HELP
];
1237 mw
:= (Length(ip
) * cw
) div 2;
1239 motdh
:= gScreenHeight
- 49 - ch
* b_Text_LineCount(slMOTD
);
1241 e_DrawFillQuad(16, 64, gScreenWidth
-16, motdh
, 64, 64, 64, 110);
1242 e_DrawQuad(16, 64, gScreenWidth
-16, motdh
, 255, 127, 0);
1244 e_TextureFontPrintEx(gScreenWidth
div 2 - mw
, gScreenHeight
-24, ip
, gStdFont
, 225, 225, 225, 1);
1247 if slMOTD
<> '' then
1249 e_DrawFillQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 110);
1250 e_DrawQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 255, 127, 0);
1251 e_TextureFontPrintFmt(20, motdh
+ 3, slMOTD
, gStdFont
, False, True);
1255 if not slReadUrgent
and (slUrgent
<> '') then
1257 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
1258 e_DrawFillQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
1259 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 64, 64, 64, 128);
1260 e_DrawQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
1261 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 255, 127, 0);
1262 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 40,
1263 gScreenWidth
div 2 + 256, gScreenHeight
div 2 - 40, 255, 127, 0);
1264 l
:= Length(_lc
[I_NET_SLIST_URGENT
]) div 2;
1265 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - 58,
1266 _lc
[I_NET_SLIST_URGENT
], gStdFont
);
1267 l
:= Length(slUrgent
) div 2;
1268 e_TextureFontPrintFmt(gScreenWidth
div 2 - 253, gScreenHeight
div 2 - 38,
1269 slUrgent
, gStdFont
, False, True);
1270 l
:= Length(_lc
[I_NET_SLIST_URGENT_CONT
]) div 2;
1271 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 + 41,
1272 _lc
[I_NET_SLIST_URGENT_CONT
], gStdFont
);
1273 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 + 40,
1274 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 40, 255, 127, 0);
1280 l
:= Length(slWaitStr
) div 2;
1281 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
1282 e_DrawQuad(gScreenWidth
div 2 - 192, gScreenHeight
div 2 - 10,
1283 gScreenWidth
div 2 + 192, gScreenHeight
div 2 + 11, 255, 127, 0);
1284 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - ch
div 2,
1285 slWaitStr
, gStdFont
);
1290 if (slSelection
< Length(ST
)) then
1293 sy
:= y
+ 42 * I
- 4;
1294 Srv
:= GetServerFromTable(I
, SL
, ST
);
1295 ip
:= _lc
[I_NET_ADDRESS
] + ' ' + Srv
.IP
+ ':' + IntToStr(Srv
.Port
);
1296 if Srv
.Password
then
1297 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_YES
]
1299 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_NO
];
1301 if Length(ST
) > 0 then
1304 mw
:= (gScreenWidth
- 188);
1307 e_DrawFillQuad(16 + 1, sy
, gScreenWidth
- 16 - 1, sy
+ 40, 64, 64, 64, 0);
1308 e_DrawLine(1, 16 + 1, sy
, gScreenWidth
- 16 - 1, sy
, 205, 205, 205);
1309 e_DrawLine(1, 16 + 1, sy
+ 41, gScreenWidth
- 16 - 1, sy
+ 41, 255, 255, 255);
1311 e_DrawLine(1, 16, 85, gScreenWidth
- 16, 85, 255, 127, 0);
1312 e_DrawLine(1, 16, motdh
-20, gScreenWidth
-16, motdh
-20, 255, 127, 0);
1314 e_DrawLine(1, mx
- 70, 64, mx
- 70, motdh
, 255, 127, 0);
1315 e_DrawLine(1, mx
, 64, mx
, motdh
-20, 255, 127, 0);
1316 e_DrawLine(1, mx
+ 52, 64, mx
+ 52, motdh
-20, 255, 127, 0);
1317 e_DrawLine(1, mx
+ 104, 64, mx
+ 104, motdh
-20, 255, 127, 0);
1319 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont
, 255, 127, 0, 1);
1320 e_TextureFontPrintEx(mx
- 68, 68, 'PING', gStdFont
, 255, 127, 0, 1);
1321 e_TextureFontPrintEx(mx
+ 2, 68, 'MODE', gStdFont
, 255, 127, 0, 1);
1322 e_TextureFontPrintEx(mx
+ 54, 68, 'PLRS', gStdFont
, 255, 127, 0, 1);
1323 e_TextureFontPrintEx(mx
+ 106, 68, 'VER', gStdFont
, 255, 127, 0, 1);
1326 for I
:= 0 to High(ST
) do
1328 Srv
:= GetServerFromTable(I
, SL
, ST
);
1330 e_TextureFontPrintEx(18, y
, Srv
.Name
, gStdFont
, 255, 255, 255, 1);
1331 e_TextureFontPrintEx(18, y
+ 16, Srv
.Map
, gStdFont
, 210, 210, 210, 1);
1333 // Ping and similar count
1334 if (Srv
.Ping
< 0) or (Srv
.Ping
> 999) then
1335 e_TextureFontPrintEx(mx
- 68, y
, _lc
[I_NET_SLIST_NO_ACCESS
], gStdFont
, 255, 0, 0, 1)
1337 if Srv
.Ping
= 0 then
1338 e_TextureFontPrintEx(mx
- 68, y
, '<1' + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1)
1340 e_TextureFontPrintEx(mx
- 68, y
, IntToStr(Srv
.Ping
) + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1);
1342 if Length(ST
[I
].Indices
) > 1 then
1343 e_TextureFontPrintEx(mx
- 68, y
+ 16, '< ' + IntToStr(Length(ST
[I
].Indices
)) + ' >', gStdFont
, 210, 210, 210, 1);
1346 e_TextureFontPrintEx(mx
+ 2, y
, g_Game_ModeToText(Srv
.GameMode
), gStdFont
, 255, 255, 255, 1);
1349 e_TextureFontPrintEx(mx
+ 54, y
, IntToStr(Srv
.Players
) + '/' + IntToStr(Srv
.MaxPlayers
), gStdFont
, 255, 255, 255, 1);
1350 e_TextureFontPrintEx(mx
+ 54, y
+ 16, IntToStr(Srv
.LocalPl
) + '+' + IntToStr(Srv
.Bots
), gStdFont
, 210, 210, 210, 1);
1353 e_TextureFontPrintEx(mx
+ 106, y
, IntToStr(Srv
.Protocol
), gStdFont
, 255, 255, 255, 1);
1358 e_TextureFontPrintEx(20, motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
1359 ip
:= IntToStr(Length(ST
)) + _lc
[I_NET_SLIST_SERVERS
];
1360 e_TextureFontPrintEx(gScreenWidth
- 48 - (Length(ip
) + 1)*cw
,
1361 motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
1365 //==========================================================================
1367 // g_Serverlist_GenerateTable
1369 //==========================================================================
1370 procedure g_Serverlist_GenerateTable (SL
: TNetServerList
; var ST
: TNetServerTable
);
1374 function FindServerInTable(Name
: AnsiString): Integer;
1381 for i
:= Low(ST
) to High(ST
) do
1383 if Length(ST
[i
].Indices
) = 0 then
1385 if SL
[ST
[i
].Indices
[0]].Name
= Name
then
1392 function ComparePing(i1
, i2
: Integer): Boolean;
1398 if (p1
< 0) then p1
:= 999;
1399 if (p2
< 0) then p2
:= 999;
1402 procedure SortIndices(var ind
: Array of Integer);
1407 for I
:= High(ind
) downto Low(ind
) do
1408 for J
:= Low(ind
) to High(ind
) - 1 do
1409 if ComparePing(ind
[j
], ind
[j
+1]) then
1416 procedure SortRows();
1421 for I
:= High(ST
) downto Low(ST
) do
1422 for J
:= Low(ST
) to High(ST
) - 1 do
1423 if ComparePing(ST
[j
].Indices
[0], ST
[j
+1].Indices
[0]) then
1434 for i
:= Low(SL
) to High(SL
) do
1436 j
:= FindServerInTable(SL
[i
].Name
);
1440 SetLength(ST
, j
+ 1);
1442 SetLength(ST
[j
].Indices
, 1);
1443 ST
[j
].Indices
[0] := i
;
1447 SetLength(ST
[j
].Indices
, Length(ST
[j
].Indices
) + 1);
1448 ST
[j
].Indices
[High(ST
[j
].Indices
)] := i
;
1452 for i
:= Low(ST
) to High(ST
) do
1453 SortIndices(ST
[i
].Indices
);
1459 //==========================================================================
1461 // g_Serverlist_Control
1463 //==========================================================================
1464 procedure g_Serverlist_Control (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1469 g_Net_Slist_Pulse();
1471 if gConsoleShow
or gChatShow
then
1474 qm
:= sys_HandleInput(); // this updates kbd
1476 if qm
or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) or
1477 e_KeyPressed(JOY0_JUMP
) or e_KeyPressed(JOY1_JUMP
) or
1478 e_KeyPressed(JOY2_JUMP
) or e_KeyPressed(JOY3_JUMP
) then
1482 gState
:= STATE_MENU
;
1483 g_GUI_ShowWindow('MainMenu');
1484 g_GUI_ShowWindow('NetGameMenu');
1485 g_GUI_ShowWindow('NetClientMenu');
1486 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
1490 // if there's a message on the screen,
1491 if not slReadUrgent
and (slUrgent
<> '') then
1493 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
1494 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
1495 slReadUrgent
:= True;
1499 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(VK_JUMP
) or
1500 e_KeyPressed(JOY0_ACTIVATE
) or e_KeyPressed(JOY1_ACTIVATE
) or e_KeyPressed(JOY2_ACTIVATE
) or e_KeyPressed(JOY3_ACTIVATE
) then
1502 if not slFetched
then
1504 slWaitStr
:= _lc
[I_NET_SLIST_WAIT
];
1509 if g_Net_Slist_Fetch(SL
) then
1512 slWaitStr
:= _lc
[I_NET_SLIST_NOSERVERS
];
1516 slWaitStr
:= _lc
[I_NET_SLIST_ERROR
];
1519 g_Serverlist_GenerateTable(SL
, ST
);
1525 if SL
= nil then Exit
;
1527 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
1528 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
1530 if not slReturnPressed
then
1532 Srv
:= GetServerFromTable(slSelection
, SL
, ST
);
1533 if Srv
.Password
then
1536 PromptPort
:= Srv
.Port
;
1537 gState
:= STATE_MENU
;
1538 g_GUI_ShowWindow('ClientPasswordMenu');
1541 slReturnPressed
:= True;
1545 g_Game_StartClient(Srv
.IP
, Srv
.Port
, '');
1548 slReturnPressed
:= True;
1553 slReturnPressed
:= False;
1555 if e_KeyPressed(IK_DOWN
) or e_KeyPressed(IK_KPDOWN
) or e_KeyPressed(VK_DOWN
) or
1556 e_KeyPressed(JOY0_DOWN
) or e_KeyPressed(JOY1_DOWN
) or e_KeyPressed(JOY2_DOWN
) or e_KeyPressed(JOY3_DOWN
) then
1558 if not slDirPressed
then
1561 if slSelection
> High(ST
) then slSelection
:= 0;
1562 slDirPressed
:= True;
1566 if e_KeyPressed(IK_UP
) or e_KeyPressed(IK_KPUP
) or e_KeyPressed(VK_UP
) or
1567 e_KeyPressed(JOY0_UP
) or e_KeyPressed(JOY1_UP
) or e_KeyPressed(JOY2_UP
) or e_KeyPressed(JOY3_UP
) then
1569 if not slDirPressed
then
1571 if slSelection
= 0 then slSelection
:= Length(ST
);
1574 slDirPressed
:= True;
1578 if e_KeyPressed(IK_RIGHT
) or e_KeyPressed(IK_KPRIGHT
) or e_KeyPressed(VK_RIGHT
) or
1579 e_KeyPressed(JOY0_RIGHT
) or e_KeyPressed(JOY1_RIGHT
) or e_KeyPressed(JOY2_RIGHT
) or e_KeyPressed(JOY3_RIGHT
) then
1581 if not slDirPressed
then
1583 Inc(ST
[slSelection
].Current
);
1584 if ST
[slSelection
].Current
> High(ST
[slSelection
].Indices
) then ST
[slSelection
].Current
:= 0;
1585 slDirPressed
:= True;
1589 if e_KeyPressed(IK_LEFT
) or e_KeyPressed(IK_KPLEFT
) or e_KeyPressed(VK_LEFT
) or
1590 e_KeyPressed(JOY0_LEFT
) or e_KeyPressed(JOY1_LEFT
) or e_KeyPressed(JOY2_LEFT
) or e_KeyPressed(JOY3_LEFT
) then
1592 if not slDirPressed
then
1594 if ST
[slSelection
].Current
= 0 then ST
[slSelection
].Current
:= Length(ST
[slSelection
].Indices
);
1595 Dec(ST
[slSelection
].Current
);
1597 slDirPressed
:= True;
1601 if (not e_KeyPressed(IK_DOWN
)) and
1602 (not e_KeyPressed(IK_UP
)) and
1603 (not e_KeyPressed(IK_RIGHT
)) and
1604 (not e_KeyPressed(IK_LEFT
)) and
1605 (not e_KeyPressed(IK_KPDOWN
)) and
1606 (not e_KeyPressed(IK_KPUP
)) and
1607 (not e_KeyPressed(IK_KPRIGHT
)) and
1608 (not e_KeyPressed(IK_KPLEFT
)) and
1609 (not e_KeyPressed(VK_DOWN
)) and
1610 (not e_KeyPressed(VK_UP
)) and
1611 (not e_KeyPressed(VK_RIGHT
)) and
1612 (not e_KeyPressed(VK_LEFT
)) and
1613 (not e_KeyPressed(JOY0_UP
)) and (not e_KeyPressed(JOY1_UP
)) and (not e_KeyPressed(JOY2_UP
)) and (not e_KeyPressed(JOY3_UP
)) and
1614 (not e_KeyPressed(JOY0_DOWN
)) and (not e_KeyPressed(JOY1_DOWN
)) and (not e_KeyPressed(JOY2_DOWN
)) and (not e_KeyPressed(JOY3_DOWN
)) and
1615 (not e_KeyPressed(JOY0_LEFT
)) and (not e_KeyPressed(JOY1_LEFT
)) and (not e_KeyPressed(JOY2_LEFT
)) and (not e_KeyPressed(JOY3_LEFT
)) and
1616 (not e_KeyPressed(JOY0_RIGHT
)) and (not e_KeyPressed(JOY1_RIGHT
)) and (not e_KeyPressed(JOY2_RIGHT
)) and (not e_KeyPressed(JOY3_RIGHT
))
1618 slDirPressed
:= False;