DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
sfs and wad code refactoring: part 1
[d2df-sdl.git] / src / game / g_netmaster.pas
1 unit g_netmaster;
2
3 interface
4
5 uses ENet;
6
7 const
8 NET_MCHANS = 2;
9
10 NET_MCHAN_MAIN = 0;
11 NET_MCHAN_UPD = 1;
12
13 NET_MMSG_UPD = 200;
14 NET_MMSG_DEL = 201;
15 NET_MMSG_GET = 202;
16
17 type
18 TNetServer = record
19 Number: Byte;
20 Protocol: Byte;
21 Name: string;
22 IP: string;
23 Port: Word;
24 Map: string;
25 Players, MaxPlayers, LocalPl, Bots: Byte;
26 Ping: Int64;
27 GameMode: Byte;
28 Password: Boolean;
29 PingAddr: ENetAddress;
30 end;
31 pTNetServer = ^TNetServer;
32
33 TNetServerList = array of TNetServer;
34 pTNetServerList = ^TNetServerList;
35
36 var
37 NetMHost: pENetHost = nil;
38 NetMPeer: pENetPeer = nil;
39
40 slCurrent: TNetServerList = nil;
41 slWaitStr: string = '';
42 slReturnPressed: Boolean = True;
43
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();
52
53 procedure g_Serverlist_Draw(var SL: TNetServerList);
54 procedure g_Serverlist_Control(var SL: TNetServerList);
55
56 implementation
57
58 uses
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, wadreader,
61 ENetPlatform;
62
63 var
64 NetMEvent: ENetEvent;
65 slSelection: Byte = 0;
66 slFetched: Boolean = False;
67 slDirPressed: Boolean = False;
68
69 function GetTimerMS(): Int64;
70 begin
71 Result := GetTimer() {div 1000};
72 end;
73
74 procedure PingServer(var S: TNetServer; Sock: ENetSocket);
75 var
76 Buf: ENetBuffer;
77 Ping: array [0..9] of Byte;
78 ClTime: Int64;
79 begin
80 ClTime := GetTimerMS();
81
82 Buf.data := Addr(Ping[0]);
83 Buf.dataLength := 2+8;
84
85 Ping[0] := Ord('D');
86 Ping[1] := Ord('F');
87 Int64(Addr(Ping[2])^) := ClTime;
88
89 enet_socket_send(Sock, Addr(S.PingAddr), @Buf, 1);
90 end;
91
92 function g_Net_Slist_Fetch(var SL: TNetServerList): Boolean;
93 var
94 Cnt: Byte;
95 P: pENetPacket;
96 MID: Byte;
97 I, RX: Integer;
98 T: Int64;
99 Sock: ENetSocket;
100 Buf: ENetBuffer;
101 SvAddr: ENetAddress;
102 begin
103 Result := False;
104 SL := nil;
105
106 if (NetMHost <> nil) or (NetMPeer <> nil) then
107 Exit;
108
109 if not g_Net_Slist_Connect then
110 Exit;
111
112 e_WriteLog('Fetching serverlist...', MSG_NOTIFY);
113 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_FETCH]);
114
115 e_Buffer_Clear(@NetOut);
116 e_Buffer_Write(@NetOut, Byte(NET_MMSG_GET));
117
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);
121
122 while enet_host_service(NetMHost, @NetMEvent, 5000) > 0 do
123 begin
124 if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
125 begin
126 e_Raw_Seek(0);
127 MID := e_Raw_Read_Byte(NetMEvent.packet^.data);
128
129 if MID <> NET_MMSG_GET then continue;
130
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);
134
135 if Cnt > 0 then
136 begin
137 SetLength(SL, Cnt);
138
139 for I := 0 to Cnt - 1 do
140 begin
141 SL[I].Number := I;
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])));
152 SL[I].Ping := -1;
153 SL[I].PingAddr.port := SL[I].Port + 1;
154 end;
155 end;
156
157 Result := True;
158 break;
159 end;
160 end;
161
162 g_Net_Slist_Disconnect;
163 e_Buffer_Clear(@NetOut);
164
165 if Length(SL) = 0 then Exit;
166
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);
170
171 for I := Low(SL) to High(SL) do
172 PingServer(SL[I], Sock);
173
174 T := GetTimerMS();
175
176 e_Buffer_Clear(@NetIn);
177 Buf.data := Addr(NetIn.Data);
178 Buf.dataLength := Length(NetIn.Data);
179 Cnt := 0;
180 while Cnt < Length(SL) do
181 begin
182 if GetTimerMS() - T > 500 then break;
183
184 e_Buffer_Clear(@NetIn);
185
186 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
187 if RX <= 0 then continue;
188 NetIn.Len := RX + 1;
189 NetIn.ReadPos := 0;
190
191 if e_Buffer_Read_Char(@NetIn) <> 'D' then continue;
192 if e_Buffer_Read_Char(@NetIn) <> 'F' then continue;
193
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
197 begin
198 with SL[I] do
199 begin
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);
211 end;
212 Inc(Cnt);
213 break;
214 end;
215 end;
216
217 enet_socket_destroy(Sock);
218 end;
219
220 procedure g_Net_Slist_WriteInfo();
221 var
222 Wad, Map: string;
223 Cli: Byte;
224 begin
225 g_ProcessResourceStr(gMapInfo.Map, @Wad, nil, @Map);
226 Wad := ExtractFileName(Wad);
227
228 e_Buffer_Write(@NetOut, NetServerName);
229
230 e_Buffer_Write(@NetOut, Wad + ':\' + Map);
231 e_Buffer_Write(@NetOut, gGameSettings.GameMode);
232
233 Cli := NetClientCount;
234 e_Buffer_Write(@NetOut, Cli);
235
236 e_Buffer_Write(@NetOut, NetMaxClients);
237
238 e_Buffer_Write(@NetOut, Byte(NET_PROTOCOL_VER));
239 e_Buffer_Write(@NetOut, Byte(NetPassword <> ''));
240 end;
241
242 procedure g_Net_Slist_Update;
243 var
244
245 P: pENetPacket;
246
247 begin
248 if (NetMHost = nil) or (NetMPeer = nil) then Exit;
249
250 e_Buffer_Clear(@NetOut);
251 e_Buffer_Write(@NetOut, Byte(NET_MMSG_UPD));
252 e_Buffer_Write(@NetOut, NetAddr.port);
253
254 g_Net_Slist_WriteInfo();
255
256 P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, Cardinal(ENET_PACKET_FLAG_RELIABLE));
257 enet_peer_send(NetMPeer, NET_MCHAN_UPD, P);
258
259 enet_host_flush(NetMHost);
260 e_Buffer_Clear(@NetOut);
261 end;
262
263 procedure g_Net_Slist_Remove;
264 var
265 P: pENetPacket;
266 begin
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);
271
272 P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, Cardinal(ENET_PACKET_FLAG_RELIABLE));
273 enet_peer_send(NetMPeer, NET_MCHAN_MAIN, P);
274
275 enet_host_flush(NetMHost);
276 e_Buffer_Clear(@NetOut);
277 end;
278
279 function g_Net_Slist_Connect: Boolean;
280 begin
281 Result := False;
282
283 NetMHost := enet_host_create(nil, 1, NET_MCHANS, 0, 0);
284 if (NetMHost = nil) then
285 begin
286 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
287 Exit;
288 end;
289
290 NetMPeer := enet_host_connect(NetMHost, @NetSlistAddr, NET_MCHANS, 0);
291 if (NetMPeer = nil) then
292 begin
293 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
294 enet_host_destroy(NetMHost);
295 NetMHost := nil;
296 Exit;
297 end;
298
299 if (enet_host_service(NetMHost, @NetMEvent, 3000) > 0) then
300 if NetMEvent.kind = ENET_EVENT_TYPE_CONNECT then
301 begin
302 Result := True;
303 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_CONN]);
304 Exit;
305 end
306 else
307 if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
308 enet_packet_destroy(NetMEvent.packet);
309
310 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
311
312 NetMHost := nil;
313 NetMPeer := nil;
314 end;
315
316 procedure g_Net_Slist_Disconnect;
317 begin
318 if (NetMHost = nil) and (NetMPeer = nil) then Exit;
319
320 if NetMode = NET_SERVER then g_Net_Slist_Remove;
321
322 enet_peer_disconnect(NetMPeer, 0);
323 enet_host_flush(NetMHost);
324
325 enet_peer_reset(NetMPeer);
326 enet_host_destroy(NetMHost);
327
328 NetMPeer := nil;
329 NetMHost := nil;
330
331 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
332 end;
333
334 procedure g_Net_Slist_Check;
335 begin
336 if (NetMHost = nil) or (NetMPeer = nil) then Exit;
337
338 while (enet_host_service(NetMHost, @NetMEvent, 0) > 0) do
339 begin
340 if NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT then
341 begin
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);
345 NetMPeer := nil;
346 NetMHost := nil;
347 Break;
348 end
349 else
350 if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
351 enet_packet_destroy(NetMEvent.packet);
352 end;
353 end;
354
355 procedure g_Net_Slist_Set(IP: string; Port: Word);
356 begin
357 if NetInitDone then
358 begin
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);
362 end;
363 end;
364
365 procedure g_Serverlist_Draw(var SL: TNetServerList);
366 var
367 sy, i, y, mw, mx, l: Integer;
368 cw, ch: Byte;
369 ww, hh: Word;
370 ip: string;
371 begin
372 ip := '';
373 sy := 0;
374
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]);
377
378 e_TextureFontGetSize(gStdFont, cw, ch);
379
380 ip := _lc[I_NET_SLIST_HELP];
381 mw := (Length(ip) * cw) div 2;
382
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);
385
386 e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
387
388 if SL = nil then
389 begin
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);
396 Exit;
397 end;
398
399 y := 90;
400 if (slSelection < Length(SL)) then
401 begin
402 I := slSelection;
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]
407 else
408 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_NO];
409 end else
410 if Length(SL) > 0 then
411 slSelection := 0;
412
413 mw := (gScreenWidth - 188);
414 mx := 16 + mw;
415
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);
419
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);
422
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);
427
428 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
429
430 y := 90;
431 for I := 0 to High(SL) do
432 begin
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);
435
436 y := y + 42;
437 end;
438
439 e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
440 y := 90;
441 for I := 0 to High(SL) do
442 begin
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)
445 else
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)
448 else
449 e_TextureFontPrintEx(mx - 68, y, IntToStr(SL[I].Ping) + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1);
450
451 y := y + 42;
452 end;
453
454 e_TextureFontPrintEx(mx + 2, 68, 'MODE', gStdFont, 255, 127, 0, 1);
455 y := 90;
456 for I := 0 to High(SL) do
457 begin
458 e_TextureFontPrintEx(mx + 2, y, g_Game_ModeToText(SL[I].GameMode), gStdFont, 255, 255, 255, 1);
459
460 y := y + 42;
461 end;
462
463 e_TextureFontPrintEx(mx + 54, 68, 'PLRS', gStdFont, 255, 127, 0, 1);
464 y := 90;
465 for I := 0 to High(SL) do
466 begin
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);
469 y := y + 42;
470 end;
471
472 e_TextureFontPrintEx(mx + 106, 68, 'VER', gStdFont, 255, 127, 0, 1);
473 y := 90;
474 for I := 0 to High(SL) do
475 begin
476 e_TextureFontPrintEx(mx + 106, y, IntToStr(SL[I].Protocol), gStdFont, 255, 255, 255, 1);
477
478 y := y + 42;
479 end;
480
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);
485 end;
486
487 procedure g_Serverlist_Control(var SL: TNetServerList);
488 begin
489 if gConsoleShow or gChatShow then
490 Exit;
491
492 e_PollInput();
493
494 if e_KeyPressed(IK_ESCAPE) then
495 begin
496 SL := nil;
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);
502 Exit;
503 end;
504
505 if e_KeyPressed(IK_SPACE) then
506 begin
507 if not slFetched then
508 begin
509 slWaitStr := _lc[I_NET_SLIST_WAIT];
510
511 g_Game_Draw;
512 g_window.ReDrawWindow;
513
514 if g_Net_Slist_Fetch(SL) then
515 begin
516 if SL = nil then
517 slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
518 end
519 else
520 slWaitStr := _lc[I_NET_SLIST_ERROR];
521 slFetched := True;
522 slSelection := 0;
523 end;
524 end
525 else
526 slFetched := False;
527
528 if SL = nil then Exit;
529
530 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) then
531 begin
532 if not slReturnPressed then
533 begin
534 if SL[slSelection].Password then
535 begin
536 PromptIP := SL[slSelection].IP;
537 PromptPort := SL[slSelection].Port;
538 gState := STATE_MENU;
539 g_GUI_ShowWindow('ClientPasswordMenu');
540 SL := nil;
541 slReturnPressed := True;
542 Exit;
543 end
544 else
545 g_Game_StartClient(SL[slSelection].IP, SL[slSelection].Port, '');
546 SL := nil;
547 slReturnPressed := True;
548 Exit;
549 end;
550 end
551 else
552 slReturnPressed := False;
553
554 if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) then
555 begin
556 if not slDirPressed then
557 begin
558 Inc(slSelection);
559 if slSelection > High(SL) then slSelection := 0;
560 slDirPressed := True;
561 end;
562 end;
563
564 if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) then
565 begin
566 if not slDirPressed then
567 begin
568 if slSelection = 0 then slSelection := Length(SL);
569 Dec(slSelection);
570
571 slDirPressed := True;
572 end;
573 end;
574
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;
577 end;
578
579 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024