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 addressInited
: Boolean;
74 // server list request working flags
76 srvAnswer
: array of TNetServer
;
79 slReadUrgent
: Boolean;
85 constructor Create (hostandport
: AnsiString);
89 function setAddress (hostandport
: AnsiString): Boolean;
91 function isValid (): Boolean;
92 function isAlive (): Boolean; // not disconnected
93 function isConnecting (): Boolean; // is connection in progress?
94 function isConnected (): Boolean;
96 // call as often as you want, the object will do the rest
97 // but try to call this at least once in 100 msecs
100 procedure disconnect ();
101 function connect (): Boolean;
106 class procedure writeInfo (var msg
: TMsg
); static
;
108 procedure connectedEvent ();
109 procedure disconnectedEvent ();
110 procedure receivedEvent (pkt
: pENetPacket
); // `pkt` is never `nil`
115 slCurrent
: TNetServerList
= nil;
116 slTable
: TNetServerTable
= nil;
117 slWaitStr
: AnsiString = '';
118 slReturnPressed
: Boolean = True;
120 slMOTD
: AnsiString = '';
121 slUrgent
: AnsiString = '';
124 procedure g_Net_Slist_Set (IP
: AnsiString; Port
: Word);
125 function g_Net_Slist_Fetch (var SL
: TNetServerList
): Boolean;
127 // make this server private
128 procedure g_Net_Slist_Private ();
129 // make this server public
130 procedure g_Net_Slist_Public ();
132 // called on network mode init
133 procedure g_Net_Slist_NetworkStarted ();
134 // called on network mode shutdown
135 procedure g_Net_Slist_NetworkStopped ();
137 procedure g_Net_Slist_Pulse (timeout
: Integer=0);
139 procedure g_Serverlist_GenerateTable (SL
: TNetServerList
; var ST
: TNetServerTable
);
140 procedure g_Serverlist_Draw (var SL
: TNetServerList
; var ST
: TNetServerTable
);
141 procedure g_Serverlist_Control (var SL
: TNetServerList
; var ST
: TNetServerTable
);
143 function GetTimerMS (): Int64;
149 e_input
, e_graphics
, e_log
, g_window
, g_net
, g_console
,
150 g_map
, g_game
, g_sound
, g_gui
, g_menu
, g_options
, g_language
, g_basic
,
151 wadreader
, g_system
, utils
;
153 // make this server private
154 procedure g_Net_Slist_Private ();
159 // make this server public
160 procedure g_Net_Slist_Public ();
165 // called on network mode init
166 procedure g_Net_Slist_NetworkStarted ();
170 // called on network mode shutdown
171 procedure g_Net_Slist_NetworkStopped ();
177 NetMHost
: pENetHost
= nil;
178 NetMEvent
: ENetEvent
;
179 mlist
: array of TMasterHost
= nil;
181 slSelection
: Byte = 0;
182 slFetched
: Boolean = False;
183 slDirPressed
: Boolean = False;
184 slReadUrgent
: Boolean = False;
187 //==========================================================================
191 //==========================================================================
192 function GetTimerMS (): Int64;
194 Result
:= sys_GetTicks() {div 1000};
198 //==========================================================================
202 //==========================================================================
203 function findByPeer (peer
: pENetPeer
): Integer;
207 for f
:= 0 to High(mlist
) do if (mlist
[f
].peer
= peer
) then begin result
:= f
; exit
; end;
212 //==========================================================================
214 // TMasterHost.Create
216 //==========================================================================
217 constructor TMasterHost
.Create (hostandport
: AnsiString);
220 NetHostConnected
:= false;
221 NetHostConReqTime
:= 0;
222 NetUpdatePending
:= false;
226 SetLength(srvAnswer
, 0);
230 slReadUrgent
:= true;
231 netmsg
.Alloc(NET_BUFSIZE
);
232 setAddress(hostandport
);
236 //==========================================================================
240 //==========================================================================
241 procedure TMasterHost
.clear ();
243 updateSent
:= false; // do not send 'remove'
248 SetLength(srvAnswer
, 0);
252 slReadUrgent
:= true;
256 //==========================================================================
258 // TMasterHost.setAddress
260 //==========================================================================
261 function TMasterHost
.setAddress (hostandport
: AnsiString): Boolean;
266 SetLength(srvAnswer
, 0);
270 slReadUrgent
:= true;
271 updateSent
:= false; // do not send 'remove'
273 addressInited
:= false;
276 hostandport
:= Trim(hostandport
);
277 if (length(hostandport
) > 0) then
279 hostName
:= hostandport
;
280 cp
:= Pos(':', hostandport
);
283 hostName
:= Copy(hostandport
, 1, cp
-1);
284 Delete(hostandport
, 1, cp
);
285 if (length(hostandport
) > 0) then
288 pp
:= StrToInt(hostandport
);
292 if (pp
> 0) and (pp
< 65536) then hostPort
:= pp
else hostPort
:= 0;
297 if not isValid() then exit
;
298 if (NetInitDone
) then
300 if (enet_address_set_host(@enetAddr
, PChar(Addr(hostName
[1]))) <> 0) then
305 enetAddr
.Port
:= hostPort
;
312 //==========================================================================
314 // TMasterHost.isValid
316 //==========================================================================
317 function TMasterHost
.isValid (): Boolean;
319 result
:= (length(hostName
) > 0) and (hostPort
> 0);
323 //==========================================================================
325 // TMasterHost.isAlive
329 //==========================================================================
330 function TMasterHost
.isAlive (): Boolean;
332 result
:= (NetMHost
<> nil) and (peer
<> nil);
336 //==========================================================================
338 // TMasterHost.isConnecting
340 // is connection in progress?
342 //==========================================================================
343 function TMasterHost
.isConnecting (): Boolean;
345 result
:= isAlive() and (not NetHostConnected
) and (NetHostConReqTime
<> -1);
349 //==========================================================================
351 // TMasterHost.isConnected
353 //==========================================================================
354 function TMasterHost
.isConnected (): Boolean;
356 result
:= isAlive() and (NetHostConnected
) and (NetHostConReqTime
<> -1);
360 //==========================================================================
362 // TMasterHost.connectedEvent
364 //==========================================================================
365 procedure TMasterHost
.connectedEvent ();
367 if not isAlive() then exit
;
368 if NetHostConnected
then exit
;
369 NetHostConnected
:= true;
370 e_LogWritefln('connected to master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
374 //==========================================================================
376 // TMasterHost.disconnectedEvent
378 //==========================================================================
379 procedure TMasterHost
.disconnectedEvent ();
381 if not isAlive() then exit
;
382 e_LogWritefln('disconnected from master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
383 enet_peer_reset(peer
);
385 NetHostConnected
:= False;
386 NetHostConReqTime
:= 0;
387 NetUpdatePending
:= false;
389 //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
393 //==========================================================================
395 // TMasterHost.receivedEvent
397 // `pkt` is never `nil`
399 //==========================================================================
400 procedure TMasterHost
.receivedEvent (pkt
: pENetPacket
);
415 MyVer, Str: AnsiString;
418 e_LogWritefln('received packed from master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
419 if not msg
.Init(pkt
^.data
, pkt
^.dataLength
, True) then exit
;
421 MID
:= msg
.ReadByte();
422 if (MID
<> NET_MMSG_GET
) then exit
;
423 e_LogWritefln('received list packet from master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
424 SetLength(srvAnswer
, 0);
425 if (srvAnswered
> 0) then Inc(srvAnswered
);
428 slReadUrgent
:= true;
430 Cnt
:= msg
.ReadByte();
431 g_Console_Add(_lc
[I_NET_MSG
]+Format(_lc
[I_NET_SLIST_RETRIEVED
], [Cnt
]), True);
434 SetLength(srvAnswer
, Cnt
);
435 for f
:= 0 to Cnt
-1 do
437 srvAnswer
[f
].Number
:= f
;
438 srvAnswer
[f
].IP
:= msg
.ReadString();
439 srvAnswer
[f
].Port
:= msg
.ReadWord();
440 srvAnswer
[f
].Name
:= msg
.ReadString();
441 srvAnswer
[f
].Map
:= msg
.ReadString();
442 srvAnswer
[f
].GameMode
:= msg
.ReadByte();
443 srvAnswer
[f
].Players
:= msg
.ReadByte();
444 srvAnswer
[f
].MaxPlayers
:= msg
.ReadByte();
445 srvAnswer
[f
].Protocol
:= msg
.ReadByte();
446 srvAnswer
[f
].Password
:= msg
.ReadByte() = 1;
447 enet_address_set_host(Addr(srvAnswer
[f
].PingAddr
), PChar(Addr(srvAnswer
[f
].IP
[1])));
448 srvAnswer
[f
].Ping
:= -1;
449 srvAnswer
[f
].PingAddr
.port
:= NET_PING_PORT
;
453 if (msg
.ReadCount
< msg
.CurSize
) then
455 // new master, supports version reports
456 s
:= msg
.ReadString();
457 if (s
<> {MyVer}GAME_VERSION
) then
460 g_Console_Add('!!! UpdVer = `'+s
+'`');
462 // even newer master, supports extra info
463 if (msg
.ReadCount
< msg
.CurSize
) then
465 slMOTD
:= b_Text_Format(msg
.ReadString());
466 s
:= b_Text_Format(msg
.ReadString());
467 // check if the message has updated and the user has to read it again
468 if (slUrgent
<> s
) then slReadUrgent
:= false;
475 //==========================================================================
479 // this performs various scheduled tasks, if necessary
481 //==========================================================================
482 procedure TMasterHost
.pulse ();
486 if not isAlive() then exit
;
487 if (NetHostConReqTime
= -1) then exit
; // waiting for shutdown (disconnect in progress)
488 // process pending connection timeout
489 if (not NetHostConnected
) then
492 if (ct
< NetHostConReqTime
) or (ct
-NetHostConReqTime
>= 3000) then
494 e_LogWritefln('failed to connect to master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
495 // do not spam with error messages, it looks like the master is down
496 //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
497 enet_peer_disconnect(peer
, 0);
498 // main pulse will take care of the rest
505 //==========================================================================
507 // TMasterHost.disconnect
509 //==========================================================================
510 procedure TMasterHost
.disconnect ();
512 if not isAlive() then exit
;
513 //if (NetMode = NET_SERVER) and isConnected() and updateSent then remove();
515 enet_peer_disconnect_later(peer
, 0);
516 // main pulse will take care of the rest
517 NetHostConnected
:= false;
518 NetHostConReqTime
:= -1;
519 NetUpdatePending
:= false;
522 //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
526 //==========================================================================
528 // TMasterHost.connect
530 //==========================================================================
531 function TMasterHost
.connect (): Boolean;
534 if not isValid() or (NetHostConReqTime
= -1) then exit
;
535 if isAlive() then begin result
:= true; exit
; end;
537 SetLength(srvAnswer
, 0);
539 NetHostConnected
:= false;
540 NetHostConReqTime
:= 0;
541 NetUpdatePending
:= false;
543 if (not NetInitDone
) then exit
;
545 if (not addressInited
) then
547 if (enet_address_set_host(@enetAddr
, PChar(Addr(hostName
[1]))) <> 0) then
553 enetAddr
.Port
:= hostPort
;
554 addressInited
:= true;
557 peer
:= enet_host_connect(NetMHost
, @enetAddr
, NET_MCHANS
, 0);
560 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], true);
564 NetHostConReqTime
:= GetTimerMS();
565 e_LogWritefln('connecting to master at [%s:%u]', [hostName
, hostPort
], TMsgType
.Notify
);
569 //==========================================================================
571 // TMasterHost.writeInfo
573 //==========================================================================
574 class procedure TMasterHost
.writeInfo (var msg
: TMsg
);
576 wad
, map
: AnsiString;
578 wad
:= g_ExtractWadNameNoPath(gMapInfo
.Map
);
579 map
:= g_ExtractFileName(gMapInfo
.Map
);
581 msg
.Write(NetServerName
);
583 msg
.Write(wad
+':/'+map
);
584 msg
.Write(gGameSettings
.GameMode
);
586 msg
.Write(Byte(NetClientCount
));
588 msg
.Write(NetMaxClients
);
590 msg
.Write(Byte(NET_PROTOCOL_VER
));
591 msg
.Write(Byte(NetPassword
<> ''));
595 //==========================================================================
597 // TMasterHost.update
599 //==========================================================================
600 procedure TMasterHost
.update ();
604 if not isAlive() then exit
;
605 if not isConnected() then
607 NetUpdatePending
:= isConnecting();
613 netmsg
.Write(Byte(NET_MMSG_UPD
));
614 netmsg
.Write(NetAddr
.port
);
618 pkt
:= enet_packet_create(netmsg
.Data
, netmsg
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
619 if assigned(pkt
) then
621 if (enet_peer_send(peer
, NET_MCHAN_UPD
, pkt
) = 0) then NetUpdatePending
:= false;
629 //==========================================================================
631 // TMasterHost.remove
633 //==========================================================================
634 procedure TMasterHost
.remove ();
638 NetUpdatePending
:= false;
639 if not isAlive() then exit
;
640 if not isConnected() then exit
;
644 netmsg
.Write(Byte(NET_MMSG_DEL
));
645 netmsg
.Write(NetAddr
.port
);
647 pkt
:= enet_packet_create(netmsg
.Data
, netmsg
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
648 if assigned(pkt
) then
650 enet_peer_send(peer
, NET_MCHAN_MAIN
, pkt
);
658 //**************************************************************************
662 //**************************************************************************
664 procedure g_Net_Slist_Set (IP
: AnsiString; Port
: Word);
666 if (length(mlist
) = 0) then
669 mlist
[0].Create(ip
+':'+IntToStr(Port
));
673 mlist
[0].setAddress(ip
+':'+IntToStr(Port
));
675 e_LogWritefln('Masterserver address set to [%s:%u]', [IP
, Port
], TMsgType
.Notify
);
679 enet_address_set_host(@NetSlistAddr, PChar(Addr(IP[1])));
680 NetSlistAddr.Port := Port;
681 e_WriteLog('Masterserver address set to ' + IP + ':' + IntToStr(Port), TMsgType.Notify);
687 //**************************************************************************
691 //**************************************************************************
692 procedure g_Net_Slist_Pulse (timeout
: Integer=0);
698 if (length(mlist
) = 0) then
700 if (NetMHost
<> nil) then
702 enet_host_destroy(NetMHost
);
708 if (NetMHost
= nil) then
710 NetMHost
:= enet_host_create(nil, 1, NET_MCHANS
, 0, 0);
711 if (NetMHost
= nil) then
713 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], True);
714 for f
:= 0 to High(mlist
) do mlist
[f
].clear();
720 for f
:= 0 to High(mlist
) do mlist
[f
].pulse();
724 sres
:= enet_host_service(NetMHost
, @NetMEvent
, timeout
);
727 g_Console_Add(_lc
[I_NET_MSG_ERROR
]+_lc
[I_NET_ERR_CLIENT
], True);
728 for f
:= 0 to High(mlist
) do mlist
[f
].clear();
730 enet_host_destroy(NetMHost
);
735 if (sres
= 0) then break
;
736 idx
:= findByPeer(NetMEvent
.peer
);
739 e_LogWriteln('network event from unknown master host. ignored.', TMsgType
.Warning
);
740 if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then enet_packet_destroy(NetMEvent
.packet
);
744 if (NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
746 mlist
[idx
].connectedEvent();
748 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
750 mlist
[idx
].disconnectedEvent();
752 else if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
754 mlist
[idx
].receivedEvent(NetMEvent
.packet
);
755 enet_packet_destroy(NetMEvent
.packet
);
761 //**************************************************************************
763 // gui and server list
765 //**************************************************************************
767 //==========================================================================
771 //==========================================================================
772 procedure PingServer (var S
: TNetServer
; Sock
: ENetSocket
);
775 Ping
: array [0..9] of Byte;
778 ClTime
:= GetTimerMS();
780 Buf
.data
:= Addr(Ping
[0]);
781 Buf
.dataLength
:= 2+8;
785 Int64(Addr(Ping
[2])^) := ClTime
;
787 enet_socket_send(Sock
, Addr(S
.PingAddr
), @Buf
, 1);
791 //==========================================================================
795 //==========================================================================
796 procedure PingBcast (Sock
: ENetSocket
);
800 S
.IP
:= '255.255.255.255';
801 S
.Port
:= NET_PING_PORT
;
802 enet_address_set_host(Addr(S
.PingAddr
), PChar(Addr(S
.IP
[1])));
804 S
.PingAddr
.port
:= S
.Port
;
809 //==========================================================================
813 //==========================================================================
814 function g_Net_Slist_Fetch (var SL
: TNetServerList
): Boolean;
827 procedure DisconnectAll ();
831 for f
:= 0 to High(mlist
) do
833 if (mlist
[f
].isAlive()) then mlist
[f
].disconnect();
837 procedure ProcessLocal ();
840 SetLength(SL
, I
+ 1);
843 IP
:= DecodeIPV4(SvAddr
.host
);
844 Port
:= InMsg
.ReadWord();
845 Ping
:= InMsg
.ReadInt64();
846 Ping
:= GetTimerMS() - Ping
;
847 Name
:= InMsg
.ReadString();
848 Map
:= InMsg
.ReadString();
849 GameMode
:= InMsg
.ReadByte();
850 Players
:= InMsg
.ReadByte();
851 MaxPlayers
:= InMsg
.ReadByte();
852 Protocol
:= InMsg
.ReadByte();
853 Password
:= InMsg
.ReadByte() = 1;
854 LocalPl
:= InMsg
.ReadByte();
855 Bots
:= InMsg
.ReadWord();
859 procedure CheckLocalServers ();
863 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
864 if Sock
= ENET_SOCKET_NULL
then Exit
;
865 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
866 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
871 InMsg
.Alloc(NET_BUFSIZE
);
872 Buf
.data
:= InMsg
.Data
;
873 Buf
.dataLength
:= InMsg
.MaxSize
;
874 while GetTimerMS() - T
<= 500 do
878 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
879 if RX
<= 0 then continue
;
882 InMsg
.BeginReading();
884 if InMsg
.ReadChar() <> 'D' then continue
;
885 if InMsg
.ReadChar() <> 'F' then continue
;
891 enet_socket_destroy(Sock
);
893 if Length(SL
) = 0 then SL
:= nil;
897 f
, c
, n
, pos
: Integer;
899 hasUnanswered
: Boolean;
905 g_Net_Slist_Pulse(); // this will create mhost
908 NetOut
.Write(Byte(NET_MMSG_GET
));
910 // TODO: what should we identify the build with?
911 MyVer
:= GAME_VERSION
;
916 for f
:= 0 to High(mlist
) do
918 mlist
[f
].srvAnswered
:= 0;
919 if (not mlist
[f
].isValid()) then continue
;
920 if (not mlist
[f
].isConnected()) then mlist
[f
].connect();
921 if (not mlist
[f
].isAlive()) then continue
;
922 if (mlist
[f
].isConnected()) then
924 pkt
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
925 if assigned(pkt
) then
927 if (enet_peer_send(mlist
[f
].peer
, NET_MCHAN_MAIN
, pkt
) = 0) then
930 mlist
[f
].srvAnswered
:= 1;
934 else if (mlist
[f
].isConnecting()) then
940 if (aliveCount
= 0) then
947 e_WriteLog('Fetching serverlist...', TMsgType
.Notify
);
948 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_FETCH
]);
950 // wait until all servers connected and answered
954 g_Net_Slist_Pulse(300);
956 hasUnanswered
:= false;
957 for f
:= 0 to High(mlist
) do
959 if (not mlist
[f
].isValid()) then continue
;
960 if (mlist
[f
].isConnected()) then
962 if (mlist
[f
].srvAnswered
= 0) then
964 pkt
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
965 if assigned(pkt
) then
967 if (enet_peer_send(mlist
[f
].peer
, NET_MCHAN_MAIN
, pkt
) = 0) then
969 hasUnanswered
:= true;
970 mlist
[f
].srvAnswered
:= 1;
974 else if (mlist
[f
].srvAnswered
= 1) then
976 hasUnanswered
:= true;
978 else if (mlist
[f
].srvAnswered
> 1) then
983 else if (mlist
[f
].isConnecting()) then
985 hasUnanswered
:= true;
988 if (not hasUnanswered
) then break
;
991 if (ct
< stt
) or (ct
-stt
> 4000) then break
;
994 if (aliveCount
= 0) then
1004 slReadUrgent := true;
1008 for f
:= 0 to High(mlist
) do
1010 if (mlist
[f
].srvAnswered
< 2) then continue
;
1011 for n
:= 0 to High(mlist
[f
].srvAnswer
) do
1014 for c
:= 0 to High(SL
) do
1016 if (SL
[c
].IP
= mlist
[f
].srvAnswer
[n
].IP
) and (SL
[c
].Port
= mlist
[f
].srvAnswer
[n
].Port
) then
1025 SetLength(SL
, pos
+1);
1026 SL
[pos
] := mlist
[f
].srvAnswer
[n
];
1027 SL
[pos
].Number
:= pos
;
1030 if (not mlist
[f
].slReadUrgent
) and (mlist
[f
].slUrgent
<> '') then
1032 if (mlist
[f
].slUrgent
<> slUrgent
) then
1034 slUrgent
:= mlist
[f
].slUrgent
;
1035 slReadUrgent
:= false;
1038 if (slMOTD
<> '') and (mlist
[f
].slMOTD
<> '') then
1040 slMOTD
:= mlist
[f
].slMOTD
;
1046 if (length(SL
) = 0) then
1048 CheckLocalServers();
1052 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
1053 if Sock
= ENET_SOCKET_NULL
then Exit
;
1054 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
1056 for I
:= Low(SL
) to High(SL
) do PingServer(SL
[I
], Sock
);
1058 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
1063 InMsg
.Alloc(NET_BUFSIZE
);
1064 Buf
.data
:= InMsg
.Data
;
1065 Buf
.dataLength
:= InMsg
.MaxSize
;
1067 while GetTimerMS() - T
<= 500 do
1071 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
1072 if RX
<= 0 then continue
;
1073 InMsg
.CurSize
:= RX
;
1075 InMsg
.BeginReading();
1077 if InMsg
.ReadChar() <> 'D' then continue
;
1078 if InMsg
.ReadChar() <> 'F' then continue
;
1081 for I
:= Low(SL
) to High(SL
) do
1082 if (SL
[I
].PingAddr
.host
= SvAddr
.host
) and
1083 (SL
[I
].PingAddr
.port
= SvAddr
.port
) then
1087 Port
:= InMsg
.ReadWord();
1088 Ping
:= InMsg
.ReadInt64();
1089 Ping
:= GetTimerMS() - Ping
;
1090 Name
:= InMsg
.ReadString();
1091 Map
:= InMsg
.ReadString();
1092 GameMode
:= InMsg
.ReadByte();
1093 Players
:= InMsg
.ReadByte();
1094 MaxPlayers
:= InMsg
.ReadByte();
1095 Protocol
:= InMsg
.ReadByte();
1096 Password
:= InMsg
.ReadByte() = 1;
1097 LocalPl
:= InMsg
.ReadByte();
1098 Bots
:= InMsg
.ReadWord();
1109 enet_socket_destroy(Sock
);
1116 //==========================================================================
1118 // GetServerFromTable
1120 //==========================================================================
1121 function GetServerFromTable (Index
: Integer; SL
: TNetServerList
; ST
: TNetServerTable
): TNetServer
;
1124 Result
.Protocol
:= 0;
1129 Result
.Players
:= 0;
1130 Result
.MaxPlayers
:= 0;
1131 Result
.LocalPl
:= 0;
1134 Result
.GameMode
:= 0;
1135 Result
.Password
:= false;
1136 FillChar(Result
.PingAddr
, SizeOf(ENetAddress
), 0);
1139 if (Index
< 0) or (Index
>= Length(ST
)) then
1141 Result
:= SL
[ST
[Index
].Indices
[ST
[Index
].Current
]];
1145 //==========================================================================
1147 // g_Serverlist_Draw
1149 //==========================================================================
1150 procedure g_Serverlist_Draw (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1153 sy
, i
, y
, mw
, mx
, l
, motdh
: Integer;
1163 e_CharFont_GetSize(gMenuFont
, _lc
[I_NET_SLIST
], ww
, hh
);
1164 e_CharFont_Print(gMenuFont
, (gScreenWidth
div 2) - (ww
div 2), 16, _lc
[I_NET_SLIST
]);
1166 e_TextureFontGetSize(gStdFont
, cw
, ch
);
1168 ip
:= _lc
[I_NET_SLIST_HELP
];
1169 mw
:= (Length(ip
) * cw
) div 2;
1171 motdh
:= gScreenHeight
- 49 - ch
* b_Text_LineCount(slMOTD
);
1173 e_DrawFillQuad(16, 64, gScreenWidth
-16, motdh
, 64, 64, 64, 110);
1174 e_DrawQuad(16, 64, gScreenWidth
-16, motdh
, 255, 127, 0);
1176 e_TextureFontPrintEx(gScreenWidth
div 2 - mw
, gScreenHeight
-24, ip
, gStdFont
, 225, 225, 225, 1);
1179 if slMOTD
<> '' then
1181 e_DrawFillQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 110);
1182 e_DrawQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 255, 127, 0);
1183 e_TextureFontPrintFmt(20, motdh
+ 3, slMOTD
, gStdFont
, False, True);
1187 if not slReadUrgent
and (slUrgent
<> '') then
1189 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
1190 e_DrawFillQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
1191 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 64, 64, 64, 128);
1192 e_DrawQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
1193 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 255, 127, 0);
1194 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 40,
1195 gScreenWidth
div 2 + 256, gScreenHeight
div 2 - 40, 255, 127, 0);
1196 l
:= Length(_lc
[I_NET_SLIST_URGENT
]) div 2;
1197 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - 58,
1198 _lc
[I_NET_SLIST_URGENT
], gStdFont
);
1199 l
:= Length(slUrgent
) div 2;
1200 e_TextureFontPrintFmt(gScreenWidth
div 2 - 253, gScreenHeight
div 2 - 38,
1201 slUrgent
, gStdFont
, False, True);
1202 l
:= Length(_lc
[I_NET_SLIST_URGENT_CONT
]) div 2;
1203 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 + 41,
1204 _lc
[I_NET_SLIST_URGENT_CONT
], gStdFont
);
1205 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 + 40,
1206 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 40, 255, 127, 0);
1212 l
:= Length(slWaitStr
) div 2;
1213 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
1214 e_DrawQuad(gScreenWidth
div 2 - 192, gScreenHeight
div 2 - 10,
1215 gScreenWidth
div 2 + 192, gScreenHeight
div 2 + 11, 255, 127, 0);
1216 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - ch
div 2,
1217 slWaitStr
, gStdFont
);
1222 if (slSelection
< Length(ST
)) then
1225 sy
:= y
+ 42 * I
- 4;
1226 Srv
:= GetServerFromTable(I
, SL
, ST
);
1227 ip
:= _lc
[I_NET_ADDRESS
] + ' ' + Srv
.IP
+ ':' + IntToStr(Srv
.Port
);
1228 if Srv
.Password
then
1229 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_YES
]
1231 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_NO
];
1233 if Length(ST
) > 0 then
1236 mw
:= (gScreenWidth
- 188);
1239 e_DrawFillQuad(16 + 1, sy
, gScreenWidth
- 16 - 1, sy
+ 40, 64, 64, 64, 0);
1240 e_DrawLine(1, 16 + 1, sy
, gScreenWidth
- 16 - 1, sy
, 205, 205, 205);
1241 e_DrawLine(1, 16 + 1, sy
+ 41, gScreenWidth
- 16 - 1, sy
+ 41, 255, 255, 255);
1243 e_DrawLine(1, 16, 85, gScreenWidth
- 16, 85, 255, 127, 0);
1244 e_DrawLine(1, 16, motdh
-20, gScreenWidth
-16, motdh
-20, 255, 127, 0);
1246 e_DrawLine(1, mx
- 70, 64, mx
- 70, motdh
, 255, 127, 0);
1247 e_DrawLine(1, mx
, 64, mx
, motdh
-20, 255, 127, 0);
1248 e_DrawLine(1, mx
+ 52, 64, mx
+ 52, motdh
-20, 255, 127, 0);
1249 e_DrawLine(1, mx
+ 104, 64, mx
+ 104, motdh
-20, 255, 127, 0);
1251 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont
, 255, 127, 0, 1);
1252 e_TextureFontPrintEx(mx
- 68, 68, 'PING', gStdFont
, 255, 127, 0, 1);
1253 e_TextureFontPrintEx(mx
+ 2, 68, 'MODE', gStdFont
, 255, 127, 0, 1);
1254 e_TextureFontPrintEx(mx
+ 54, 68, 'PLRS', gStdFont
, 255, 127, 0, 1);
1255 e_TextureFontPrintEx(mx
+ 106, 68, 'VER', gStdFont
, 255, 127, 0, 1);
1258 for I
:= 0 to High(ST
) do
1260 Srv
:= GetServerFromTable(I
, SL
, ST
);
1262 e_TextureFontPrintEx(18, y
, Srv
.Name
, gStdFont
, 255, 255, 255, 1);
1263 e_TextureFontPrintEx(18, y
+ 16, Srv
.Map
, gStdFont
, 210, 210, 210, 1);
1265 // Ping and similar count
1266 if (Srv
.Ping
< 0) or (Srv
.Ping
> 999) then
1267 e_TextureFontPrintEx(mx
- 68, y
, _lc
[I_NET_SLIST_NO_ACCESS
], gStdFont
, 255, 0, 0, 1)
1269 if Srv
.Ping
= 0 then
1270 e_TextureFontPrintEx(mx
- 68, y
, '<1' + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1)
1272 e_TextureFontPrintEx(mx
- 68, y
, IntToStr(Srv
.Ping
) + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1);
1274 if Length(ST
[I
].Indices
) > 1 then
1275 e_TextureFontPrintEx(mx
- 68, y
+ 16, '< ' + IntToStr(Length(ST
[I
].Indices
)) + ' >', gStdFont
, 210, 210, 210, 1);
1278 e_TextureFontPrintEx(mx
+ 2, y
, g_Game_ModeToText(Srv
.GameMode
), gStdFont
, 255, 255, 255, 1);
1281 e_TextureFontPrintEx(mx
+ 54, y
, IntToStr(Srv
.Players
) + '/' + IntToStr(Srv
.MaxPlayers
), gStdFont
, 255, 255, 255, 1);
1282 e_TextureFontPrintEx(mx
+ 54, y
+ 16, IntToStr(Srv
.LocalPl
) + '+' + IntToStr(Srv
.Bots
), gStdFont
, 210, 210, 210, 1);
1285 e_TextureFontPrintEx(mx
+ 106, y
, IntToStr(Srv
.Protocol
), gStdFont
, 255, 255, 255, 1);
1290 e_TextureFontPrintEx(20, motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
1291 ip
:= IntToStr(Length(ST
)) + _lc
[I_NET_SLIST_SERVERS
];
1292 e_TextureFontPrintEx(gScreenWidth
- 48 - (Length(ip
) + 1)*cw
,
1293 motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
1297 //==========================================================================
1299 // g_Serverlist_GenerateTable
1301 //==========================================================================
1302 procedure g_Serverlist_GenerateTable (SL
: TNetServerList
; var ST
: TNetServerTable
);
1306 function FindServerInTable(Name
: AnsiString): Integer;
1313 for i
:= Low(ST
) to High(ST
) do
1315 if Length(ST
[i
].Indices
) = 0 then
1317 if SL
[ST
[i
].Indices
[0]].Name
= Name
then
1324 function ComparePing(i1
, i2
: Integer): Boolean;
1330 if (p1
< 0) then p1
:= 999;
1331 if (p2
< 0) then p2
:= 999;
1334 procedure SortIndices(var ind
: Array of Integer);
1339 for I
:= High(ind
) downto Low(ind
) do
1340 for J
:= Low(ind
) to High(ind
) - 1 do
1341 if ComparePing(ind
[j
], ind
[j
+1]) then
1348 procedure SortRows();
1353 for I
:= High(ST
) downto Low(ST
) do
1354 for J
:= Low(ST
) to High(ST
) - 1 do
1355 if ComparePing(ST
[j
].Indices
[0], ST
[j
+1].Indices
[0]) then
1366 for i
:= Low(SL
) to High(SL
) do
1368 j
:= FindServerInTable(SL
[i
].Name
);
1372 SetLength(ST
, j
+ 1);
1374 SetLength(ST
[j
].Indices
, 1);
1375 ST
[j
].Indices
[0] := i
;
1379 SetLength(ST
[j
].Indices
, Length(ST
[j
].Indices
) + 1);
1380 ST
[j
].Indices
[High(ST
[j
].Indices
)] := i
;
1384 for i
:= Low(ST
) to High(ST
) do
1385 SortIndices(ST
[i
].Indices
);
1391 //==========================================================================
1393 // g_Serverlist_Control
1395 //==========================================================================
1396 procedure g_Serverlist_Control (var SL
: TNetServerList
; var ST
: TNetServerTable
);
1401 if gConsoleShow
or gChatShow
then
1404 qm
:= sys_HandleInput(); // this updates kbd
1406 if qm
or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) or
1407 e_KeyPressed(JOY0_JUMP
) or e_KeyPressed(JOY1_JUMP
) or
1408 e_KeyPressed(JOY2_JUMP
) or e_KeyPressed(JOY3_JUMP
) then
1412 gState
:= STATE_MENU
;
1413 g_GUI_ShowWindow('MainMenu');
1414 g_GUI_ShowWindow('NetGameMenu');
1415 g_GUI_ShowWindow('NetClientMenu');
1416 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
1420 // if there's a message on the screen,
1421 if not slReadUrgent
and (slUrgent
<> '') then
1423 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
1424 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
1425 slReadUrgent
:= True;
1429 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(VK_JUMP
) or
1430 e_KeyPressed(JOY0_ACTIVATE
) or e_KeyPressed(JOY1_ACTIVATE
) or e_KeyPressed(JOY2_ACTIVATE
) or e_KeyPressed(JOY3_ACTIVATE
) then
1432 if not slFetched
then
1434 slWaitStr
:= _lc
[I_NET_SLIST_WAIT
];
1439 if g_Net_Slist_Fetch(SL
) then
1442 slWaitStr
:= _lc
[I_NET_SLIST_NOSERVERS
];
1446 slWaitStr
:= _lc
[I_NET_SLIST_ERROR
];
1449 g_Serverlist_GenerateTable(SL
, ST
);
1455 if SL
= nil then Exit
;
1457 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
1458 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
1460 if not slReturnPressed
then
1462 Srv
:= GetServerFromTable(slSelection
, SL
, ST
);
1463 if Srv
.Password
then
1466 PromptPort
:= Srv
.Port
;
1467 gState
:= STATE_MENU
;
1468 g_GUI_ShowWindow('ClientPasswordMenu');
1471 slReturnPressed
:= True;
1475 g_Game_StartClient(Srv
.IP
, Srv
.Port
, '');
1478 slReturnPressed
:= True;
1483 slReturnPressed
:= False;
1485 if e_KeyPressed(IK_DOWN
) or e_KeyPressed(IK_KPDOWN
) or e_KeyPressed(VK_DOWN
) or
1486 e_KeyPressed(JOY0_DOWN
) or e_KeyPressed(JOY1_DOWN
) or e_KeyPressed(JOY2_DOWN
) or e_KeyPressed(JOY3_DOWN
) then
1488 if not slDirPressed
then
1491 if slSelection
> High(ST
) then slSelection
:= 0;
1492 slDirPressed
:= True;
1496 if e_KeyPressed(IK_UP
) or e_KeyPressed(IK_KPUP
) or e_KeyPressed(VK_UP
) or
1497 e_KeyPressed(JOY0_UP
) or e_KeyPressed(JOY1_UP
) or e_KeyPressed(JOY2_UP
) or e_KeyPressed(JOY3_UP
) then
1499 if not slDirPressed
then
1501 if slSelection
= 0 then slSelection
:= Length(ST
);
1504 slDirPressed
:= True;
1508 if e_KeyPressed(IK_RIGHT
) or e_KeyPressed(IK_KPRIGHT
) or e_KeyPressed(VK_RIGHT
) or
1509 e_KeyPressed(JOY0_RIGHT
) or e_KeyPressed(JOY1_RIGHT
) or e_KeyPressed(JOY2_RIGHT
) or e_KeyPressed(JOY3_RIGHT
) then
1511 if not slDirPressed
then
1513 Inc(ST
[slSelection
].Current
);
1514 if ST
[slSelection
].Current
> High(ST
[slSelection
].Indices
) then ST
[slSelection
].Current
:= 0;
1515 slDirPressed
:= True;
1519 if e_KeyPressed(IK_LEFT
) or e_KeyPressed(IK_KPLEFT
) or e_KeyPressed(VK_LEFT
) or
1520 e_KeyPressed(JOY0_LEFT
) or e_KeyPressed(JOY1_LEFT
) or e_KeyPressed(JOY2_LEFT
) or e_KeyPressed(JOY3_LEFT
) then
1522 if not slDirPressed
then
1524 if ST
[slSelection
].Current
= 0 then ST
[slSelection
].Current
:= Length(ST
[slSelection
].Indices
);
1525 Dec(ST
[slSelection
].Current
);
1527 slDirPressed
:= True;
1531 if (not e_KeyPressed(IK_DOWN
)) and
1532 (not e_KeyPressed(IK_UP
)) and
1533 (not e_KeyPressed(IK_RIGHT
)) and
1534 (not e_KeyPressed(IK_LEFT
)) and
1535 (not e_KeyPressed(IK_KPDOWN
)) and
1536 (not e_KeyPressed(IK_KPUP
)) and
1537 (not e_KeyPressed(IK_KPRIGHT
)) and
1538 (not e_KeyPressed(IK_KPLEFT
)) and
1539 (not e_KeyPressed(VK_DOWN
)) and
1540 (not e_KeyPressed(VK_UP
)) and
1541 (not e_KeyPressed(VK_RIGHT
)) and
1542 (not e_KeyPressed(VK_LEFT
)) and
1543 (not e_KeyPressed(JOY0_UP
)) and (not e_KeyPressed(JOY1_UP
)) and (not e_KeyPressed(JOY2_UP
)) and (not e_KeyPressed(JOY3_UP
)) and
1544 (not e_KeyPressed(JOY0_DOWN
)) and (not e_KeyPressed(JOY1_DOWN
)) and (not e_KeyPressed(JOY2_DOWN
)) and (not e_KeyPressed(JOY3_DOWN
)) and
1545 (not e_KeyPressed(JOY0_LEFT
)) and (not e_KeyPressed(JOY1_LEFT
)) and (not e_KeyPressed(JOY2_LEFT
)) and (not e_KeyPressed(JOY3_LEFT
)) and
1546 (not e_KeyPressed(JOY0_RIGHT
)) and (not e_KeyPressed(JOY1_RIGHT
)) and (not e_KeyPressed(JOY2_RIGHT
)) and (not e_KeyPressed(JOY3_RIGHT
))
1548 slDirPressed
:= False;