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}
40 Players
, MaxPlayers
, LocalPl
, Bots
: Byte;
44 PingAddr
: ENetAddress
;
46 pTNetServer
= ^TNetServer
;
47 TNetServerRow
= record
48 Indices
: Array of Integer;
52 TNetServerList
= array of TNetServer
;
53 pTNetServerList
= ^TNetServerList
;
54 TNetServerTable
= array of TNetServerRow
;
57 slCurrent
: TNetServerList
= nil;
58 slTable
: TNetServerTable
= nil;
59 slWaitStr
: string = '';
60 slReturnPressed
: Boolean = True;
63 slUrgent
: string = '';
65 procedure g_Net_Slist_Set(IP
: string; Port
: Word);
66 function g_Net_Slist_Fetch(var SL
: TNetServerList
): Boolean;
67 procedure g_Net_Slist_Update (immediateSend
: Boolean=true);
68 procedure g_Net_Slist_Remove();
69 function g_Net_Slist_Connect(blocking
: Boolean=True): Boolean;
70 procedure g_Net_Slist_Check();
71 procedure g_Net_Slist_Disconnect (spamConsole
: Boolean=true);
72 procedure g_Net_Slist_WriteInfo();
74 function g_Net_Slist_IsConnectionActive (): Boolean; // returns `false` if totally disconnected
75 function g_Net_Slist_IsConnectionInProgress (): Boolean;
77 procedure g_Serverlist_GenerateTable(SL
: TNetServerList
; var ST
: TNetServerTable
);
78 procedure g_Serverlist_Draw(var SL
: TNetServerList
; var ST
: TNetServerTable
);
79 procedure g_Serverlist_Control(var SL
: TNetServerList
; var ST
: TNetServerTable
);
81 function GetTimerMS(): Int64;
87 SysUtils
, e_msg
, e_input
, e_graphics
, e_log
, g_window
, g_net
, g_console
,
88 g_map
, g_game
, g_sound
, g_gui
, g_menu
, g_options
, g_language
, g_basic
,
92 NetMHost
: pENetHost
= nil;
93 NetMPeer
: pENetPeer
= nil;
95 slSelection
: Byte = 0;
96 slFetched
: Boolean = False;
97 slDirPressed
: Boolean = False;
98 slReadUrgent
: Boolean = False;
99 // inside the game, calling `g_Net_Slist_Connect()` is disasterous, as it is blocking.
100 // so we'll use this variable to indicate if "connected" event is received.
101 NetHostConnected
: Boolean = false;
102 NetHostConReqTime
: Int64 = 0; // to timeout `connect`
103 NetUpdatePending
: Boolean = false;
106 function GetTimerMS (): Int64;
108 Result
:= sys_GetTicks() {div 1000};
112 // returns `false` if totally disconnected
113 function g_Net_Slist_IsConnectionActive (): Boolean;
115 result
:= (NetMHost
<> nil) and (NetMPeer
<> nil);
119 function g_Net_Slist_IsConnectionInProgress (): Boolean;
121 if (NetMHost
= nil) or (NetMPeer
= nil) then begin result
:= false; exit
; end;
122 result
:= (not NetHostConnected
);
126 // should be called only if host/peer is here
127 // returns `false` if not connected/dead
128 function ProcessPendingConnection (): Boolean;
133 if (NetMHost
= nil) or (NetMPeer
= nil) then exit
;
134 // are we waiting for connection?
135 if (not NetHostConnected
) then
137 // check for connection event
138 if (enet_host_service(NetMHost
, @NetMEvent
, 0) > 0) then
140 if (NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
142 NetHostConnected
:= true;
143 if NetUpdatePending
then g_Net_Slist_Update(false);
144 g_Console_Add(_lc
[I_NET_MSG
]+_lc
[I_NET_SLIST_CONN
]);
148 if (NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then enet_packet_destroy(NetMEvent
.packet
);
150 // check for connection timeout
151 if (not NetHostConnected
) then
154 if (ct
< NetHostConReqTime
) or (ct
-NetHostConReqTime
>= 3000) then
156 // do not spam with error messages, it looks like the master is down
157 //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
158 g_Net_Slist_Disconnect(false);
167 procedure PingServer(var S
: TNetServer
; Sock
: ENetSocket
);
170 Ping
: array [0..9] of Byte;
173 ClTime
:= GetTimerMS();
175 Buf
.data
:= Addr(Ping
[0]);
176 Buf
.dataLength
:= 2+8;
180 Int64(Addr(Ping
[2])^) := ClTime
;
182 enet_socket_send(Sock
, Addr(S
.PingAddr
), @Buf
, 1);
185 procedure PingBcast(Sock
: ENetSocket
);
189 S
.IP
:= '255.255.255.255';
190 S
.Port
:= NET_PING_PORT
;
191 enet_address_set_host(Addr(S
.PingAddr
), PChar(Addr(S
.IP
[1])));
193 S
.PingAddr
.port
:= S
.Port
;
197 function g_Net_Slist_Fetch(var SL
: TNetServerList
): Boolean;
211 procedure ProcessLocal();
214 SetLength(SL
, I
+ 1);
217 IP
:= DecodeIPV4(SvAddr
.host
);
218 Port
:= InMsg
.ReadWord();
219 Ping
:= InMsg
.ReadInt64();
220 Ping
:= GetTimerMS() - Ping
;
221 Name
:= InMsg
.ReadString();
222 Map
:= InMsg
.ReadString();
223 GameMode
:= InMsg
.ReadByte();
224 Players
:= InMsg
.ReadByte();
225 MaxPlayers
:= InMsg
.ReadByte();
226 Protocol
:= InMsg
.ReadByte();
227 Password
:= InMsg
.ReadByte() = 1;
228 LocalPl
:= InMsg
.ReadByte();
229 Bots
:= InMsg
.ReadWord();
232 procedure CheckLocalServers();
236 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
237 if Sock
= ENET_SOCKET_NULL
then Exit
;
238 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
239 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
244 InMsg
.Alloc(NET_BUFSIZE
);
245 Buf
.data
:= InMsg
.Data
;
246 Buf
.dataLength
:= InMsg
.MaxSize
;
247 while GetTimerMS() - T
<= 500 do
251 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
252 if RX
<= 0 then continue
;
255 InMsg
.BeginReading();
257 if InMsg
.ReadChar() <> 'D' then continue
;
258 if InMsg
.ReadChar() <> 'F' then continue
;
264 enet_socket_destroy(Sock
);
266 if Length(SL
) = 0 then SL
:= nil;
272 if (NetMHost
<> nil) or (NetMPeer
<> nil) then
278 if not g_Net_Slist_Connect
then
284 e_WriteLog('Fetching serverlist...', TMsgType
.Notify
);
285 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_FETCH
]);
288 NetOut
.Write(Byte(NET_MMSG_GET
));
290 // TODO: what should we identify the build with?
291 MyVer
:= GAME_VERSION
;
294 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
295 enet_peer_send(NetMPeer
, NET_MCHAN_MAIN
, P
);
296 enet_host_flush(NetMHost
);
298 while enet_host_service(NetMHost
, @NetMEvent
, 5000) > 0 do
300 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
302 if not InMsg
.Init(NetMEvent
.packet
^.data
, NetMEvent
.packet
^.dataLength
, True) then continue
;
304 MID
:= InMsg
.ReadByte();
306 if MID
<> NET_MMSG_GET
then continue
;
308 Cnt
:= InMsg
.ReadByte();
309 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_SLIST_RETRIEVED
], [Cnt
]), True);
315 for I
:= 0 to Cnt
- 1 do
318 SL
[I
].IP
:= InMsg
.ReadString();
319 SL
[I
].Port
:= InMsg
.ReadWord();
320 SL
[I
].Name
:= InMsg
.ReadString();
321 SL
[I
].Map
:= InMsg
.ReadString();
322 SL
[I
].GameMode
:= InMsg
.ReadByte();
323 SL
[I
].Players
:= InMsg
.ReadByte();
324 SL
[I
].MaxPlayers
:= InMsg
.ReadByte();
325 SL
[I
].Protocol
:= InMsg
.ReadByte();
326 SL
[I
].Password
:= InMsg
.ReadByte() = 1;
327 enet_address_set_host(Addr(SL
[I
].PingAddr
), PChar(Addr(SL
[I
].IP
[1])));
329 SL
[I
].PingAddr
.port
:= NET_PING_PORT
;
333 if InMsg
.ReadCount
< InMsg
.CurSize
then
335 // new master, supports version reports
336 Str
:= InMsg
.ReadString();
337 if (Str
<> MyVer
) then
340 g_Console_Add('!!! UpdVer = `' + Str
+ '`');
342 // even newer master, supports extra info
343 if InMsg
.ReadCount
< InMsg
.CurSize
then
345 slMOTD
:= b_Text_Format(InMsg
.ReadString());
346 Str
:= b_Text_Format(InMsg
.ReadString());
347 // check if the message has updated and the user has to read it again
348 if slUrgent
<> Str
then slReadUrgent
:= False;
358 g_Net_Slist_Disconnect
;
361 if Length(SL
) = 0 then
367 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
368 if Sock
= ENET_SOCKET_NULL
then Exit
;
369 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
371 for I
:= Low(SL
) to High(SL
) do
372 PingServer(SL
[I
], Sock
);
374 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
379 InMsg
.Alloc(NET_BUFSIZE
);
380 Buf
.data
:= InMsg
.Data
;
381 Buf
.dataLength
:= InMsg
.MaxSize
;
383 while GetTimerMS() - T
<= 500 do
387 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
388 if RX
<= 0 then continue
;
391 InMsg
.BeginReading();
393 if InMsg
.ReadChar() <> 'D' then continue
;
394 if InMsg
.ReadChar() <> 'F' then continue
;
397 for I
:= Low(SL
) to High(SL
) do
398 if (SL
[I
].PingAddr
.host
= SvAddr
.host
) and
399 (SL
[I
].PingAddr
.port
= SvAddr
.port
) then
403 Port
:= InMsg
.ReadWord();
404 Ping
:= InMsg
.ReadInt64();
405 Ping
:= GetTimerMS() - Ping
;
406 Name
:= InMsg
.ReadString();
407 Map
:= InMsg
.ReadString();
408 GameMode
:= InMsg
.ReadByte();
409 Players
:= InMsg
.ReadByte();
410 MaxPlayers
:= InMsg
.ReadByte();
411 Protocol
:= InMsg
.ReadByte();
412 Password
:= InMsg
.ReadByte() = 1;
413 LocalPl
:= InMsg
.ReadByte();
414 Bots
:= InMsg
.ReadWord();
425 enet_socket_destroy(Sock
);
428 procedure g_Net_Slist_WriteInfo();
433 Wad
:= g_ExtractWadNameNoPath(gMapInfo
.Map
);
434 Map
:= g_ExtractFileName(gMapInfo
.Map
);
436 NetOut
.Write(NetServerName
);
438 NetOut
.Write(Wad
+ ':\' + Map
);
439 NetOut
.Write(gGameSettings
.GameMode
);
441 Cli
:= NetClientCount
;
444 NetOut
.Write(NetMaxClients
);
446 NetOut
.Write(Byte(NET_PROTOCOL_VER
));
447 NetOut
.Write(Byte(NetPassword
<> ''));
451 procedure g_Net_Slist_Update (immediateSend
: Boolean=true);
455 if not ProcessPendingConnection() then
457 NetUpdatePending
:= g_Net_Slist_IsConnectionInProgress();
461 NetUpdatePending
:= false;
464 NetOut
.Write(Byte(NET_MMSG_UPD
));
465 NetOut
.Write(NetAddr
.port
);
467 g_Net_Slist_WriteInfo();
469 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
470 enet_peer_send(NetMPeer
, NET_MCHAN_UPD
, P
);
472 if (immediateSend
) then enet_host_flush(NetMHost
);
476 procedure g_Net_Slist_Remove
;
480 if not ProcessPendingConnection() then exit
;
483 NetOut
.Write(Byte(NET_MMSG_DEL
));
484 NetOut
.Write(NetAddr
.port
);
486 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
487 enet_peer_send(NetMPeer
, NET_MCHAN_MAIN
, P
);
489 enet_host_flush(NetMHost
);
493 function g_Net_Slist_Connect (blocking
: Boolean=True): Boolean;
499 if g_Net_Slist_IsConnectionActive
then
501 if not blocking
then exit
;
502 g_Net_Slist_Disconnect(false);
505 NetHostConnected
:= False; // just in case
506 NetHostConReqTime
:= 0; // just in case
507 NetUpdatePending
:= false;
509 NetMHost
:= enet_host_create(nil, 1, NET_MCHANS
, 0, 0);
510 if (NetMHost
= nil) then
512 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
516 NetMPeer
:= enet_host_connect(NetMHost
, @NetSlistAddr
, NET_MCHANS
, 0);
517 if (NetMPeer
= nil) then
519 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
520 enet_host_destroy(NetMHost
);
525 if (blocking
) then delay
:= 3000 else delay
:= 0;
526 if (enet_host_service(NetMHost
, @NetMEvent
, delay
) > 0) then
527 if NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
then
530 NetHostConnected
:= True;
531 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_CONN
]);
535 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
536 enet_packet_destroy(NetMEvent
.packet
);
540 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_SLIST_ERROR
], True);
542 if NetMPeer
<> nil then enet_peer_reset(NetMPeer
);
543 if NetMHost
<> nil then enet_host_destroy(NetMHost
);
546 NetHostConnected
:= False;
547 NetHostConReqTime
:= 0;
548 NetUpdatePending
:= false;
552 NetHostConReqTime
:= GetTimerMS();
553 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_WCONN
]);
557 procedure g_Net_Slist_Disconnect (spamConsole
: Boolean=true);
559 if (NetMHost
= nil) and (NetMPeer
= nil) then Exit
;
561 if (NetMode
= NET_SERVER
) and (NetHostConnected
) then g_Net_Slist_Remove
;
563 enet_peer_disconnect(NetMPeer
, 0);
564 enet_host_flush(NetMHost
);
566 enet_peer_reset(NetMPeer
);
567 enet_host_destroy(NetMHost
);
571 NetHostConnected
:= False;
572 NetHostConReqTime
:= 0;
573 NetUpdatePending
:= false;
575 if (spamConsole
) then g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_DISC
]);
578 procedure g_Net_Slist_Check
;
580 if not ProcessPendingConnection() then exit
;
582 if (NetUpdatePending
) then g_Net_Slist_Update(false);
584 while (enet_host_service(NetMHost
, @NetMEvent
, 0) > 0) do
586 if NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
then
588 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_LOST
], True);
589 if NetMPeer
<> nil then enet_peer_reset(NetMPeer
);
590 if NetMHost
<> nil then enet_host_destroy(NetMHost
);
593 NetHostConnected
:= False;
594 NetHostConReqTime
:= 0;
595 NetUpdatePending
:= false;
599 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
600 enet_packet_destroy(NetMEvent
.packet
);
604 procedure g_Net_Slist_Set(IP
: string; Port
: Word);
608 enet_address_set_host(@NetSlistAddr
, PChar(Addr(IP
[1])));
609 NetSlistAddr
.Port
:= Port
;
610 e_WriteLog('Masterserver address set to ' + IP
+ ':' + IntToStr(Port
), TMsgType
.Notify
);
614 function GetServerFromTable(Index
: Integer; SL
: TNetServerList
; ST
: TNetServerTable
): TNetServer
;
617 Result
.Protocol
:= 0;
623 Result
.MaxPlayers
:= 0;
627 Result
.GameMode
:= 0;
628 Result
.Password
:= false;
629 FillChar(Result
.PingAddr
, SizeOf(ENetAddress
), 0);
632 if (Index
< 0) or (Index
>= Length(ST
)) then
634 Result
:= SL
[ST
[Index
].Indices
[ST
[Index
].Current
]];
637 procedure g_Serverlist_Draw(var SL
: TNetServerList
; var ST
: TNetServerTable
);
640 sy
, i
, y
, mw
, mx
, l
, motdh
: Integer;
650 e_CharFont_GetSize(gMenuFont
, _lc
[I_NET_SLIST
], ww
, hh
);
651 e_CharFont_Print(gMenuFont
, (gScreenWidth
div 2) - (ww
div 2), 16, _lc
[I_NET_SLIST
]);
653 e_TextureFontGetSize(gStdFont
, cw
, ch
);
655 ip
:= _lc
[I_NET_SLIST_HELP
];
656 mw
:= (Length(ip
) * cw
) div 2;
658 motdh
:= gScreenHeight
- 49 - ch
* b_Text_LineCount(slMOTD
);
660 e_DrawFillQuad(16, 64, gScreenWidth
-16, motdh
, 64, 64, 64, 110);
661 e_DrawQuad(16, 64, gScreenWidth
-16, motdh
, 255, 127, 0);
663 e_TextureFontPrintEx(gScreenWidth
div 2 - mw
, gScreenHeight
-24, ip
, gStdFont
, 225, 225, 225, 1);
668 e_DrawFillQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 110);
669 e_DrawQuad(16, motdh
, gScreenWidth
-16, gScreenHeight
-44, 255, 127, 0);
670 e_TextureFontPrintFmt(20, motdh
+ 3, slMOTD
, gStdFont
, False, True);
674 if not slReadUrgent
and (slUrgent
<> '') then
676 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
677 e_DrawFillQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
678 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 64, 64, 64, 128);
679 e_DrawQuad(gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 60,
680 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 60, 255, 127, 0);
681 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 - 40,
682 gScreenWidth
div 2 + 256, gScreenHeight
div 2 - 40, 255, 127, 0);
683 l
:= Length(_lc
[I_NET_SLIST_URGENT
]) div 2;
684 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - 58,
685 _lc
[I_NET_SLIST_URGENT
], gStdFont
);
686 l
:= Length(slUrgent
) div 2;
687 e_TextureFontPrintFmt(gScreenWidth
div 2 - 253, gScreenHeight
div 2 - 38,
688 slUrgent
, gStdFont
, False, True);
689 l
:= Length(_lc
[I_NET_SLIST_URGENT_CONT
]) div 2;
690 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 + 41,
691 _lc
[I_NET_SLIST_URGENT_CONT
], gStdFont
);
692 e_DrawLine(1, gScreenWidth
div 2 - 256, gScreenHeight
div 2 + 40,
693 gScreenWidth
div 2 + 256, gScreenHeight
div 2 + 40, 255, 127, 0);
699 l
:= Length(slWaitStr
) div 2;
700 e_DrawFillQuad(17, 65, gScreenWidth
-17, motdh
-1, 64, 64, 64, 128);
701 e_DrawQuad(gScreenWidth
div 2 - 192, gScreenHeight
div 2 - 10,
702 gScreenWidth
div 2 + 192, gScreenHeight
div 2 + 11, 255, 127, 0);
703 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - ch
div 2,
704 slWaitStr
, gStdFont
);
709 if (slSelection
< Length(ST
)) then
712 sy
:= y
+ 42 * I
- 4;
713 Srv
:= GetServerFromTable(I
, SL
, ST
);
714 ip
:= _lc
[I_NET_ADDRESS
] + ' ' + Srv
.IP
+ ':' + IntToStr(Srv
.Port
);
716 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_YES
]
718 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_NO
];
720 if Length(ST
) > 0 then
723 mw
:= (gScreenWidth
- 188);
726 e_DrawFillQuad(16 + 1, sy
, gScreenWidth
- 16 - 1, sy
+ 40, 64, 64, 64, 0);
727 e_DrawLine(1, 16 + 1, sy
, gScreenWidth
- 16 - 1, sy
, 205, 205, 205);
728 e_DrawLine(1, 16 + 1, sy
+ 41, gScreenWidth
- 16 - 1, sy
+ 41, 255, 255, 255);
730 e_DrawLine(1, 16, 85, gScreenWidth
- 16, 85, 255, 127, 0);
731 e_DrawLine(1, 16, motdh
-20, gScreenWidth
-16, motdh
-20, 255, 127, 0);
733 e_DrawLine(1, mx
- 70, 64, mx
- 70, motdh
, 255, 127, 0);
734 e_DrawLine(1, mx
, 64, mx
, motdh
-20, 255, 127, 0);
735 e_DrawLine(1, mx
+ 52, 64, mx
+ 52, motdh
-20, 255, 127, 0);
736 e_DrawLine(1, mx
+ 104, 64, mx
+ 104, motdh
-20, 255, 127, 0);
738 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont
, 255, 127, 0, 1);
739 e_TextureFontPrintEx(mx
- 68, 68, 'PING', gStdFont
, 255, 127, 0, 1);
740 e_TextureFontPrintEx(mx
+ 2, 68, 'MODE', gStdFont
, 255, 127, 0, 1);
741 e_TextureFontPrintEx(mx
+ 54, 68, 'PLRS', gStdFont
, 255, 127, 0, 1);
742 e_TextureFontPrintEx(mx
+ 106, 68, 'VER', gStdFont
, 255, 127, 0, 1);
745 for I
:= 0 to High(ST
) do
747 Srv
:= GetServerFromTable(I
, SL
, ST
);
749 e_TextureFontPrintEx(18, y
, Srv
.Name
, gStdFont
, 255, 255, 255, 1);
750 e_TextureFontPrintEx(18, y
+ 16, Srv
.Map
, gStdFont
, 210, 210, 210, 1);
752 // Ping and similar count
753 if (Srv
.Ping
< 0) or (Srv
.Ping
> 999) then
754 e_TextureFontPrintEx(mx
- 68, y
, _lc
[I_NET_SLIST_NO_ACCESS
], gStdFont
, 255, 0, 0, 1)
757 e_TextureFontPrintEx(mx
- 68, y
, '<1' + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1)
759 e_TextureFontPrintEx(mx
- 68, y
, IntToStr(Srv
.Ping
) + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1);
761 if Length(ST
[I
].Indices
) > 1 then
762 e_TextureFontPrintEx(mx
- 68, y
+ 16, '< ' + IntToStr(Length(ST
[I
].Indices
)) + ' >', gStdFont
, 210, 210, 210, 1);
765 e_TextureFontPrintEx(mx
+ 2, y
, g_Game_ModeToText(Srv
.GameMode
), gStdFont
, 255, 255, 255, 1);
768 e_TextureFontPrintEx(mx
+ 54, y
, IntToStr(Srv
.Players
) + '/' + IntToStr(Srv
.MaxPlayers
), gStdFont
, 255, 255, 255, 1);
769 e_TextureFontPrintEx(mx
+ 54, y
+ 16, IntToStr(Srv
.LocalPl
) + '+' + IntToStr(Srv
.Bots
), gStdFont
, 210, 210, 210, 1);
772 e_TextureFontPrintEx(mx
+ 106, y
, IntToStr(Srv
.Protocol
), gStdFont
, 255, 255, 255, 1);
777 e_TextureFontPrintEx(20, motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
778 ip
:= IntToStr(Length(ST
)) + _lc
[I_NET_SLIST_SERVERS
];
779 e_TextureFontPrintEx(gScreenWidth
- 48 - (Length(ip
) + 1)*cw
,
780 motdh
-20+3, ip
, gStdFont
, 205, 205, 205, 1);
783 procedure g_Serverlist_GenerateTable(SL
: TNetServerList
; var ST
: TNetServerTable
);
787 function FindServerInTable(Name
: string): Integer;
794 for i
:= Low(ST
) to High(ST
) do
796 if Length(ST
[i
].Indices
) = 0 then
798 if SL
[ST
[i
].Indices
[0]].Name
= Name
then
805 function ComparePing(i1
, i2
: Integer): Boolean;
811 if (p1
< 0) then p1
:= 999;
812 if (p2
< 0) then p2
:= 999;
815 procedure SortIndices(var ind
: Array of Integer);
820 for I
:= High(ind
) downto Low(ind
) do
821 for J
:= Low(ind
) to High(ind
) - 1 do
822 if ComparePing(ind
[j
], ind
[j
+1]) then
829 procedure SortRows();
834 for I
:= High(ST
) downto Low(ST
) do
835 for J
:= Low(ST
) to High(ST
) - 1 do
836 if ComparePing(ST
[j
].Indices
[0], ST
[j
+1].Indices
[0]) then
847 for i
:= Low(SL
) to High(SL
) do
849 j
:= FindServerInTable(SL
[i
].Name
);
853 SetLength(ST
, j
+ 1);
855 SetLength(ST
[j
].Indices
, 1);
856 ST
[j
].Indices
[0] := i
;
860 SetLength(ST
[j
].Indices
, Length(ST
[j
].Indices
) + 1);
861 ST
[j
].Indices
[High(ST
[j
].Indices
)] := i
;
865 for i
:= Low(ST
) to High(ST
) do
866 SortIndices(ST
[i
].Indices
);
871 procedure g_Serverlist_Control(var SL
: TNetServerList
; var ST
: TNetServerTable
);
876 if gConsoleShow
or gChatShow
then
879 qm
:= sys_HandleInput(); // this updates kbd
881 if qm
or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) or
882 e_KeyPressed(JOY0_JUMP
) or e_KeyPressed(JOY1_JUMP
) or
883 e_KeyPressed(JOY2_JUMP
) or e_KeyPressed(JOY3_JUMP
) then
887 gState
:= STATE_MENU
;
888 g_GUI_ShowWindow('MainMenu');
889 g_GUI_ShowWindow('NetGameMenu');
890 g_GUI_ShowWindow('NetClientMenu');
891 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
895 // if there's a message on the screen,
896 if not slReadUrgent
and (slUrgent
<> '') then
898 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
899 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
900 slReadUrgent
:= True;
904 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(VK_JUMP
) or
905 e_KeyPressed(JOY0_ACTIVATE
) or e_KeyPressed(JOY1_ACTIVATE
) or e_KeyPressed(JOY2_ACTIVATE
) or e_KeyPressed(JOY3_ACTIVATE
) then
907 if not slFetched
then
909 slWaitStr
:= _lc
[I_NET_SLIST_WAIT
];
914 if g_Net_Slist_Fetch(SL
) then
917 slWaitStr
:= _lc
[I_NET_SLIST_NOSERVERS
];
921 slWaitStr
:= _lc
[I_NET_SLIST_ERROR
];
924 g_Serverlist_GenerateTable(SL
, ST
);
930 if SL
= nil then Exit
;
932 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) or
933 e_KeyPressed(JOY0_ATTACK
) or e_KeyPressed(JOY1_ATTACK
) or e_KeyPressed(JOY2_ATTACK
) or e_KeyPressed(JOY3_ATTACK
) then
935 if not slReturnPressed
then
937 Srv
:= GetServerFromTable(slSelection
, SL
, ST
);
941 PromptPort
:= Srv
.Port
;
942 gState
:= STATE_MENU
;
943 g_GUI_ShowWindow('ClientPasswordMenu');
946 slReturnPressed
:= True;
950 g_Game_StartClient(Srv
.IP
, Srv
.Port
, '');
953 slReturnPressed
:= True;
958 slReturnPressed
:= False;
960 if e_KeyPressed(IK_DOWN
) or e_KeyPressed(IK_KPDOWN
) or e_KeyPressed(VK_DOWN
) or
961 e_KeyPressed(JOY0_DOWN
) or e_KeyPressed(JOY1_DOWN
) or e_KeyPressed(JOY2_DOWN
) or e_KeyPressed(JOY3_DOWN
) then
963 if not slDirPressed
then
966 if slSelection
> High(ST
) then slSelection
:= 0;
967 slDirPressed
:= True;
971 if e_KeyPressed(IK_UP
) or e_KeyPressed(IK_KPUP
) or e_KeyPressed(VK_UP
) or
972 e_KeyPressed(JOY0_UP
) or e_KeyPressed(JOY1_UP
) or e_KeyPressed(JOY2_UP
) or e_KeyPressed(JOY3_UP
) then
974 if not slDirPressed
then
976 if slSelection
= 0 then slSelection
:= Length(ST
);
979 slDirPressed
:= True;
983 if e_KeyPressed(IK_RIGHT
) or e_KeyPressed(IK_KPRIGHT
) or e_KeyPressed(VK_RIGHT
) or
984 e_KeyPressed(JOY0_RIGHT
) or e_KeyPressed(JOY1_RIGHT
) or e_KeyPressed(JOY2_RIGHT
) or e_KeyPressed(JOY3_RIGHT
) then
986 if not slDirPressed
then
988 Inc(ST
[slSelection
].Current
);
989 if ST
[slSelection
].Current
> High(ST
[slSelection
].Indices
) then ST
[slSelection
].Current
:= 0;
990 slDirPressed
:= True;
994 if e_KeyPressed(IK_LEFT
) or e_KeyPressed(IK_KPLEFT
) or e_KeyPressed(VK_LEFT
) or
995 e_KeyPressed(JOY0_LEFT
) or e_KeyPressed(JOY1_LEFT
) or e_KeyPressed(JOY2_LEFT
) or e_KeyPressed(JOY3_LEFT
) then
997 if not slDirPressed
then
999 if ST
[slSelection
].Current
= 0 then ST
[slSelection
].Current
:= Length(ST
[slSelection
].Indices
);
1000 Dec(ST
[slSelection
].Current
);
1002 slDirPressed
:= True;
1006 if (not e_KeyPressed(IK_DOWN
)) and
1007 (not e_KeyPressed(IK_UP
)) and
1008 (not e_KeyPressed(IK_RIGHT
)) and
1009 (not e_KeyPressed(IK_LEFT
)) and
1010 (not e_KeyPressed(IK_KPDOWN
)) and
1011 (not e_KeyPressed(IK_KPUP
)) and
1012 (not e_KeyPressed(IK_KPRIGHT
)) and
1013 (not e_KeyPressed(IK_KPLEFT
)) and
1014 (not e_KeyPressed(VK_DOWN
)) and
1015 (not e_KeyPressed(VK_UP
)) and
1016 (not e_KeyPressed(VK_RIGHT
)) and
1017 (not e_KeyPressed(VK_LEFT
)) and
1018 (not e_KeyPressed(JOY0_UP
)) and (not e_KeyPressed(JOY1_UP
)) and (not e_KeyPressed(JOY2_UP
)) and (not e_KeyPressed(JOY3_UP
)) and
1019 (not e_KeyPressed(JOY0_DOWN
)) and (not e_KeyPressed(JOY1_DOWN
)) and (not e_KeyPressed(JOY2_DOWN
)) and (not e_KeyPressed(JOY3_DOWN
)) and
1020 (not e_KeyPressed(JOY0_LEFT
)) and (not e_KeyPressed(JOY1_LEFT
)) and (not e_KeyPressed(JOY2_LEFT
)) and (not e_KeyPressed(JOY3_LEFT
)) and
1021 (not e_KeyPressed(JOY0_RIGHT
)) and (not e_KeyPressed(JOY1_RIGHT
)) and (not e_KeyPressed(JOY2_RIGHT
)) and (not e_KeyPressed(JOY3_RIGHT
))
1023 slDirPressed
:= False;