25 Players
, MaxPlayers
, LocalPl
, Bots
: Byte;
29 PingAddr
: ENetAddress
;
31 pTNetServer
= ^TNetServer
;
33 TNetServerList
= array of TNetServer
;
34 pTNetServerList
= ^TNetServerList
;
37 NetMHost
: pENetHost
= nil;
38 NetMPeer
: pENetPeer
= nil;
40 slCurrent
: TNetServerList
= nil;
41 slWaitStr
: string = '';
42 slReturnPressed
: Boolean = True;
44 procedure g_Net_Slist_Set(IP
: string; Port
: Word);
45 function g_Net_Slist_Fetch(var SL
: TNetServerList
): Boolean;
46 procedure g_Net_Slist_Update();
47 procedure g_Net_Slist_Remove();
48 function g_Net_Slist_Connect(): Boolean;
49 procedure g_Net_Slist_Check();
50 procedure g_Net_Slist_Disconnect();
51 procedure g_Net_Slist_WriteInfo();
53 procedure g_Serverlist_Draw(var SL
: TNetServerList
);
54 procedure g_Serverlist_Control(var SL
: TNetServerList
);
59 SysUtils
, e_fixedbuffer
, e_input
, e_graphics
, e_log
, g_window
, g_net
, g_console
,
60 g_map
, g_game
, g_sound
, g_textures
, g_gui
, g_menu
, g_options
, g_language
, WADEDITOR
,
65 slSelection
: Byte = 0;
66 slFetched
: Boolean = False;
67 slDirPressed
: Boolean = False;
69 function GetTimerMS(): Int64;
71 Result
:= GetTimer() {div 1000};
74 procedure PingServer(var S
: TNetServer
; Sock
: ENetSocket
);
77 Ping
: array [0..9] of Byte;
80 ClTime
:= GetTimerMS();
82 Buf
.data
:= Addr(Ping
[0]);
83 Buf
.dataLength
:= 2+8;
87 Int64(Addr(Ping
[2])^) := ClTime
;
89 enet_socket_send(Sock
, Addr(S
.PingAddr
), @Buf
, 1);
92 function g_Net_Slist_Fetch(var SL
: TNetServerList
): Boolean;
106 if (NetMHost
<> nil) or (NetMPeer
<> nil) then
109 if not g_Net_Slist_Connect
then
112 e_WriteLog('Fetching serverlist...', MSG_NOTIFY
);
113 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_FETCH
]);
115 e_Buffer_Clear(@NetOut
);
116 e_Buffer_Write(@NetOut
, Byte(NET_MMSG_GET
));
118 P
:= enet_packet_create(Addr(NetOut
.Data
), NetOut
.Len
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
119 enet_peer_send(NetMPeer
, NET_MCHAN_MAIN
, P
);
120 enet_host_flush(NetMHost
);
122 while enet_host_service(NetMHost
, @NetMEvent
, 5000) > 0 do
124 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
127 MID
:= e_Raw_Read_Byte(NetMEvent
.packet
^.data
);
129 if MID
<> NET_MMSG_GET
then continue
;
131 Cnt
:= e_Raw_Read_Byte(NetMEvent
.packet
^.data
);
132 e_WriteLog('Retrieved ' + IntToStr(Cnt
) + ' server(s).', MSG_NOTIFY
);
133 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_SLIST_RETRIEVED
], [Cnt
]), True);
139 for I
:= 0 to Cnt
- 1 do
142 SL
[I
].IP
:= e_Raw_Read_String(NetMEvent
.packet
^.data
);
143 SL
[I
].Port
:= e_Raw_Read_Word(NetMEvent
.packet
^.data
);
144 SL
[I
].Name
:= e_Raw_Read_String(NetMEvent
.packet
^.data
);
145 SL
[I
].Map
:= e_Raw_Read_String(NetMEvent
.packet
^.data
);
146 SL
[I
].GameMode
:= e_Raw_Read_Byte(NetMEvent
.packet
^.data
);
147 SL
[I
].Players
:= e_Raw_Read_Byte(NetMEvent
.packet
^.data
);
148 SL
[I
].MaxPlayers
:= e_Raw_Read_Byte(NetMEvent
.packet
^.data
);
149 SL
[I
].Protocol
:= e_Raw_Read_Byte(NetMEvent
.packet
^.data
);
150 SL
[I
].Password
:= e_Raw_Read_Byte(NetMEvent
.packet
^.data
) = 1;
151 enet_address_set_host(Addr(SL
[I
].PingAddr
), PChar(Addr(SL
[I
].IP
[1])));
153 SL
[I
].PingAddr
.port
:= SL
[I
].Port
+ 1;
162 g_Net_Slist_Disconnect
;
163 e_Buffer_Clear(@NetOut
);
165 if Length(SL
) = 0 then Exit
;
167 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
168 if Sock
= ENET_SOCKET_NULL
then Exit
;
169 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
171 for I
:= Low(SL
) to High(SL
) do
172 PingServer(SL
[I
], Sock
);
176 e_Buffer_Clear(@NetIn
);
177 Buf
.data
:= Addr(NetIn
.Data
);
178 Buf
.dataLength
:= Length(NetIn
.Data
);
180 while Cnt
< Length(SL
) do
182 if GetTimerMS() - T
> 500 then break
;
184 e_Buffer_Clear(@NetIn
);
186 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
187 if RX
<= 0 then continue
;
191 if e_Buffer_Read_Char(@NetIn
) <> 'D' then continue
;
192 if e_Buffer_Read_Char(@NetIn
) <> 'F' then continue
;
194 for I
:= Low(SL
) to High(SL
) do
195 if (SL
[I
].PingAddr
.host
= SvAddr
.host
) and
196 (SL
[I
].PingAddr
.port
= SvAddr
.port
) then
200 Ping
:= e_Buffer_Read_Int64(@NetIn
);
201 Ping
:= GetTimerMS() - Ping
;
202 Name
:= e_Buffer_Read_String(@NetIn
);
203 Map
:= e_Buffer_Read_String(@NetIn
);
204 GameMode
:= e_Buffer_Read_Byte(@NetIn
);
205 Players
:= e_Buffer_Read_Byte(@NetIn
);
206 MaxPlayers
:= e_Buffer_Read_Byte(@NetIn
);
207 Protocol
:= e_Buffer_Read_Byte(@NetIn
);
208 Password
:= e_Buffer_Read_Byte(@NetIn
) = 1;
209 LocalPl
:= e_Buffer_Read_Byte(@NetIn
);
210 Bots
:= e_Buffer_Read_Word(@NetIn
);
217 enet_socket_destroy(Sock
);
220 procedure g_Net_Slist_WriteInfo();
225 g_ProcessResourceStr(gMapInfo
.Map
, @Wad
, nil, @Map
);
226 Wad
:= ExtractFileName(Wad
);
228 e_Buffer_Write(@NetOut
, NetServerName
);
230 e_Buffer_Write(@NetOut
, Wad
+ ':\' + Map
);
231 e_Buffer_Write(@NetOut
, gGameSettings
.GameMode
);
233 Cli
:= NetClientCount
;
234 e_Buffer_Write(@NetOut
, Cli
);
236 e_Buffer_Write(@NetOut
, NetMaxClients
);
238 e_Buffer_Write(@NetOut
, Byte(NET_PROTOCOL_VER
));
239 e_Buffer_Write(@NetOut
, Byte(NetPassword
<> ''));
242 procedure g_Net_Slist_Update
;
248 if (NetMHost
= nil) or (NetMPeer
= nil) then Exit
;
250 e_Buffer_Clear(@NetOut
);
251 e_Buffer_Write(@NetOut
, Byte(NET_MMSG_UPD
));
252 e_Buffer_Write(@NetOut
, NetAddr
.port
);
254 g_Net_Slist_WriteInfo();
256 P
:= enet_packet_create(Addr(NetOut
.Data
), NetOut
.Len
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
257 enet_peer_send(NetMPeer
, NET_MCHAN_UPD
, P
);
259 enet_host_flush(NetMHost
);
260 e_Buffer_Clear(@NetOut
);
263 procedure g_Net_Slist_Remove
;
267 if (NetMHost
= nil) or (NetMPeer
= nil) then Exit
;
268 e_Buffer_Clear(@NetOut
);
269 e_Buffer_Write(@NetOut
, Byte(NET_MMSG_DEL
));
270 e_Buffer_Write(@NetOut
, NetAddr
.port
);
272 P
:= enet_packet_create(Addr(NetOut
.Data
), NetOut
.Len
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
273 enet_peer_send(NetMPeer
, NET_MCHAN_MAIN
, P
);
275 enet_host_flush(NetMHost
);
276 e_Buffer_Clear(@NetOut
);
279 function g_Net_Slist_Connect
: Boolean;
283 NetMHost
:= enet_host_create(nil, 1, NET_MCHANS
, 0, 0);
284 if (NetMHost
= nil) then
286 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
290 NetMPeer
:= enet_host_connect(NetMHost
, @NetSlistAddr
, NET_MCHANS
, 0);
291 if (NetMPeer
= nil) then
293 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
294 enet_host_destroy(NetMHost
);
299 if (enet_host_service(NetMHost
, @NetMEvent
, 3000) > 0) then
300 if NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
then
303 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_CONN
]);
307 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
308 enet_packet_destroy(NetMEvent
.packet
);
310 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_SLIST_ERROR
], True);
316 procedure g_Net_Slist_Disconnect
;
318 if (NetMHost
= nil) and (NetMPeer
= nil) then Exit
;
320 if NetMode
= NET_SERVER
then g_Net_Slist_Remove
;
322 enet_peer_disconnect(NetMPeer
, 0);
323 enet_host_flush(NetMHost
);
325 enet_peer_reset(NetMPeer
);
326 enet_host_destroy(NetMHost
);
331 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_DISC
]);
334 procedure g_Net_Slist_Check
;
336 if (NetMHost
= nil) or (NetMPeer
= nil) then Exit
;
338 while (enet_host_service(NetMHost
, @NetMEvent
, 0) > 0) do
340 if NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
then
342 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_LOST
], True);
343 if NetMPeer
<> nil then enet_peer_reset(NetMPeer
);
344 if NetMHost
<> nil then enet_host_destroy(NetMHost
);
350 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
351 enet_packet_destroy(NetMEvent
.packet
);
355 procedure g_Net_Slist_Set(IP
: string; Port
: Word);
359 enet_address_set_host(@NetSlistAddr
, PChar(Addr(IP
[1])));
360 NetSlistAddr
.Port
:= Port
;
361 e_WriteLog('Masterserver address set to ' + IP
+ ':' + IntToStr(Port
), MSG_NOTIFY
);
365 procedure g_Serverlist_Draw(var SL
: TNetServerList
);
367 sy
, i
, y
, mw
, mx
, l
: Integer;
375 e_CharFont_GetSize(gMenuFont
, _lc
[I_NET_SLIST
], ww
, hh
);
376 e_CharFont_Print(gMenuFont
, (gScreenWidth
div 2) - (ww
div 2), 16, _lc
[I_NET_SLIST
]);
378 e_TextureFontGetSize(gStdFont
, cw
, ch
);
380 ip
:= _lc
[I_NET_SLIST_HELP
];
381 mw
:= (Length(ip
) * cw
) div 2;
383 e_DrawFillQuad(16, 64, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 110);
384 e_DrawQuad(16, 64, gScreenWidth
-16, gScreenHeight
-44, 255, 127, 0);
386 e_TextureFontPrintEx(gScreenWidth
div 2 - mw
, gScreenHeight
-24, ip
, gStdFont
, 225, 225, 225, 1);
390 l
:= Length(slWaitStr
) div 2;
391 e_DrawFillQuad(16, 64, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 128);
392 e_DrawQuad(gScreenWidth
div 2 - 192, gScreenHeight
div 2 - 10,
393 gScreenWidth
div 2 + 192, gScreenHeight
div 2 + 11, 255, 127, 0);
394 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - ch
div 2,
395 slWaitStr
, gStdFont
);
400 if (slSelection
< Length(SL
)) then
403 sy
:= y
+ 42 * I
- 4;
404 ip
:= _lc
[I_NET_ADDRESS
] + ' ' + SL
[I
].IP
+ ':' + IntToStr(SL
[I
].Port
);
405 if SL
[I
].Password
then
406 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_YES
]
408 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_NO
];
410 if Length(SL
) > 0 then
413 mw
:= (gScreenWidth
- 188);
416 e_DrawFillQuad(16 + 1, sy
, gScreenWidth
- 16 - 1, sy
+ 40, 64, 64, 64, 0);
417 e_DrawLine(1, 16 + 1, sy
, gScreenWidth
- 16 - 1, sy
, 205, 205, 205);
418 e_DrawLine(1, 16 + 1, sy
+ 41, gScreenWidth
- 16 - 1, sy
+ 41, 255, 255, 255);
420 e_DrawLine(1, 16, 85, gScreenWidth
- 16, 85, 255, 127, 0);
421 e_DrawLine(1, 16, gScreenHeight
-64, gScreenWidth
-16, gScreenHeight
-64, 255, 127, 0);
423 e_DrawLine(1, mx
- 70, 64, mx
- 70, gScreenHeight
-44, 255, 127, 0);
424 e_DrawLine(1, mx
, 64, mx
, gScreenHeight
-64, 255, 127, 0);
425 e_DrawLine(1, mx
+ 52, 64, mx
+ 52, gScreenHeight
-64, 255, 127, 0);
426 e_DrawLine(1, mx
+ 104, 64, mx
+ 104, gScreenHeight
-64, 255, 127, 0);
428 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont
, 255, 127, 0, 1);
431 for I
:= 0 to High(SL
) do
433 e_TextureFontPrintEx(18, y
, SL
[I
].Name
, gStdFont
, 255, 255, 255, 1);
434 e_TextureFontPrintEx(18, y
+ 16, SL
[I
].Map
, gStdFont
, 210, 210, 210, 1);
439 e_TextureFontPrintEx(mx
- 68, 68, 'PING', gStdFont
, 255, 127, 0, 1);
441 for I
:= 0 to High(SL
) do
443 if (SL
[I
].Ping
< 0) or (SL
[I
].Ping
> 999) then
444 e_TextureFontPrintEx(mx
- 68, y
, _lc
[I_NET_SLIST_NO_ACCESS
], gStdFont
, 255, 0, 0, 1)
446 if SL
[I
].Ping
= 0 then
447 e_TextureFontPrintEx(mx
- 68, y
, '<1' + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1)
449 e_TextureFontPrintEx(mx
- 68, y
, IntToStr(SL
[I
].Ping
) + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1);
454 e_TextureFontPrintEx(mx
+ 2, 68, 'MODE', gStdFont
, 255, 127, 0, 1);
456 for I
:= 0 to High(SL
) do
458 e_TextureFontPrintEx(mx
+ 2, y
, g_Game_ModeToText(SL
[I
].GameMode
), gStdFont
, 255, 255, 255, 1);
463 e_TextureFontPrintEx(mx
+ 54, 68, 'PLRS', gStdFont
, 255, 127, 0, 1);
465 for I
:= 0 to High(SL
) do
467 e_TextureFontPrintEx(mx
+ 54, y
, IntToStr(SL
[I
].Players
) + '/' + IntToStr(SL
[I
].MaxPlayers
), gStdFont
, 255, 255, 255, 1);
468 e_TextureFontPrintEx(mx
+ 54, y
+ 16, IntToStr(SL
[I
].LocalPl
) + '+' + IntToStr(SL
[I
].Bots
), gStdFont
, 210, 210, 210, 1);
472 e_TextureFontPrintEx(mx
+ 106, 68, 'VER', gStdFont
, 255, 127, 0, 1);
474 for I
:= 0 to High(SL
) do
476 e_TextureFontPrintEx(mx
+ 106, y
, IntToStr(SL
[I
].Protocol
), gStdFont
, 255, 255, 255, 1);
481 e_TextureFontPrintEx(20, gScreenHeight
-61, ip
, gStdFont
, 205, 205, 205, 1);
482 ip
:= IntToStr(Length(SL
)) + _lc
[I_NET_SLIST_SERVERS
];
483 e_TextureFontPrintEx(gScreenWidth
- 48 - (Length(ip
) + 1)*cw
,
484 gScreenHeight
-61, ip
, gStdFont
, 205, 205, 205, 1);
487 procedure g_Serverlist_Control(var SL
: TNetServerList
);
489 if gConsoleShow
or gChatShow
then
494 if e_KeyPressed(IK_ESCAPE
) then
497 gState
:= STATE_MENU
;
498 g_GUI_ShowWindow('MainMenu');
499 g_GUI_ShowWindow('NetGameMenu');
500 g_GUI_ShowWindow('NetClientMenu');
501 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
505 if e_KeyPressed(IK_SPACE
) then
507 if not slFetched
then
509 slWaitStr
:= _lc
[I_NET_SLIST_WAIT
];
512 g_window
.ReDrawWindow
;
514 if g_Net_Slist_Fetch(SL
) then
517 slWaitStr
:= _lc
[I_NET_SLIST_NOSERVERS
];
520 slWaitStr
:= _lc
[I_NET_SLIST_ERROR
];
528 if SL
= nil then Exit
;
530 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) then
532 if not slReturnPressed
then
534 if SL
[slSelection
].Password
then
536 PromptIP
:= SL
[slSelection
].IP
;
537 PromptPort
:= SL
[slSelection
].Port
;
538 gState
:= STATE_MENU
;
539 g_GUI_ShowWindow('ClientPasswordMenu');
541 slReturnPressed
:= True;
545 g_Game_StartClient(SL
[slSelection
].IP
, SL
[slSelection
].Port
, '');
547 slReturnPressed
:= True;
552 slReturnPressed
:= False;
554 if e_KeyPressed(IK_DOWN
) or e_KeyPressed(IK_KPDOWN
) then
556 if not slDirPressed
then
559 if slSelection
> High(SL
) then slSelection
:= 0;
560 slDirPressed
:= True;
564 if e_KeyPressed(IK_UP
) or e_KeyPressed(IK_KPUP
) then
566 if not slDirPressed
then
568 if slSelection
= 0 then slSelection
:= Length(SL
);
571 slDirPressed
:= True;
575 if (not e_KeyPressed(IK_DOWN
)) and (not e_KeyPressed(IK_UP
)) and (not e_KeyPressed(IK_KPDOWN
)) and (not e_KeyPressed(IK_KPUP
)) then
576 slDirPressed
:= False;