DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


1f7ddf1e787877483b48dce108eaa7ddd01de0bc
[d2df-sdl.git] / src / game / g_netmaster.pas
1 (* Copyright (C) DooM 2D:Forever Developers
2 *
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.
7 *
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.
12 *
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/>.
15 *)
16 {$MODE DELPHI}
17 unit g_netmaster;
18
19 interface
20
21 uses ENet;
22
23 const
24 NET_MCHANS = 2;
25
26 NET_MCHAN_MAIN = 0;
27 NET_MCHAN_UPD = 1;
28
29 NET_MMSG_UPD = 200;
30 NET_MMSG_DEL = 201;
31 NET_MMSG_GET = 202;
32
33 type
34 TNetServer = record
35 Number: Byte;
36 Protocol: Byte;
37 Name: string;
38 IP: string;
39 Port: Word;
40 Map: string;
41 Players, MaxPlayers, LocalPl, Bots: Byte;
42 Ping: Int64;
43 GameMode: Byte;
44 Password: Boolean;
45 PingAddr: ENetAddress;
46 end;
47 pTNetServer = ^TNetServer;
48
49 TNetServerList = array of TNetServer;
50 pTNetServerList = ^TNetServerList;
51
52 var
53 NetMHost: pENetHost = nil;
54 NetMPeer: pENetPeer = nil;
55
56 slCurrent: TNetServerList = nil;
57 slWaitStr: string = '';
58 slReturnPressed: Boolean = True;
59
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();
68
69 procedure g_Serverlist_Draw(var SL: TNetServerList);
70 procedure g_Serverlist_Control(var SL: TNetServerList);
71
72 implementation
73
74 uses
75 SysUtils, e_fixedbuffer, e_input, e_graphics, e_log, g_window, g_net, g_console,
76 g_map, g_game, g_sound, g_textures, g_gui, g_menu, g_options, g_language, wadreader,
77 ENetPlatform;
78
79 var
80 NetMEvent: ENetEvent;
81 slSelection: Byte = 0;
82 slFetched: Boolean = False;
83 slDirPressed: Boolean = False;
84
85 function GetTimerMS(): Int64;
86 begin
87 Result := GetTimer() {div 1000};
88 end;
89
90 procedure PingServer(var S: TNetServer; Sock: ENetSocket);
91 var
92 Buf: ENetBuffer;
93 Ping: array [0..9] of Byte;
94 ClTime: Int64;
95 begin
96 ClTime := GetTimerMS();
97
98 Buf.data := Addr(Ping[0]);
99 Buf.dataLength := 2+8;
100
101 Ping[0] := Ord('D');
102 Ping[1] := Ord('F');
103 Int64(Addr(Ping[2])^) := ClTime;
104
105 enet_socket_send(Sock, Addr(S.PingAddr), @Buf, 1);
106 end;
107
108 function g_Net_Slist_Fetch(var SL: TNetServerList): Boolean;
109 var
110 Cnt: Byte;
111 P: pENetPacket;
112 MID: Byte;
113 I, RX: Integer;
114 T: Int64;
115 Sock: ENetSocket;
116 Buf: ENetBuffer;
117 SvAddr: ENetAddress;
118 begin
119 Result := False;
120 SL := nil;
121
122 if (NetMHost <> nil) or (NetMPeer <> nil) then
123 Exit;
124
125 if not g_Net_Slist_Connect then
126 Exit;
127
128 e_WriteLog('Fetching serverlist...', MSG_NOTIFY);
129 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_FETCH]);
130
131 e_Buffer_Clear(@NetOut);
132 e_Buffer_Write(@NetOut, Byte(NET_MMSG_GET));
133
134 P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, Cardinal(ENET_PACKET_FLAG_RELIABLE));
135 enet_peer_send(NetMPeer, NET_MCHAN_MAIN, P);
136 enet_host_flush(NetMHost);
137
138 while enet_host_service(NetMHost, @NetMEvent, 5000) > 0 do
139 begin
140 if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
141 begin
142 e_Raw_Seek(0);
143 MID := e_Raw_Read_Byte(NetMEvent.packet^.data);
144
145 if MID <> NET_MMSG_GET then continue;
146
147 Cnt := e_Raw_Read_Byte(NetMEvent.packet^.data);
148 e_WriteLog('Retrieved ' + IntToStr(Cnt) + ' server(s).', MSG_NOTIFY);
149 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_SLIST_RETRIEVED], [Cnt]), True);
150 //writeln('BOO!');
151
152 if Cnt > 0 then
153 begin
154 SetLength(SL, Cnt);
155
156 for I := 0 to Cnt - 1 do
157 begin
158 SL[I].Number := I;
159 SL[I].IP := e_Raw_Read_String(NetMEvent.packet^.data);
160 SL[I].Port := e_Raw_Read_Word(NetMEvent.packet^.data);
161 SL[I].Name := e_Raw_Read_String(NetMEvent.packet^.data);
162 SL[I].Map := e_Raw_Read_String(NetMEvent.packet^.data);
163 SL[I].GameMode := e_Raw_Read_Byte(NetMEvent.packet^.data);
164 SL[I].Players := e_Raw_Read_Byte(NetMEvent.packet^.data);
165 SL[I].MaxPlayers := e_Raw_Read_Byte(NetMEvent.packet^.data);
166 SL[I].Protocol := e_Raw_Read_Byte(NetMEvent.packet^.data);
167 SL[I].Password := e_Raw_Read_Byte(NetMEvent.packet^.data) = 1;
168 enet_address_set_host(Addr(SL[I].PingAddr), PChar(Addr(SL[I].IP[1])));
169 SL[I].Ping := -1;
170 SL[I].PingAddr.port := SL[I].Port + 1;
171 end;
172 end;
173
174 Result := True;
175 break;
176 end;
177 end;
178
179 g_Net_Slist_Disconnect;
180 e_Buffer_Clear(@NetOut);
181
182 if Length(SL) = 0 then Exit;
183
184 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
185 if Sock = ENET_SOCKET_NULL then Exit;
186 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
187
188 for I := Low(SL) to High(SL) do
189 PingServer(SL[I], Sock);
190
191 T := GetTimerMS();
192
193 e_Buffer_Clear(@NetIn);
194 Buf.data := Addr(NetIn.Data);
195 Buf.dataLength := Length(NetIn.Data);
196 Cnt := 0;
197 while Cnt < Length(SL) do
198 begin
199 if GetTimerMS() - T > 500 then break;
200
201 e_Buffer_Clear(@NetIn);
202
203 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
204 if RX <= 0 then continue;
205 NetIn.Len := RX + 1;
206 NetIn.ReadPos := 0;
207
208 if e_Buffer_Read_Char(@NetIn) <> 'D' then continue;
209 if e_Buffer_Read_Char(@NetIn) <> 'F' then continue;
210
211 for I := Low(SL) to High(SL) do
212 if (SL[I].PingAddr.host = SvAddr.host) and
213 (SL[I].PingAddr.port = SvAddr.port) then
214 begin
215 with SL[I] do
216 begin
217 Ping := e_Buffer_Read_Int64(@NetIn);
218 Ping := GetTimerMS() - Ping;
219 Name := e_Buffer_Read_String(@NetIn);
220 Map := e_Buffer_Read_String(@NetIn);
221 GameMode := e_Buffer_Read_Byte(@NetIn);
222 Players := e_Buffer_Read_Byte(@NetIn);
223 MaxPlayers := e_Buffer_Read_Byte(@NetIn);
224 Protocol := e_Buffer_Read_Byte(@NetIn);
225 Password := e_Buffer_Read_Byte(@NetIn) = 1;
226 LocalPl := e_Buffer_Read_Byte(@NetIn);
227 Bots := e_Buffer_Read_Word(@NetIn);
228 end;
229 Inc(Cnt);
230 break;
231 end;
232 end;
233
234 enet_socket_destroy(Sock);
235 end;
236
237 procedure g_Net_Slist_WriteInfo();
238 var
239 Wad, Map: string;
240 Cli: Byte;
241 begin
242 Wad := g_ExtractWadNameNoPath(gMapInfo.Map);
243 Map := g_ExtractFileName(gMapInfo.Map);
244
245 e_Buffer_Write(@NetOut, NetServerName);
246
247 e_Buffer_Write(@NetOut, Wad + ':\' + Map);
248 e_Buffer_Write(@NetOut, gGameSettings.GameMode);
249
250 Cli := NetClientCount;
251 e_Buffer_Write(@NetOut, Cli);
252
253 e_Buffer_Write(@NetOut, NetMaxClients);
254
255 e_Buffer_Write(@NetOut, Byte(NET_PROTOCOL_VER));
256 e_Buffer_Write(@NetOut, Byte(NetPassword <> ''));
257 end;
258
259 procedure g_Net_Slist_Update;
260 var
261
262 P: pENetPacket;
263
264 begin
265 if (NetMHost = nil) or (NetMPeer = nil) then Exit;
266
267 e_Buffer_Clear(@NetOut);
268 e_Buffer_Write(@NetOut, Byte(NET_MMSG_UPD));
269 e_Buffer_Write(@NetOut, NetAddr.port);
270
271 g_Net_Slist_WriteInfo();
272
273 P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, Cardinal(ENET_PACKET_FLAG_RELIABLE));
274 enet_peer_send(NetMPeer, NET_MCHAN_UPD, P);
275
276 enet_host_flush(NetMHost);
277 e_Buffer_Clear(@NetOut);
278 end;
279
280 procedure g_Net_Slist_Remove;
281 var
282 P: pENetPacket;
283 begin
284 if (NetMHost = nil) or (NetMPeer = nil) then Exit;
285 e_Buffer_Clear(@NetOut);
286 e_Buffer_Write(@NetOut, Byte(NET_MMSG_DEL));
287 e_Buffer_Write(@NetOut, NetAddr.port);
288
289 P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, Cardinal(ENET_PACKET_FLAG_RELIABLE));
290 enet_peer_send(NetMPeer, NET_MCHAN_MAIN, P);
291
292 enet_host_flush(NetMHost);
293 e_Buffer_Clear(@NetOut);
294 end;
295
296 function g_Net_Slist_Connect: Boolean;
297 begin
298 Result := False;
299
300 NetMHost := enet_host_create(nil, 1, NET_MCHANS, 0, 0);
301 if (NetMHost = nil) then
302 begin
303 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
304 Exit;
305 end;
306
307 NetMPeer := enet_host_connect(NetMHost, @NetSlistAddr, NET_MCHANS, 0);
308 if (NetMPeer = nil) then
309 begin
310 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
311 enet_host_destroy(NetMHost);
312 NetMHost := nil;
313 Exit;
314 end;
315
316 if (enet_host_service(NetMHost, @NetMEvent, 3000) > 0) then
317 if NetMEvent.kind = ENET_EVENT_TYPE_CONNECT then
318 begin
319 Result := True;
320 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_CONN]);
321 Exit;
322 end
323 else
324 if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
325 enet_packet_destroy(NetMEvent.packet);
326
327 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
328
329 NetMHost := nil;
330 NetMPeer := nil;
331 end;
332
333 procedure g_Net_Slist_Disconnect;
334 begin
335 if (NetMHost = nil) and (NetMPeer = nil) then Exit;
336
337 if NetMode = NET_SERVER then g_Net_Slist_Remove;
338
339 enet_peer_disconnect(NetMPeer, 0);
340 enet_host_flush(NetMHost);
341
342 enet_peer_reset(NetMPeer);
343 enet_host_destroy(NetMHost);
344
345 NetMPeer := nil;
346 NetMHost := nil;
347
348 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
349 end;
350
351 procedure g_Net_Slist_Check;
352 begin
353 if (NetMHost = nil) or (NetMPeer = nil) then Exit;
354
355 while (enet_host_service(NetMHost, @NetMEvent, 0) > 0) do
356 begin
357 if NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT then
358 begin
359 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_LOST], True);
360 if NetMPeer <> nil then enet_peer_reset(NetMPeer);
361 if NetMHost <> nil then enet_host_destroy(NetMHost);
362 NetMPeer := nil;
363 NetMHost := nil;
364 Break;
365 end
366 else
367 if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
368 enet_packet_destroy(NetMEvent.packet);
369 end;
370 end;
371
372 procedure g_Net_Slist_Set(IP: string; Port: Word);
373 begin
374 if NetInitDone then
375 begin
376 enet_address_set_host(@NetSlistAddr, PChar(Addr(IP[1])));
377 NetSlistAddr.Port := Port;
378 e_WriteLog('Masterserver address set to ' + IP + ':' + IntToStr(Port), MSG_NOTIFY);
379 end;
380 end;
381
382 procedure g_Serverlist_Draw(var SL: TNetServerList);
383 var
384 sy, i, y, mw, mx, l: Integer;
385 cw, ch: Byte;
386 ww, hh: Word;
387 ip: string;
388 begin
389 ip := '';
390 sy := 0;
391
392 e_CharFont_GetSize(gMenuFont, _lc[I_NET_SLIST], ww, hh);
393 e_CharFont_Print(gMenuFont, (gScreenWidth div 2) - (ww div 2), 16, _lc[I_NET_SLIST]);
394
395 e_TextureFontGetSize(gStdFont, cw, ch);
396
397 ip := _lc[I_NET_SLIST_HELP];
398 mw := (Length(ip) * cw) div 2;
399
400 e_DrawFillQuad(16, 64, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
401 e_DrawQuad(16, 64, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
402
403 e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
404
405 if SL = nil then
406 begin
407 l := Length(slWaitStr) div 2;
408 e_DrawFillQuad(16, 64, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 128);
409 e_DrawQuad(gScreenWidth div 2 - 192, gScreenHeight div 2 - 10,
410 gScreenWidth div 2 + 192, gScreenHeight div 2 + 11, 255, 127, 0);
411 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - ch div 2,
412 slWaitStr, gStdFont);
413 Exit;
414 end;
415
416 y := 90;
417 if (slSelection < Length(SL)) then
418 begin
419 I := slSelection;
420 sy := y + 42 * I - 4;
421 ip := _lc[I_NET_ADDRESS] + ' ' + SL[I].IP + ':' + IntToStr(SL[I].Port);
422 if SL[I].Password then
423 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_YES]
424 else
425 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_NO];
426 end else
427 if Length(SL) > 0 then
428 slSelection := 0;
429
430 mw := (gScreenWidth - 188);
431 mx := 16 + mw;
432
433 e_DrawFillQuad(16 + 1, sy, gScreenWidth - 16 - 1, sy + 40, 64, 64, 64, 0);
434 e_DrawLine(1, 16 + 1, sy, gScreenWidth - 16 - 1, sy, 205, 205, 205);
435 e_DrawLine(1, 16 + 1, sy + 41, gScreenWidth - 16 - 1, sy + 41, 255, 255, 255);
436
437 e_DrawLine(1, 16, 85, gScreenWidth - 16, 85, 255, 127, 0);
438 e_DrawLine(1, 16, gScreenHeight-64, gScreenWidth-16, gScreenHeight-64, 255, 127, 0);
439
440 e_DrawLine(1, mx - 70, 64, mx - 70, gScreenHeight-44, 255, 127, 0);
441 e_DrawLine(1, mx, 64, mx, gScreenHeight-64, 255, 127, 0);
442 e_DrawLine(1, mx + 52, 64, mx + 52, gScreenHeight-64, 255, 127, 0);
443 e_DrawLine(1, mx + 104, 64, mx + 104, gScreenHeight-64, 255, 127, 0);
444
445 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
446
447 y := 90;
448 for I := 0 to High(SL) do
449 begin
450 e_TextureFontPrintEx(18, y, SL[I].Name, gStdFont, 255, 255, 255, 1);
451 e_TextureFontPrintEx(18, y + 16, SL[I].Map, gStdFont, 210, 210, 210, 1);
452
453 y := y + 42;
454 end;
455
456 e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
457 y := 90;
458 for I := 0 to High(SL) do
459 begin
460 if (SL[I].Ping < 0) or (SL[I].Ping > 999) then
461 e_TextureFontPrintEx(mx - 68, y, _lc[I_NET_SLIST_NO_ACCESS], gStdFont, 255, 0, 0, 1)
462 else
463 if SL[I].Ping = 0 then
464 e_TextureFontPrintEx(mx - 68, y, '<1' + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1)
465 else
466 e_TextureFontPrintEx(mx - 68, y, IntToStr(SL[I].Ping) + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1);
467
468 y := y + 42;
469 end;
470
471 e_TextureFontPrintEx(mx + 2, 68, 'MODE', gStdFont, 255, 127, 0, 1);
472 y := 90;
473 for I := 0 to High(SL) do
474 begin
475 e_TextureFontPrintEx(mx + 2, y, g_Game_ModeToText(SL[I].GameMode), gStdFont, 255, 255, 255, 1);
476
477 y := y + 42;
478 end;
479
480 e_TextureFontPrintEx(mx + 54, 68, 'PLRS', gStdFont, 255, 127, 0, 1);
481 y := 90;
482 for I := 0 to High(SL) do
483 begin
484 e_TextureFontPrintEx(mx + 54, y, IntToStr(SL[I].Players) + '/' + IntToStr(SL[I].MaxPlayers), gStdFont, 255, 255, 255, 1);
485 e_TextureFontPrintEx(mx + 54, y + 16, IntToStr(SL[I].LocalPl) + '+' + IntToStr(SL[I].Bots), gStdFont, 210, 210, 210, 1);
486 y := y + 42;
487 end;
488
489 e_TextureFontPrintEx(mx + 106, 68, 'VER', gStdFont, 255, 127, 0, 1);
490 y := 90;
491 for I := 0 to High(SL) do
492 begin
493 e_TextureFontPrintEx(mx + 106, y, IntToStr(SL[I].Protocol), gStdFont, 255, 255, 255, 1);
494
495 y := y + 42;
496 end;
497
498 e_TextureFontPrintEx(20, gScreenHeight-61, ip, gStdFont, 205, 205, 205, 1);
499 ip := IntToStr(Length(SL)) + _lc[I_NET_SLIST_SERVERS];
500 e_TextureFontPrintEx(gScreenWidth - 48 - (Length(ip) + 1)*cw,
501 gScreenHeight-61, ip, gStdFont, 205, 205, 205, 1);
502 end;
503
504 procedure g_Serverlist_Control(var SL: TNetServerList);
505 begin
506 if gConsoleShow or gChatShow then
507 Exit;
508
509 e_PollInput();
510
511 if e_KeyPressed(IK_ESCAPE) then
512 begin
513 SL := nil;
514 gState := STATE_MENU;
515 g_GUI_ShowWindow('MainMenu');
516 g_GUI_ShowWindow('NetGameMenu');
517 g_GUI_ShowWindow('NetClientMenu');
518 g_Sound_PlayEx(WINDOW_CLOSESOUND);
519 Exit;
520 end;
521
522 if e_KeyPressed(IK_SPACE) then
523 begin
524 if not slFetched then
525 begin
526 slWaitStr := _lc[I_NET_SLIST_WAIT];
527
528 g_Game_Draw;
529 g_window.ReDrawWindow;
530
531 if g_Net_Slist_Fetch(SL) then
532 begin
533 if SL = nil then
534 slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
535 end
536 else
537 slWaitStr := _lc[I_NET_SLIST_ERROR];
538 slFetched := True;
539 slSelection := 0;
540 end;
541 end
542 else
543 slFetched := False;
544
545 if SL = nil then Exit;
546
547 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) then
548 begin
549 if not slReturnPressed then
550 begin
551 if SL[slSelection].Password then
552 begin
553 PromptIP := SL[slSelection].IP;
554 PromptPort := SL[slSelection].Port;
555 gState := STATE_MENU;
556 g_GUI_ShowWindow('ClientPasswordMenu');
557 SL := nil;
558 slReturnPressed := True;
559 Exit;
560 end
561 else
562 g_Game_StartClient(SL[slSelection].IP, SL[slSelection].Port, '');
563 SL := nil;
564 slReturnPressed := True;
565 Exit;
566 end;
567 end
568 else
569 slReturnPressed := False;
570
571 if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) then
572 begin
573 if not slDirPressed then
574 begin
575 Inc(slSelection);
576 if slSelection > High(SL) then slSelection := 0;
577 slDirPressed := True;
578 end;
579 end;
580
581 if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) then
582 begin
583 if not slDirPressed then
584 begin
585 if slSelection = 0 then slSelection := Length(SL);
586 Dec(slSelection);
587
588 slDirPressed := True;
589 end;
590 end;
591
592 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
593 slDirPressed := False;
594 end;
595
596 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024