DEADSOFTWARE

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