DEADSOFTWARE

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


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