DEADSOFTWARE

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