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, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
41 Players
, MaxPlayers
, LocalPl
, Bots
: Byte;
45 PingAddr
: ENetAddress
;
47 pTNetServer
= ^TNetServer
;
49 TNetServerList
= array of TNetServer
;
50 pTNetServerList
= ^TNetServerList
;
53 NetMHost
: pENetHost
= nil;
54 NetMPeer
: pENetPeer
= nil;
56 slCurrent
: TNetServerList
= nil;
57 slWaitStr
: string = '';
58 slReturnPressed
: Boolean = True;
60 procedure g_Net_Slist_Set(IP
: string; Port
: Word);
61 function g_Net_Slist_Fetch(var SL
: TNetServerList
): Boolean;
62 procedure g_Net_Slist_Update();
63 procedure g_Net_Slist_Remove();
64 function g_Net_Slist_Connect(): Boolean;
65 procedure g_Net_Slist_Check();
66 procedure g_Net_Slist_Disconnect();
67 procedure g_Net_Slist_WriteInfo();
69 procedure g_Serverlist_Draw(var SL
: TNetServerList
);
70 procedure g_Serverlist_Control(var SL
: TNetServerList
);
75 SysUtils
, e_msg
, e_input
, e_graphics
, e_log
, g_window
, g_net
, g_console
,
76 g_map
, g_game
, g_sound
, g_gui
, g_menu
, g_options
, g_language
, wadreader
;
80 slSelection
: Byte = 0;
81 slFetched
: Boolean = False;
82 slDirPressed
: Boolean = False;
84 function GetTimerMS(): Int64;
86 Result
:= GetTimer() {div 1000};
89 procedure PingServer(var S
: TNetServer
; Sock
: ENetSocket
);
92 Ping
: array [0..9] of Byte;
95 ClTime
:= GetTimerMS();
97 Buf
.data
:= Addr(Ping
[0]);
98 Buf
.dataLength
:= 2+8;
102 Int64(Addr(Ping
[2])^) := ClTime
;
104 enet_socket_send(Sock
, Addr(S
.PingAddr
), @Buf
, 1);
107 procedure PingBcast(Sock
: ENetSocket
);
111 S
.IP
:= '255.255.255.255';
112 S
.Port
:= NET_PING_PORT
;
113 enet_address_set_host(Addr(S
.PingAddr
), PChar(Addr(S
.IP
[1])));
115 S
.PingAddr
.port
:= S
.Port
;
119 function g_Net_Slist_Fetch(var SL
: TNetServerList
): Boolean;
132 procedure ProcessLocal();
134 IPBuf
: Array[0..19] of Byte;
137 SetLength(SL
, I
+ 1);
140 FillChar(IPBuf
, Length(IPBuf
), 0);
141 enet_address_get_host_ip(Addr(SvAddr
.host
), PChar(Addr(IPBuf
)), Length(IPBuf
));
142 IP
:= PChar(Addr(IPBuf
));
143 Port
:= InMsg
.ReadWord();
144 Ping
:= InMsg
.ReadInt64();
145 Ping
:= GetTimerMS() - Ping
;
146 Name
:= InMsg
.ReadString();
147 Map
:= InMsg
.ReadString();
148 GameMode
:= InMsg
.ReadByte();
149 Players
:= InMsg
.ReadByte();
150 MaxPlayers
:= InMsg
.ReadByte();
151 Protocol
:= InMsg
.ReadByte();
152 Password
:= InMsg
.ReadByte() = 1;
153 LocalPl
:= InMsg
.ReadByte();
154 Bots
:= InMsg
.ReadWord();
157 procedure CheckLocalServers();
161 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
162 if Sock
= ENET_SOCKET_NULL
then Exit
;
163 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
164 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
169 InMsg
.Alloc(NET_BUFSIZE
);
170 Buf
.data
:= InMsg
.Data
;
171 Buf
.dataLength
:= InMsg
.MaxSize
;
172 while GetTimerMS() - T
<= 500 do
176 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
177 if RX
<= 0 then continue
;
180 InMsg
.BeginReading();
182 if InMsg
.ReadChar() <> 'D' then continue
;
183 if InMsg
.ReadChar() <> 'F' then continue
;
189 enet_socket_destroy(Sock
);
191 if Length(SL
) = 0 then SL
:= nil;
197 if (NetMHost
<> nil) or (NetMPeer
<> nil) then
203 if not g_Net_Slist_Connect
then
209 e_WriteLog('Fetching serverlist...', TMsgType
.Notify
);
210 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_FETCH
]);
213 NetOut
.Write(Byte(NET_MMSG_GET
));
215 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
216 enet_peer_send(NetMPeer
, NET_MCHAN_MAIN
, P
);
217 enet_host_flush(NetMHost
);
219 while enet_host_service(NetMHost
, @NetMEvent
, 5000) > 0 do
221 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
223 if not InMsg
.Init(NetMEvent
.packet
^.data
, NetMEvent
.packet
^.dataLength
, True) then continue
;
225 MID
:= InMsg
.ReadByte();
227 if MID
<> NET_MMSG_GET
then continue
;
229 Cnt
:= InMsg
.ReadByte();
230 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_SLIST_RETRIEVED
], [Cnt
]), True);
236 for I
:= 0 to Cnt
- 1 do
239 SL
[I
].IP
:= InMsg
.ReadString();
240 SL
[I
].Port
:= InMsg
.ReadWord();
241 SL
[I
].Name
:= InMsg
.ReadString();
242 SL
[I
].Map
:= InMsg
.ReadString();
243 SL
[I
].GameMode
:= InMsg
.ReadByte();
244 SL
[I
].Players
:= InMsg
.ReadByte();
245 SL
[I
].MaxPlayers
:= InMsg
.ReadByte();
246 SL
[I
].Protocol
:= InMsg
.ReadByte();
247 SL
[I
].Password
:= InMsg
.ReadByte() = 1;
248 enet_address_set_host(Addr(SL
[I
].PingAddr
), PChar(Addr(SL
[I
].IP
[1])));
250 SL
[I
].PingAddr
.port
:= NET_PING_PORT
;
259 g_Net_Slist_Disconnect
;
262 if Length(SL
) = 0 then
268 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
269 if Sock
= ENET_SOCKET_NULL
then Exit
;
270 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
272 for I
:= Low(SL
) to High(SL
) do
273 PingServer(SL
[I
], Sock
);
275 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
280 InMsg
.Alloc(NET_BUFSIZE
);
281 Buf
.data
:= InMsg
.Data
;
282 Buf
.dataLength
:= InMsg
.MaxSize
;
284 while GetTimerMS() - T
<= 500 do
288 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
289 if RX
<= 0 then continue
;
292 InMsg
.BeginReading();
294 if InMsg
.ReadChar() <> 'D' then continue
;
295 if InMsg
.ReadChar() <> 'F' then continue
;
298 for I
:= Low(SL
) to High(SL
) do
299 if (SL
[I
].PingAddr
.host
= SvAddr
.host
) and
300 (SL
[I
].PingAddr
.port
= SvAddr
.port
) then
304 Port
:= InMsg
.ReadWord();
305 Ping
:= InMsg
.ReadInt64();
306 Ping
:= GetTimerMS() - Ping
;
307 Name
:= InMsg
.ReadString();
308 Map
:= InMsg
.ReadString();
309 GameMode
:= InMsg
.ReadByte();
310 Players
:= InMsg
.ReadByte();
311 MaxPlayers
:= InMsg
.ReadByte();
312 Protocol
:= InMsg
.ReadByte();
313 Password
:= InMsg
.ReadByte() = 1;
314 LocalPl
:= InMsg
.ReadByte();
315 Bots
:= InMsg
.ReadWord();
326 enet_socket_destroy(Sock
);
329 procedure g_Net_Slist_WriteInfo();
334 Wad
:= g_ExtractWadNameNoPath(gMapInfo
.Map
);
335 Map
:= g_ExtractFileName(gMapInfo
.Map
);
337 NetOut
.Write(NetServerName
);
339 NetOut
.Write(Wad
+ ':\' + Map
);
340 NetOut
.Write(gGameSettings
.GameMode
);
342 Cli
:= NetClientCount
;
345 NetOut
.Write(NetMaxClients
);
347 NetOut
.Write(Byte(NET_PROTOCOL_VER
));
348 NetOut
.Write(Byte(NetPassword
<> ''));
351 procedure g_Net_Slist_Update
;
357 if (NetMHost
= nil) or (NetMPeer
= nil) then Exit
;
360 NetOut
.Write(Byte(NET_MMSG_UPD
));
361 NetOut
.Write(NetAddr
.port
);
363 g_Net_Slist_WriteInfo();
365 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
366 enet_peer_send(NetMPeer
, NET_MCHAN_UPD
, P
);
368 enet_host_flush(NetMHost
);
372 procedure g_Net_Slist_Remove
;
376 if (NetMHost
= nil) or (NetMPeer
= nil) then Exit
;
378 NetOut
.Write(Byte(NET_MMSG_DEL
));
379 NetOut
.Write(NetAddr
.port
);
381 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
382 enet_peer_send(NetMPeer
, NET_MCHAN_MAIN
, P
);
384 enet_host_flush(NetMHost
);
388 function g_Net_Slist_Connect
: Boolean;
392 NetMHost
:= enet_host_create(nil, 1, NET_MCHANS
, 0, 0);
393 if (NetMHost
= nil) then
395 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
399 NetMPeer
:= enet_host_connect(NetMHost
, @NetSlistAddr
, NET_MCHANS
, 0);
400 if (NetMPeer
= nil) then
402 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
403 enet_host_destroy(NetMHost
);
408 if (enet_host_service(NetMHost
, @NetMEvent
, 3000) > 0) then
409 if NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
then
412 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_CONN
]);
416 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
417 enet_packet_destroy(NetMEvent
.packet
);
419 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_SLIST_ERROR
], True);
425 procedure g_Net_Slist_Disconnect
;
427 if (NetMHost
= nil) and (NetMPeer
= nil) then Exit
;
429 if NetMode
= NET_SERVER
then g_Net_Slist_Remove
;
431 enet_peer_disconnect(NetMPeer
, 0);
432 enet_host_flush(NetMHost
);
434 enet_peer_reset(NetMPeer
);
435 enet_host_destroy(NetMHost
);
440 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_DISC
]);
443 procedure g_Net_Slist_Check
;
445 if (NetMHost
= nil) or (NetMPeer
= nil) then Exit
;
447 while (enet_host_service(NetMHost
, @NetMEvent
, 0) > 0) do
449 if NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
then
451 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_LOST
], True);
452 if NetMPeer
<> nil then enet_peer_reset(NetMPeer
);
453 if NetMHost
<> nil then enet_host_destroy(NetMHost
);
459 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
460 enet_packet_destroy(NetMEvent
.packet
);
464 procedure g_Net_Slist_Set(IP
: string; Port
: Word);
468 enet_address_set_host(@NetSlistAddr
, PChar(Addr(IP
[1])));
469 NetSlistAddr
.Port
:= Port
;
470 e_WriteLog('Masterserver address set to ' + IP
+ ':' + IntToStr(Port
), TMsgType
.Notify
);
474 procedure g_Serverlist_Draw(var SL
: TNetServerList
);
476 sy
, i
, y
, mw
, mx
, l
: Integer;
486 e_CharFont_GetSize(gMenuFont
, _lc
[I_NET_SLIST
], ww
, hh
);
487 e_CharFont_Print(gMenuFont
, (gScreenWidth
div 2) - (ww
div 2), 16, _lc
[I_NET_SLIST
]);
489 e_TextureFontGetSize(gStdFont
, cw
, ch
);
491 ip
:= _lc
[I_NET_SLIST_HELP
];
492 mw
:= (Length(ip
) * cw
) div 2;
494 e_DrawFillQuad(16, 64, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 110);
495 e_DrawQuad(16, 64, gScreenWidth
-16, gScreenHeight
-44, 255, 127, 0);
497 e_TextureFontPrintEx(gScreenWidth
div 2 - mw
, gScreenHeight
-24, ip
, gStdFont
, 225, 225, 225, 1);
501 l
:= Length(slWaitStr
) div 2;
502 e_DrawFillQuad(16, 64, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 128);
503 e_DrawQuad(gScreenWidth
div 2 - 192, gScreenHeight
div 2 - 10,
504 gScreenWidth
div 2 + 192, gScreenHeight
div 2 + 11, 255, 127, 0);
505 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - ch
div 2,
506 slWaitStr
, gStdFont
);
511 if (slSelection
< Length(SL
)) then
514 sy
:= y
+ 42 * I
- 4;
515 ip
:= _lc
[I_NET_ADDRESS
] + ' ' + SL
[I
].IP
+ ':' + IntToStr(SL
[I
].Port
);
516 if SL
[I
].Password
then
517 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_YES
]
519 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_NO
];
521 if Length(SL
) > 0 then
524 mw
:= (gScreenWidth
- 188);
527 e_DrawFillQuad(16 + 1, sy
, gScreenWidth
- 16 - 1, sy
+ 40, 64, 64, 64, 0);
528 e_DrawLine(1, 16 + 1, sy
, gScreenWidth
- 16 - 1, sy
, 205, 205, 205);
529 e_DrawLine(1, 16 + 1, sy
+ 41, gScreenWidth
- 16 - 1, sy
+ 41, 255, 255, 255);
531 e_DrawLine(1, 16, 85, gScreenWidth
- 16, 85, 255, 127, 0);
532 e_DrawLine(1, 16, gScreenHeight
-64, gScreenWidth
-16, gScreenHeight
-64, 255, 127, 0);
534 e_DrawLine(1, mx
- 70, 64, mx
- 70, gScreenHeight
-44, 255, 127, 0);
535 e_DrawLine(1, mx
, 64, mx
, gScreenHeight
-64, 255, 127, 0);
536 e_DrawLine(1, mx
+ 52, 64, mx
+ 52, gScreenHeight
-64, 255, 127, 0);
537 e_DrawLine(1, mx
+ 104, 64, mx
+ 104, gScreenHeight
-64, 255, 127, 0);
539 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont
, 255, 127, 0, 1);
542 for I
:= 0 to High(SL
) do
544 e_TextureFontPrintEx(18, y
, SL
[I
].Name
, gStdFont
, 255, 255, 255, 1);
545 e_TextureFontPrintEx(18, y
+ 16, SL
[I
].Map
, gStdFont
, 210, 210, 210, 1);
550 e_TextureFontPrintEx(mx
- 68, 68, 'PING', gStdFont
, 255, 127, 0, 1);
552 for I
:= 0 to High(SL
) do
554 if (SL
[I
].Ping
< 0) or (SL
[I
].Ping
> 999) then
555 e_TextureFontPrintEx(mx
- 68, y
, _lc
[I_NET_SLIST_NO_ACCESS
], gStdFont
, 255, 0, 0, 1)
557 if SL
[I
].Ping
= 0 then
558 e_TextureFontPrintEx(mx
- 68, y
, '<1' + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1)
560 e_TextureFontPrintEx(mx
- 68, y
, IntToStr(SL
[I
].Ping
) + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1);
565 e_TextureFontPrintEx(mx
+ 2, 68, 'MODE', gStdFont
, 255, 127, 0, 1);
567 for I
:= 0 to High(SL
) do
569 e_TextureFontPrintEx(mx
+ 2, y
, g_Game_ModeToText(SL
[I
].GameMode
), gStdFont
, 255, 255, 255, 1);
574 e_TextureFontPrintEx(mx
+ 54, 68, 'PLRS', gStdFont
, 255, 127, 0, 1);
576 for I
:= 0 to High(SL
) do
578 e_TextureFontPrintEx(mx
+ 54, y
, IntToStr(SL
[I
].Players
) + '/' + IntToStr(SL
[I
].MaxPlayers
), gStdFont
, 255, 255, 255, 1);
579 e_TextureFontPrintEx(mx
+ 54, y
+ 16, IntToStr(SL
[I
].LocalPl
) + '+' + IntToStr(SL
[I
].Bots
), gStdFont
, 210, 210, 210, 1);
583 e_TextureFontPrintEx(mx
+ 106, 68, 'VER', gStdFont
, 255, 127, 0, 1);
585 for I
:= 0 to High(SL
) do
587 e_TextureFontPrintEx(mx
+ 106, y
, IntToStr(SL
[I
].Protocol
), gStdFont
, 255, 255, 255, 1);
592 e_TextureFontPrintEx(20, gScreenHeight
-61, ip
, gStdFont
, 205, 205, 205, 1);
593 ip
:= IntToStr(Length(SL
)) + _lc
[I_NET_SLIST_SERVERS
];
594 e_TextureFontPrintEx(gScreenWidth
- 48 - (Length(ip
) + 1)*cw
,
595 gScreenHeight
-61, ip
, gStdFont
, 205, 205, 205, 1);
598 procedure g_Serverlist_Control(var SL
: TNetServerList
);
602 if gConsoleShow
or gChatShow
then
605 qm
:= g_ProcessMessages(); // this updates kbd
607 if qm
or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) then
610 gState
:= STATE_MENU
;
611 g_GUI_ShowWindow('MainMenu');
612 g_GUI_ShowWindow('NetGameMenu');
613 g_GUI_ShowWindow('NetClientMenu');
614 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
618 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(VK_JUMP
) then
620 if not slFetched
then
622 slWaitStr
:= _lc
[I_NET_SLIST_WAIT
];
625 g_window
.ReDrawWindow
;
627 if g_Net_Slist_Fetch(SL
) then
630 slWaitStr
:= _lc
[I_NET_SLIST_NOSERVERS
];
634 slWaitStr
:= _lc
[I_NET_SLIST_ERROR
];
642 if SL
= nil then Exit
;
644 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) then
646 if not slReturnPressed
then
648 if SL
[slSelection
].Password
then
650 PromptIP
:= SL
[slSelection
].IP
;
651 PromptPort
:= SL
[slSelection
].Port
;
652 gState
:= STATE_MENU
;
653 g_GUI_ShowWindow('ClientPasswordMenu');
655 slReturnPressed
:= True;
659 g_Game_StartClient(SL
[slSelection
].IP
, SL
[slSelection
].Port
, '');
661 slReturnPressed
:= True;
666 slReturnPressed
:= False;
668 if e_KeyPressed(IK_DOWN
) or e_KeyPressed(IK_KPDOWN
) or e_KeyPressed(VK_DOWN
) then
670 if not slDirPressed
then
673 if slSelection
> High(SL
) then slSelection
:= 0;
674 slDirPressed
:= True;
678 if e_KeyPressed(IK_UP
) or e_KeyPressed(IK_KPUP
) or e_KeyPressed(VK_UP
) then
680 if not slDirPressed
then
682 if slSelection
= 0 then slSelection
:= Length(SL
);
685 slDirPressed
:= True;
689 if (not e_KeyPressed(IK_DOWN
)) and (not e_KeyPressed(IK_UP
)) and (not e_KeyPressed(IK_KPDOWN
)) and (not e_KeyPressed(IK_KPUP
)) and (not e_KeyPressed(VK_DOWN
)) and (not e_KeyPressed(VK_UP
)) then
690 slDirPressed
:= False;