DEADSOFTWARE

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


aee13eb1c2ebb5d027ac02b9dada3af5f44802b7
[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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 unit g_netmaster;
17
18 interface
19
20 uses
21 ENet, SysUtils, e_msg;
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: AnsiString;
38 IP: AnsiString;
39 Port: Word;
40 Map: AnsiString;
41 Players, MaxPlayers, LocalPl, Bots: Byte;
42 Ping: Int64;
43 GameMode: Byte;
44 Password: Boolean;
45 PingAddr: ENetAddress;
46 end;
47 pTNetServer = ^TNetServer;
48 TNetServerRow = record
49 Indices: Array of Integer;
50 Current: Integer;
51 end;
52
53 TNetServerList = array of TNetServer;
54 pTNetServerList = ^TNetServerList;
55 TNetServerTable = array of TNetServerRow;
56
57 type
58 TMasterHost = record
59 public
60 hostName: AnsiString;
61 hostPort: Word;
62
63 public
64 peer: pENetPeer;
65 enetAddr: ENetAddress;
66 // inside the game, calling `connect()` is disasterous, as it is blocking.
67 // so we'll use this variable to indicate if "connected" event is received.
68 NetHostConnected: Boolean;
69 NetHostConReqTime: Int64; // to timeout `connect`; -1 means "waiting for shutdown"
70 NetUpdatePending: Boolean; // should we send an update after connection completes?
71 updateSent: Boolean;
72 lastUpdateTime: Int64;
73 // server list request working flags
74 srvAnswered: Integer;
75 srvAnswer: array of TNetServer;
76 slMOTD: AnsiString;
77 slUrgent: AnsiString;
78 slReadUrgent: Boolean;
79
80 private
81 netmsg: TMsg;
82
83 public
84 constructor Create (hostandport: AnsiString);
85
86 procedure clear ();
87
88 function setAddress (hostandport: AnsiString): Boolean;
89
90 function isSameAddress (hostandport: AnsiString): Boolean;
91
92 function isValid (): Boolean;
93 function isAlive (): Boolean; // not disconnected
94 function isConnecting (): Boolean; // is connection in progress?
95 function isConnected (): Boolean;
96
97 // call as often as you want, the object will do the rest
98 // but try to call this at least once in 100 msecs
99 procedure pulse ();
100
101 procedure disconnect (forced: Boolean);
102 function connect (): Boolean;
103
104 procedure update ();
105 procedure remove ();
106
107 class procedure writeInfo (var msg: TMsg); static;
108
109 procedure connectedEvent ();
110 procedure disconnectedEvent ();
111 procedure receivedEvent (pkt: pENetPacket); // `pkt` is never `nil`
112 end;
113
114
115 var
116 slCurrent: TNetServerList = nil;
117 slTable: TNetServerTable = nil;
118 slWaitStr: AnsiString = '';
119 slReturnPressed: Boolean = True;
120
121 slMOTD: AnsiString = '';
122 slUrgent: AnsiString = '';
123
124
125 procedure g_Net_Slist_Set (IP: AnsiString; Port: Word);
126 function g_Net_Slist_Fetch (var SL: TNetServerList): Boolean;
127
128 // make this server private
129 procedure g_Net_Slist_Private ();
130 // make this server public
131 procedure g_Net_Slist_Public ();
132
133 // called on network mode init
134 procedure g_Net_Slist_NetworkStarted ();
135 // called on network mode shutdown
136 procedure g_Net_Slist_NetworkStopped ();
137
138 procedure g_Net_Slist_Pulse (timeout: Integer=0);
139
140 procedure g_Serverlist_GenerateTable (SL: TNetServerList; var ST: TNetServerTable);
141 procedure g_Serverlist_Draw (var SL: TNetServerList; var ST: TNetServerTable);
142 procedure g_Serverlist_Control (var SL: TNetServerList; var ST: TNetServerTable);
143
144 function GetTimerMS (): Int64;
145
146
147 implementation
148
149 uses
150 e_input, e_graphics, e_log, g_window, g_net, g_console,
151 g_map, g_game, g_sound, g_gui, g_menu, g_options, g_language, g_basic,
152 wadreader, g_system, utils;
153
154 // make this server private
155 procedure g_Net_Slist_Private ();
156 begin
157 end;
158
159
160 // make this server public
161 procedure g_Net_Slist_Public ();
162 begin
163 end;
164
165
166 // called on network mode init
167 procedure g_Net_Slist_NetworkStarted ();
168 begin
169 end;
170
171 // called on network mode shutdown
172 procedure g_Net_Slist_NetworkStopped ();
173 begin
174 end;
175
176
177 var
178 NetMHost: pENetHost = nil;
179 NetMEvent: ENetEvent;
180 mlist: array of TMasterHost = nil;
181
182 slSelection: Byte = 0;
183 slFetched: Boolean = False;
184 slDirPressed: Boolean = False;
185 slReadUrgent: Boolean = False;
186
187
188 //==========================================================================
189 //
190 // GetTimerMS
191 //
192 //==========================================================================
193 function GetTimerMS (): Int64;
194 begin
195 Result := sys_GetTicks() {div 1000};
196 end;
197
198
199 //==========================================================================
200 //
201 // findByPeer
202 //
203 //==========================================================================
204 function findByPeer (peer: pENetPeer): Integer;
205 var
206 f: Integer;
207 begin
208 for f := 0 to High(mlist) do if (mlist[f].peer = peer) then begin result := f; exit; end;
209 result := -1;
210 end;
211
212
213 //==========================================================================
214 //
215 // TMasterHost.Create
216 //
217 //==========================================================================
218 constructor TMasterHost.Create (hostandport: AnsiString);
219 begin
220 peer := nil;
221 NetHostConnected := false;
222 NetHostConReqTime := 0;
223 NetUpdatePending := false;
224 updateSent := false;
225 hostName := '';
226 hostPort := 25665;
227 SetLength(srvAnswer, 0);
228 srvAnswered := 0;
229 slMOTD := '';
230 slUrgent := '';
231 slReadUrgent := true;
232 netmsg.Alloc(NET_BUFSIZE);
233 setAddress(hostandport);
234 end;
235
236
237 //==========================================================================
238 //
239 // TMasterHost.clear
240 //
241 //==========================================================================
242 procedure TMasterHost.clear ();
243 begin
244 updateSent := false; // do not send 'remove'
245 disconnect(true);
246 hostName := '';
247 hostPort := 25665;
248 netmsg.Free();
249 SetLength(srvAnswer, 0);
250 srvAnswered := 0;
251 slMOTD := '';
252 slUrgent := '';
253 slReadUrgent := true;
254 end;
255
256
257 //==========================================================================
258 //
259 // TMasterHost.isSameAddress
260 //
261 //==========================================================================
262 function TMasterHost.isSameAddress (hostandport: AnsiString): Boolean;
263 var
264 cp, pp: Integer;
265 hn: AnsiString;
266 begin
267 result := false;
268 if not isValid() then exit;
269 hostandport := Trim(hostandport);
270 if (length(hostandport) = 0) then exit;
271 hn := hostandport;
272 cp := Pos(':', hostandport);
273 if (cp > 0) then
274 begin
275 hn := Copy(hostandport, 1, cp-1);
276 Delete(hostandport, 1, cp);
277 if (length(hostandport) > 0) then
278 begin
279 try
280 pp := StrToInt(hostandport);
281 except
282 pp := -1;
283 end;
284 end;
285 end
286 else
287 begin
288 pp := 25665;
289 end;
290 result := strEquCI1251(hn, hostName) and (hostPort = pp);
291 end;
292
293
294 //==========================================================================
295 //
296 // TMasterHost.setAddress
297 //
298 //==========================================================================
299 function TMasterHost.setAddress (hostandport: AnsiString): Boolean;
300 var
301 cp, pp: Integer;
302 begin
303 result := false;
304 SetLength(srvAnswer, 0);
305 srvAnswered := 0;
306 slMOTD := '';
307 slUrgent := '';
308 slReadUrgent := true;
309 updateSent := false; // do not send 'remove'
310 disconnect(true);
311 hostName := '';
312 hostPort := 25665;
313
314 if (not g_Net_IsNetworkAvailable()) then exit;
315
316 hostandport := Trim(hostandport);
317 if (length(hostandport) > 0) then
318 begin
319 hostName := hostandport;
320 cp := Pos(':', hostandport);
321 if (cp > 0) then
322 begin
323 hostName := Copy(hostandport, 1, cp-1);
324 Delete(hostandport, 1, cp);
325 if (length(hostandport) > 0) then
326 begin
327 try
328 pp := StrToInt(hostandport);
329 except
330 pp := -1;
331 end;
332 if (pp > 0) and (pp < 65536) then hostPort := pp else hostPort := 0;
333 end;
334 end;
335 end;
336
337 if not isValid() then exit;
338
339 if (enet_address_set_host(@enetAddr, PChar(Addr(hostName[1]))) <> 0) then
340 begin
341 writeln('SHIT!');
342 hostName := '';
343 hostPort := 0;
344 end;
345 enetAddr.Port := hostPort;
346
347 result := isValid();
348 //writeln('*********************: ', hostandport, ' [', hostName, ':', hostPort, '] ', result);
349 end;
350
351
352 //==========================================================================
353 //
354 // TMasterHost.isValid
355 //
356 //==========================================================================
357 function TMasterHost.isValid (): Boolean;
358 begin
359 result := (length(hostName) > 0) and (hostPort > 0);
360 end;
361
362
363 //==========================================================================
364 //
365 // TMasterHost.isAlive
366 //
367 // not disconnected
368 //
369 //==========================================================================
370 function TMasterHost.isAlive (): Boolean;
371 begin
372 result := (NetMHost <> nil) and (peer <> nil);
373 end;
374
375
376 //==========================================================================
377 //
378 // TMasterHost.isConnecting
379 //
380 // is connection in progress?
381 //
382 //==========================================================================
383 function TMasterHost.isConnecting (): Boolean;
384 begin
385 result := isAlive() and (not NetHostConnected) and (NetHostConReqTime <> -1);
386 end;
387
388
389 //==========================================================================
390 //
391 // TMasterHost.isConnected
392 //
393 //==========================================================================
394 function TMasterHost.isConnected (): Boolean;
395 begin
396 result := isAlive() and (NetHostConnected) and (NetHostConReqTime <> -1);
397 end;
398
399
400 //==========================================================================
401 //
402 // TMasterHost.connectedEvent
403 //
404 //==========================================================================
405 procedure TMasterHost.connectedEvent ();
406 begin
407 if not isAlive() then exit;
408 if NetHostConnected then exit;
409 NetHostConnected := true;
410 e_LogWritefln('connected to master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
411 end;
412
413
414 //==========================================================================
415 //
416 // TMasterHost.disconnectedEvent
417 //
418 //==========================================================================
419 procedure TMasterHost.disconnectedEvent ();
420 begin
421 if not isAlive() then exit;
422 e_LogWritefln('disconnected from master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
423 disconnect(true);
424 //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
425 end;
426
427
428 //==========================================================================
429 //
430 // TMasterHost.receivedEvent
431 //
432 // `pkt` is never `nil`
433 //
434 //==========================================================================
435 procedure TMasterHost.receivedEvent (pkt: pENetPacket);
436 var
437 msg: TMsg;
438 MID: Byte;
439 Cnt: Byte;
440 f: Integer;
441 s: AnsiString;
442 begin
443 e_LogWritefln('received packed from master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
444 if not msg.Init(pkt^.data, pkt^.dataLength, True) then exit;
445 // packet type
446 MID := msg.ReadByte();
447 if (MID <> NET_MMSG_GET) then exit;
448 e_LogWritefln('received list packet from master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
449 SetLength(srvAnswer, 0);
450 if (srvAnswered > 0) then Inc(srvAnswered);
451 slMOTD := '';
452 //slUrgent := '';
453 slReadUrgent := true;
454 // number of items
455 Cnt := msg.ReadByte();
456 g_Console_Add(_lc[I_NET_MSG]+Format(_lc[I_NET_SLIST_RETRIEVED], [Cnt]), True);
457 if (Cnt > 0) then
458 begin
459 SetLength(srvAnswer, Cnt);
460 for f := 0 to Cnt-1 do
461 begin
462 srvAnswer[f].Number := f;
463 srvAnswer[f].IP := msg.ReadString();
464 srvAnswer[f].Port := msg.ReadWord();
465 srvAnswer[f].Name := msg.ReadString();
466 srvAnswer[f].Map := msg.ReadString();
467 srvAnswer[f].GameMode := msg.ReadByte();
468 srvAnswer[f].Players := msg.ReadByte();
469 srvAnswer[f].MaxPlayers := msg.ReadByte();
470 srvAnswer[f].Protocol := msg.ReadByte();
471 srvAnswer[f].Password := msg.ReadByte() = 1;
472 enet_address_set_host(Addr(srvAnswer[f].PingAddr), PChar(Addr(srvAnswer[f].IP[1])));
473 srvAnswer[f].Ping := -1;
474 srvAnswer[f].PingAddr.port := NET_PING_PORT;
475 end;
476 end;
477
478 if (msg.ReadCount < msg.CurSize) then
479 begin
480 // new master, supports version reports
481 s := msg.ReadString();
482 if (s <> {MyVer}GAME_VERSION) then
483 begin
484 { TODO }
485 g_Console_Add('!!! UpdVer = `'+s+'`');
486 end;
487 // even newer master, supports extra info
488 if (msg.ReadCount < msg.CurSize) then
489 begin
490 slMOTD := b_Text_Format(msg.ReadString());
491 s := b_Text_Format(msg.ReadString());
492 // check if the message has updated and the user has to read it again
493 if (slUrgent <> s) then slReadUrgent := false;
494 slUrgent := s;
495 end;
496 end;
497 end;
498
499
500 //==========================================================================
501 //
502 // TMasterHost.pulse
503 //
504 // this performs various scheduled tasks, if necessary
505 //
506 //==========================================================================
507 procedure TMasterHost.pulse ();
508 var
509 ct: Int64;
510 begin
511 if not isAlive() then exit;
512 if (NetHostConReqTime = -1) then exit; // waiting for shutdown (disconnect in progress)
513 // process pending connection timeout
514 if (not NetHostConnected) then
515 begin
516 ct := GetTimerMS();
517 if (ct < NetHostConReqTime) or (ct-NetHostConReqTime >= 3000) then
518 begin
519 e_LogWritefln('failed to connect to master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
520 // do not spam with error messages, it looks like the master is down
521 //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
522 enet_peer_disconnect(peer, 0);
523 // main pulse will take care of the rest
524 end;
525 exit;
526 end;
527 end;
528
529
530 //==========================================================================
531 //
532 // TMasterHost.disconnect
533 //
534 //==========================================================================
535 procedure TMasterHost.disconnect (forced: Boolean);
536 begin
537 if not isAlive() then exit;
538 //if (NetMode = NET_SERVER) and isConnected() and updateSent then remove();
539
540 if (forced) then
541 begin
542 enet_peer_reset(peer);
543 peer := nil;
544 NetHostConReqTime := 0;
545 end
546 else
547 begin
548 enet_peer_disconnect_later(peer, 0);
549 // main pulse will take care of the rest
550 NetHostConReqTime := -1;
551 end;
552
553 NetHostConnected := false;
554 NetUpdatePending := false;
555 updateSent := false;
556 //if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
557 end;
558
559
560 //==========================================================================
561 //
562 // TMasterHost.connect
563 //
564 //==========================================================================
565 function TMasterHost.connect (): Boolean;
566 begin
567 result := false;
568 if not isValid() then exit;
569 if (NetHostConReqTime = -1) then
570 begin
571 disconnect(true);
572 end
573 else
574 begin
575 if isAlive() then begin result := true; exit; end;
576 end;
577
578 SetLength(srvAnswer, 0);
579 srvAnswered := 0;
580 NetHostConnected := false;
581 NetHostConReqTime := 0;
582 NetUpdatePending := false;
583 updateSent := false;
584
585 peer := enet_host_connect(NetMHost, @enetAddr, NET_MCHANS, 0);
586 if (peer = nil) then
587 begin
588 g_Console_Add(_lc[I_NET_MSG_ERROR]+_lc[I_NET_ERR_CLIENT], true);
589 exit;
590 end;
591
592 NetHostConReqTime := GetTimerMS();
593 e_LogWritefln('connecting to master at [%s:%u]', [hostName, hostPort], TMsgType.Notify);
594 end;
595
596
597 //==========================================================================
598 //
599 // TMasterHost.writeInfo
600 //
601 //==========================================================================
602 class procedure TMasterHost.writeInfo (var msg: TMsg);
603 var
604 wad, map: AnsiString;
605 begin
606 wad := g_ExtractWadNameNoPath(gMapInfo.Map);
607 map := g_ExtractFileName(gMapInfo.Map);
608
609 msg.Write(NetServerName);
610
611 msg.Write(wad+':/'+map);
612 msg.Write(gGameSettings.GameMode);
613
614 msg.Write(Byte(NetClientCount));
615
616 msg.Write(NetMaxClients);
617
618 msg.Write(Byte(NET_PROTOCOL_VER));
619 msg.Write(Byte(NetPassword <> ''));
620 end;
621
622
623 //==========================================================================
624 //
625 // TMasterHost.update
626 //
627 //==========================================================================
628 procedure TMasterHost.update ();
629 var
630 pkt: pENetPacket;
631 begin
632 if not isAlive() then exit;
633 if not isConnected() then
634 begin
635 NetUpdatePending := isConnecting();
636 exit;
637 end;
638
639 netmsg.Clear();
640 try
641 netmsg.Write(Byte(NET_MMSG_UPD));
642 netmsg.Write(NetAddr.port);
643
644 writeInfo(netmsg);
645
646 pkt := enet_packet_create(netmsg.Data, netmsg.CurSize, ENET_PACKET_FLAG_RELIABLE);
647 if assigned(pkt) then
648 begin
649 if (enet_peer_send(peer, NET_MCHAN_UPD, pkt) = 0) then NetUpdatePending := false;
650 end;
651 finally
652 netmsg.Clear();
653 end;
654 end;
655
656
657 //==========================================================================
658 //
659 // TMasterHost.remove
660 //
661 //==========================================================================
662 procedure TMasterHost.remove ();
663 var
664 pkt: pENetPacket;
665 begin
666 NetUpdatePending := false;
667 if not isAlive() then exit;
668 if not isConnected() then exit;
669
670 netmsg.Clear();
671 try
672 netmsg.Write(Byte(NET_MMSG_DEL));
673 netmsg.Write(NetAddr.port);
674
675 pkt := enet_packet_create(netmsg.Data, netmsg.CurSize, ENET_PACKET_FLAG_RELIABLE);
676 if assigned(pkt) then
677 begin
678 enet_peer_send(peer, NET_MCHAN_MAIN, pkt);
679 end;
680 finally
681 netmsg.Clear();
682 end;
683 end;
684
685
686 //**************************************************************************
687 //
688 // other functions
689 //
690 //**************************************************************************
691
692 procedure g_Net_Slist_Set (IP: AnsiString; Port: Word);
693 var
694 f: Integer;
695 sa: AnsiString;
696 begin
697 if (not g_Net_IsNetworkAvailable()) then exit;
698 IP := Trim(IP);
699 if (length(IP) = 0) or (Port = 0) then exit;
700 sa := IP+':'+IntToStr(Port);
701 for f := 0 to High(mlist) do if (mlist[f].isSameAddress(sa)) then exit;
702 SetLength(mlist, length(mlist)+1);
703 mlist[High(mlist)].Create(sa);
704 mlist[High(mlist)].setAddress(sa);
705 e_LogWritefln('Masterserver address set to [%s:%u]', [IP, Port], TMsgType.Notify);
706 end;
707
708
709 //**************************************************************************
710 //
711 // main pulse
712 //
713 //**************************************************************************
714 procedure g_Net_Slist_Pulse (timeout: Integer=0);
715 var
716 f: Integer;
717 sres: Integer;
718 idx: Integer;
719 begin
720 if (not g_Net_IsNetworkAvailable()) then exit;
721
722 if (length(mlist) = 0) then
723 begin
724 if (NetMHost <> nil) then
725 begin
726 enet_host_destroy(NetMHost);
727 NetMHost := nil;
728 exit;
729 end;
730 end;
731
732 if (NetMHost = nil) then
733 begin
734 NetMHost := enet_host_create(nil, 1, NET_MCHANS, 0, 0);
735 if (NetMHost = nil) then
736 begin
737 g_Console_Add(_lc[I_NET_MSG_ERROR]+_lc[I_NET_ERR_CLIENT], True);
738 for f := 0 to High(mlist) do mlist[f].clear();
739 SetLength(mlist, 0);
740 Exit;
741 end;
742 end;
743
744 for f := 0 to High(mlist) do mlist[f].pulse();
745
746 while true do
747 begin
748 sres := enet_host_service(NetMHost, @NetMEvent, timeout);
749 if (sres < 0) then
750 begin
751 g_Console_Add(_lc[I_NET_MSG_ERROR]+_lc[I_NET_ERR_CLIENT], True);
752 for f := 0 to High(mlist) do mlist[f].clear();
753 SetLength(mlist, 0);
754 enet_host_destroy(NetMHost);
755 NetMHost := nil;
756 exit;
757 end;
758
759 if (sres = 0) then break;
760 idx := findByPeer(NetMEvent.peer);
761 if (idx < 0) then
762 begin
763 e_LogWriteln('network event from unknown master host. ignored.', TMsgType.Warning);
764 if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then enet_packet_destroy(NetMEvent.packet);
765 continue;
766 end;
767
768 if (NetMEvent.kind = ENET_EVENT_TYPE_CONNECT) then
769 begin
770 mlist[idx].connectedEvent();
771 end
772 else if (NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
773 begin
774 mlist[idx].disconnectedEvent();
775 end
776 else if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
777 begin
778 mlist[idx].receivedEvent(NetMEvent.packet);
779 enet_packet_destroy(NetMEvent.packet);
780 end;
781 end;
782 end;
783
784
785 //**************************************************************************
786 //
787 // gui and server list
788 //
789 //**************************************************************************
790
791 //==========================================================================
792 //
793 // PingServer
794 //
795 //==========================================================================
796 procedure PingServer (var S: TNetServer; Sock: ENetSocket);
797 var
798 Buf: ENetBuffer;
799 Ping: array [0..9] of Byte;
800 ClTime: Int64;
801 begin
802 ClTime := GetTimerMS();
803
804 Buf.data := Addr(Ping[0]);
805 Buf.dataLength := 2+8;
806
807 Ping[0] := Ord('D');
808 Ping[1] := Ord('F');
809 Int64(Addr(Ping[2])^) := ClTime;
810
811 enet_socket_send(Sock, Addr(S.PingAddr), @Buf, 1);
812 end;
813
814
815 //==========================================================================
816 //
817 // PingBcast
818 //
819 //==========================================================================
820 procedure PingBcast (Sock: ENetSocket);
821 var
822 S: TNetServer;
823 begin
824 S.IP := '255.255.255.255';
825 S.Port := NET_PING_PORT;
826 enet_address_set_host(Addr(S.PingAddr), PChar(Addr(S.IP[1])));
827 S.Ping := -1;
828 S.PingAddr.port := S.Port;
829 PingServer(S, Sock);
830 end;
831
832
833 //==========================================================================
834 //
835 // g_Net_Slist_Fetch
836 //
837 //==========================================================================
838 function g_Net_Slist_Fetch (var SL: TNetServerList): Boolean;
839 var
840 Cnt: Byte;
841 pkt: pENetPacket;
842 I, RX: Integer;
843 T: Int64;
844 Sock: ENetSocket;
845 Buf: ENetBuffer;
846 InMsg: TMsg;
847 SvAddr: ENetAddress;
848 FromSL: Boolean;
849 MyVer: AnsiString;
850
851 procedure DisconnectAll ();
852 var
853 f: Integer;
854 hasAlive: Boolean;
855 stt, ct: Int64;
856 begin
857 stt := GetTimerMS();
858 while (length(mlist) > 0) do
859 begin
860 hasAlive := false;
861 for f := 0 to High(mlist) do
862 begin
863 if (mlist[f].isAlive()) then
864 begin
865 hasAlive := true;
866 mlist[f].disconnect(false);
867 end;
868 end;
869 if not hasAlive then break;
870 g_Net_Slist_Pulse(100);
871 ct := GetTimerMS();
872 if (ct < stt) or (ct-stt > 800) then break;
873 end;
874 end;
875
876 procedure ProcessLocal ();
877 begin
878 I := Length(SL);
879 SetLength(SL, I + 1);
880 with SL[I] do
881 begin
882 IP := DecodeIPV4(SvAddr.host);
883 Port := InMsg.ReadWord();
884 Ping := InMsg.ReadInt64();
885 Ping := GetTimerMS() - Ping;
886 Name := InMsg.ReadString();
887 Map := InMsg.ReadString();
888 GameMode := InMsg.ReadByte();
889 Players := InMsg.ReadByte();
890 MaxPlayers := InMsg.ReadByte();
891 Protocol := InMsg.ReadByte();
892 Password := InMsg.ReadByte() = 1;
893 LocalPl := InMsg.ReadByte();
894 Bots := InMsg.ReadWord();
895 end;
896 end;
897
898 procedure CheckLocalServers ();
899 begin
900 SetLength(SL, 0);
901
902 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
903 if Sock = ENET_SOCKET_NULL then Exit;
904 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
905 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
906 PingBcast(Sock);
907
908 T := GetTimerMS();
909
910 InMsg.Alloc(NET_BUFSIZE);
911 Buf.data := InMsg.Data;
912 Buf.dataLength := InMsg.MaxSize;
913 while GetTimerMS() - T <= 500 do
914 begin
915 InMsg.Clear();
916
917 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
918 if RX <= 0 then continue;
919 InMsg.CurSize := RX;
920
921 InMsg.BeginReading();
922
923 if InMsg.ReadChar() <> 'D' then continue;
924 if InMsg.ReadChar() <> 'F' then continue;
925
926 ProcessLocal();
927 end;
928
929 InMsg.Free();
930 enet_socket_destroy(Sock);
931
932 if Length(SL) = 0 then SL := nil;
933 end;
934
935 var
936 f, c, n, pos: Integer;
937 aliveCount: Integer;
938 hasUnanswered: Boolean;
939 stt, ct: Int64;
940 begin
941 result := false;
942 SL := nil;
943
944 if (not g_Net_IsNetworkAvailable()) then
945 begin
946 SetLength(SL, 0);
947 exit;
948 end;
949
950 g_Net_Slist_Pulse(); // this will create mhost
951
952 NetOut.Clear();
953 NetOut.Write(Byte(NET_MMSG_GET));
954
955 // TODO: what should we identify the build with?
956 MyVer := GAME_VERSION;
957 NetOut.Write(MyVer);
958
959 try
960 e_WriteLog('Fetching serverlist...', TMsgType.Notify);
961 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_FETCH]);
962
963 // wait until all servers connected and answered
964 stt := GetTimerMS();
965 while true do
966 begin
967 g_Net_Slist_Pulse(300);
968 aliveCount := 0;
969 hasUnanswered := false;
970 for f := 0 to High(mlist) do
971 begin
972 {
973 e_LogWritefln(' master #%d: [%s:%u] valid=%d; alive=%d; connected=%d; connecting=%d',
974 [f, mlist[f].hostName, mlist[f].hostPort, Integer(mlist[f].isValid()), Integer(mlist[f].isAlive()),
975 Integer(mlist[f].isConnected()), Integer(mlist[f].isConnecting())], TMsgType.Notify);
976 }
977 if (not mlist[f].isValid()) then continue;
978 if (not mlist[f].isAlive()) then
979 begin
980 mlist[f].connect();
981 if (mlist[f].isAlive()) then
982 begin
983 hasUnanswered := true;
984 stt := GetTimerMS();
985 end;
986 end
987 else if (mlist[f].isConnected()) then
988 begin
989 if (mlist[f].srvAnswered = 0) then
990 begin
991 pkt := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
992 if assigned(pkt) then
993 begin
994 if (enet_peer_send(mlist[f].peer, NET_MCHAN_MAIN, pkt) = 0) then
995 begin
996 hasUnanswered := true;
997 mlist[f].srvAnswered := 1;
998 stt := GetTimerMS();
999 end;
1000 end;
1001 end
1002 else if (mlist[f].srvAnswered = 1) then
1003 begin
1004 hasUnanswered := true;
1005 end
1006 else if (mlist[f].srvAnswered > 1) then
1007 begin
1008 Inc(aliveCount);
1009 end;
1010 end
1011 else if (mlist[f].isConnecting()) then
1012 begin
1013 hasUnanswered := true;
1014 end;
1015 end;
1016 if (not hasUnanswered) then break;
1017 // check for timeout
1018 ct := GetTimerMS();
1019 if (ct < stt) or (ct-stt > 4000) then break;
1020 end;
1021
1022 if (aliveCount = 0) then
1023 begin
1024 DisconnectAll();
1025 CheckLocalServers();
1026 exit;
1027 end;
1028
1029 slMOTD := '';
1030 {
1031 slUrgent := '';
1032 slReadUrgent := true;
1033 }
1034
1035 SetLength(SL, 0);
1036 for f := 0 to High(mlist) do
1037 begin
1038 if (mlist[f].srvAnswered < 2) then continue;
1039 for n := 0 to High(mlist[f].srvAnswer) do
1040 begin
1041 pos := -1;
1042 for c := 0 to High(SL) do
1043 begin
1044 if (SL[c].IP = mlist[f].srvAnswer[n].IP) and (SL[c].Port = mlist[f].srvAnswer[n].Port) then
1045 begin
1046 pos := c;
1047 break;
1048 end;
1049 end;
1050 if (pos < 0) then
1051 begin
1052 pos := length(SL);
1053 SetLength(SL, pos+1);
1054 SL[pos] := mlist[f].srvAnswer[n];
1055 SL[pos].Number := pos;
1056 end;
1057 end;
1058 if (not mlist[f].slReadUrgent) and (mlist[f].slUrgent <> '') then
1059 begin
1060 if (mlist[f].slUrgent <> slUrgent) then
1061 begin
1062 slUrgent := mlist[f].slUrgent;
1063 slReadUrgent := false;
1064 end;
1065 end;
1066 if (slMOTD <> '') and (mlist[f].slMOTD <> '') then
1067 begin
1068 slMOTD := mlist[f].slMOTD;
1069 end;
1070 end;
1071
1072 DisconnectAll();
1073
1074 if (length(SL) = 0) then
1075 begin
1076 CheckLocalServers();
1077 exit;
1078 end;
1079
1080 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1081 if Sock = ENET_SOCKET_NULL then Exit;
1082 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
1083
1084 for I := Low(SL) to High(SL) do PingServer(SL[I], Sock);
1085
1086 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
1087 PingBcast(Sock);
1088
1089 T := GetTimerMS();
1090
1091 InMsg.Alloc(NET_BUFSIZE);
1092 Buf.data := InMsg.Data;
1093 Buf.dataLength := InMsg.MaxSize;
1094 Cnt := 0;
1095 while GetTimerMS() - T <= 500 do
1096 begin
1097 InMsg.Clear();
1098
1099 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
1100 if RX <= 0 then continue;
1101 InMsg.CurSize := RX;
1102
1103 InMsg.BeginReading();
1104
1105 if InMsg.ReadChar() <> 'D' then continue;
1106 if InMsg.ReadChar() <> 'F' then continue;
1107
1108 FromSL := False;
1109 for I := Low(SL) to High(SL) do
1110 if (SL[I].PingAddr.host = SvAddr.host) and
1111 (SL[I].PingAddr.port = SvAddr.port) then
1112 begin
1113 with SL[I] do
1114 begin
1115 Port := InMsg.ReadWord();
1116 Ping := InMsg.ReadInt64();
1117 Ping := GetTimerMS() - Ping;
1118 Name := InMsg.ReadString();
1119 Map := InMsg.ReadString();
1120 GameMode := InMsg.ReadByte();
1121 Players := InMsg.ReadByte();
1122 MaxPlayers := InMsg.ReadByte();
1123 Protocol := InMsg.ReadByte();
1124 Password := InMsg.ReadByte() = 1;
1125 LocalPl := InMsg.ReadByte();
1126 Bots := InMsg.ReadWord();
1127 end;
1128 FromSL := True;
1129 Inc(Cnt);
1130 break;
1131 end;
1132 if not FromSL then
1133 ProcessLocal();
1134 end;
1135
1136 InMsg.Free();
1137 enet_socket_destroy(Sock);
1138 finally
1139 NetOut.Clear();
1140 end;
1141 end;
1142
1143
1144 //==========================================================================
1145 //
1146 // GetServerFromTable
1147 //
1148 //==========================================================================
1149 function GetServerFromTable (Index: Integer; SL: TNetServerList; ST: TNetServerTable): TNetServer;
1150 begin
1151 Result.Number := 0;
1152 Result.Protocol := 0;
1153 Result.Name := '';
1154 Result.IP := '';
1155 Result.Port := 0;
1156 Result.Map := '';
1157 Result.Players := 0;
1158 Result.MaxPlayers := 0;
1159 Result.LocalPl := 0;
1160 Result.Bots := 0;
1161 Result.Ping := 0;
1162 Result.GameMode := 0;
1163 Result.Password := false;
1164 FillChar(Result.PingAddr, SizeOf(ENetAddress), 0);
1165 if ST = nil then
1166 Exit;
1167 if (Index < 0) or (Index >= Length(ST)) then
1168 Exit;
1169 Result := SL[ST[Index].Indices[ST[Index].Current]];
1170 end;
1171
1172
1173 //==========================================================================
1174 //
1175 // g_Serverlist_Draw
1176 //
1177 //==========================================================================
1178 procedure g_Serverlist_Draw (var SL: TNetServerList; var ST: TNetServerTable);
1179 var
1180 Srv: TNetServer;
1181 sy, i, y, mw, mx, l, motdh: Integer;
1182 cw: Byte = 0;
1183 ch: Byte = 0;
1184 ww: Word = 0;
1185 hh: Word = 0;
1186 ip: AnsiString;
1187 begin
1188 ip := '';
1189 sy := 0;
1190
1191 e_CharFont_GetSize(gMenuFont, _lc[I_NET_SLIST], ww, hh);
1192 e_CharFont_Print(gMenuFont, (gScreenWidth div 2) - (ww div 2), 16, _lc[I_NET_SLIST]);
1193
1194 e_TextureFontGetSize(gStdFont, cw, ch);
1195
1196 ip := _lc[I_NET_SLIST_HELP];
1197 mw := (Length(ip) * cw) div 2;
1198
1199 motdh := gScreenHeight - 49 - ch * b_Text_LineCount(slMOTD);
1200
1201 e_DrawFillQuad(16, 64, gScreenWidth-16, motdh, 64, 64, 64, 110);
1202 e_DrawQuad(16, 64, gScreenWidth-16, motdh, 255, 127, 0);
1203
1204 e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
1205
1206 // MOTD
1207 if slMOTD <> '' then
1208 begin
1209 e_DrawFillQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
1210 e_DrawQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
1211 e_TextureFontPrintFmt(20, motdh + 3, slMOTD, gStdFont, False, True);
1212 end;
1213
1214 // Urgent message
1215 if not slReadUrgent and (slUrgent <> '') then
1216 begin
1217 e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
1218 e_DrawFillQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
1219 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 64, 64, 64, 128);
1220 e_DrawQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
1221 gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 255, 127, 0);
1222 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 - 40,
1223 gScreenWidth div 2 + 256, gScreenHeight div 2 - 40, 255, 127, 0);
1224 l := Length(_lc[I_NET_SLIST_URGENT]) div 2;
1225 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - 58,
1226 _lc[I_NET_SLIST_URGENT], gStdFont);
1227 l := Length(slUrgent) div 2;
1228 e_TextureFontPrintFmt(gScreenWidth div 2 - 253, gScreenHeight div 2 - 38,
1229 slUrgent, gStdFont, False, True);
1230 l := Length(_lc[I_NET_SLIST_URGENT_CONT]) div 2;
1231 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 + 41,
1232 _lc[I_NET_SLIST_URGENT_CONT], gStdFont);
1233 e_DrawLine(1, gScreenWidth div 2 - 256, gScreenHeight div 2 + 40,
1234 gScreenWidth div 2 + 256, gScreenHeight div 2 + 40, 255, 127, 0);
1235 Exit;
1236 end;
1237
1238 if SL = nil then
1239 begin
1240 l := Length(slWaitStr) div 2;
1241 e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
1242 e_DrawQuad(gScreenWidth div 2 - 192, gScreenHeight div 2 - 10,
1243 gScreenWidth div 2 + 192, gScreenHeight div 2 + 11, 255, 127, 0);
1244 e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - ch div 2,
1245 slWaitStr, gStdFont);
1246 Exit;
1247 end;
1248
1249 y := 90;
1250 if (slSelection < Length(ST)) then
1251 begin
1252 I := slSelection;
1253 sy := y + 42 * I - 4;
1254 Srv := GetServerFromTable(I, SL, ST);
1255 ip := _lc[I_NET_ADDRESS] + ' ' + Srv.IP + ':' + IntToStr(Srv.Port);
1256 if Srv.Password then
1257 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_YES]
1258 else
1259 ip := ip + ' ' + _lc[I_NET_SERVER_PASSWORD] + ' ' + _lc[I_MENU_NO];
1260 end else
1261 if Length(ST) > 0 then
1262 slSelection := 0;
1263
1264 mw := (gScreenWidth - 188);
1265 mx := 16 + mw;
1266
1267 e_DrawFillQuad(16 + 1, sy, gScreenWidth - 16 - 1, sy + 40, 64, 64, 64, 0);
1268 e_DrawLine(1, 16 + 1, sy, gScreenWidth - 16 - 1, sy, 205, 205, 205);
1269 e_DrawLine(1, 16 + 1, sy + 41, gScreenWidth - 16 - 1, sy + 41, 255, 255, 255);
1270
1271 e_DrawLine(1, 16, 85, gScreenWidth - 16, 85, 255, 127, 0);
1272 e_DrawLine(1, 16, motdh-20, gScreenWidth-16, motdh-20, 255, 127, 0);
1273
1274 e_DrawLine(1, mx - 70, 64, mx - 70, motdh, 255, 127, 0);
1275 e_DrawLine(1, mx, 64, mx, motdh-20, 255, 127, 0);
1276 e_DrawLine(1, mx + 52, 64, mx + 52, motdh-20, 255, 127, 0);
1277 e_DrawLine(1, mx + 104, 64, mx + 104, motdh-20, 255, 127, 0);
1278
1279 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
1280 e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
1281 e_TextureFontPrintEx(mx + 2, 68, 'MODE', gStdFont, 255, 127, 0, 1);
1282 e_TextureFontPrintEx(mx + 54, 68, 'PLRS', gStdFont, 255, 127, 0, 1);
1283 e_TextureFontPrintEx(mx + 106, 68, 'VER', gStdFont, 255, 127, 0, 1);
1284
1285 y := 90;
1286 for I := 0 to High(ST) do
1287 begin
1288 Srv := GetServerFromTable(I, SL, ST);
1289 // Name and map
1290 e_TextureFontPrintEx(18, y, Srv.Name, gStdFont, 255, 255, 255, 1);
1291 e_TextureFontPrintEx(18, y + 16, Srv.Map, gStdFont, 210, 210, 210, 1);
1292
1293 // Ping and similar count
1294 if (Srv.Ping < 0) or (Srv.Ping > 999) then
1295 e_TextureFontPrintEx(mx - 68, y, _lc[I_NET_SLIST_NO_ACCESS], gStdFont, 255, 0, 0, 1)
1296 else
1297 if Srv.Ping = 0 then
1298 e_TextureFontPrintEx(mx - 68, y, '<1' + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1)
1299 else
1300 e_TextureFontPrintEx(mx - 68, y, IntToStr(Srv.Ping) + _lc[I_NET_SLIST_PING_MS], gStdFont, 255, 255, 255, 1);
1301
1302 if Length(ST[I].Indices) > 1 then
1303 e_TextureFontPrintEx(mx - 68, y + 16, '< ' + IntToStr(Length(ST[I].Indices)) + ' >', gStdFont, 210, 210, 210, 1);
1304
1305 // Game mode
1306 e_TextureFontPrintEx(mx + 2, y, g_Game_ModeToText(Srv.GameMode), gStdFont, 255, 255, 255, 1);
1307
1308 // Players
1309 e_TextureFontPrintEx(mx + 54, y, IntToStr(Srv.Players) + '/' + IntToStr(Srv.MaxPlayers), gStdFont, 255, 255, 255, 1);
1310 e_TextureFontPrintEx(mx + 54, y + 16, IntToStr(Srv.LocalPl) + '+' + IntToStr(Srv.Bots), gStdFont, 210, 210, 210, 1);
1311
1312 // Version
1313 e_TextureFontPrintEx(mx + 106, y, IntToStr(Srv.Protocol), gStdFont, 255, 255, 255, 1);
1314
1315 y := y + 42;
1316 end;
1317
1318 e_TextureFontPrintEx(20, motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
1319 ip := IntToStr(Length(ST)) + _lc[I_NET_SLIST_SERVERS];
1320 e_TextureFontPrintEx(gScreenWidth - 48 - (Length(ip) + 1)*cw,
1321 motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
1322 end;
1323
1324
1325 //==========================================================================
1326 //
1327 // g_Serverlist_GenerateTable
1328 //
1329 //==========================================================================
1330 procedure g_Serverlist_GenerateTable (SL: TNetServerList; var ST: TNetServerTable);
1331 var
1332 i, j: Integer;
1333
1334 function FindServerInTable(Name: AnsiString): Integer;
1335 var
1336 i: Integer;
1337 begin
1338 Result := -1;
1339 if ST = nil then
1340 Exit;
1341 for i := Low(ST) to High(ST) do
1342 begin
1343 if Length(ST[i].Indices) = 0 then
1344 continue;
1345 if SL[ST[i].Indices[0]].Name = Name then
1346 begin
1347 Result := i;
1348 Exit;
1349 end;
1350 end;
1351 end;
1352 function ComparePing(i1, i2: Integer): Boolean;
1353 var
1354 p1, p2: Int64;
1355 begin
1356 p1 := SL[i1].Ping;
1357 p2 := SL[i2].Ping;
1358 if (p1 < 0) then p1 := 999;
1359 if (p2 < 0) then p2 := 999;
1360 Result := p1 > p2;
1361 end;
1362 procedure SortIndices(var ind: Array of Integer);
1363 var
1364 I, J: Integer;
1365 T: Integer;
1366 begin
1367 for I := High(ind) downto Low(ind) do
1368 for J := Low(ind) to High(ind) - 1 do
1369 if ComparePing(ind[j], ind[j+1]) then
1370 begin
1371 T := ind[j];
1372 ind[j] := ind[j+1];
1373 ind[j+1] := T;
1374 end;
1375 end;
1376 procedure SortRows();
1377 var
1378 I, J: Integer;
1379 T: TNetServerRow;
1380 begin
1381 for I := High(ST) downto Low(ST) do
1382 for J := Low(ST) to High(ST) - 1 do
1383 if ComparePing(ST[j].Indices[0], ST[j+1].Indices[0]) then
1384 begin
1385 T := ST[j];
1386 ST[j] := ST[j+1];
1387 ST[j+1] := T;
1388 end;
1389 end;
1390 begin
1391 ST := nil;
1392 if SL = nil then
1393 Exit;
1394 for i := Low(SL) to High(SL) do
1395 begin
1396 j := FindServerInTable(SL[i].Name);
1397 if j = -1 then
1398 begin
1399 j := Length(ST);
1400 SetLength(ST, j + 1);
1401 ST[j].Current := 0;
1402 SetLength(ST[j].Indices, 1);
1403 ST[j].Indices[0] := i;
1404 end
1405 else
1406 begin
1407 SetLength(ST[j].Indices, Length(ST[j].Indices) + 1);
1408 ST[j].Indices[High(ST[j].Indices)] := i;
1409 end;
1410 end;
1411
1412 for i := Low(ST) to High(ST) do
1413 SortIndices(ST[i].Indices);
1414
1415 SortRows();
1416 end;
1417
1418
1419 //==========================================================================
1420 //
1421 // g_Serverlist_Control
1422 //
1423 //==========================================================================
1424 procedure g_Serverlist_Control (var SL: TNetServerList; var ST: TNetServerTable);
1425 var
1426 qm: Boolean;
1427 Srv: TNetServer;
1428 begin
1429 if gConsoleShow or gChatShow then
1430 Exit;
1431
1432 qm := sys_HandleInput(); // this updates kbd
1433
1434 if qm or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
1435 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or
1436 e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
1437 begin
1438 SL := nil;
1439 ST := nil;
1440 gState := STATE_MENU;
1441 g_GUI_ShowWindow('MainMenu');
1442 g_GUI_ShowWindow('NetGameMenu');
1443 g_GUI_ShowWindow('NetClientMenu');
1444 g_Sound_PlayEx(WINDOW_CLOSESOUND);
1445 Exit;
1446 end;
1447
1448 // if there's a message on the screen,
1449 if not slReadUrgent and (slUrgent <> '') then
1450 begin
1451 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1452 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1453 slReadUrgent := True;
1454 Exit;
1455 end;
1456
1457 if e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_JUMP) or
1458 e_KeyPressed(JOY0_ACTIVATE) or e_KeyPressed(JOY1_ACTIVATE) or e_KeyPressed(JOY2_ACTIVATE) or e_KeyPressed(JOY3_ACTIVATE) then
1459 begin
1460 if not slFetched then
1461 begin
1462 slWaitStr := _lc[I_NET_SLIST_WAIT];
1463
1464 g_Game_Draw;
1465 sys_Repaint;
1466
1467 if g_Net_Slist_Fetch(SL) then
1468 begin
1469 if SL = nil then
1470 slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
1471 end
1472 else
1473 if SL = nil then
1474 slWaitStr := _lc[I_NET_SLIST_ERROR];
1475 slFetched := True;
1476 slSelection := 0;
1477 g_Serverlist_GenerateTable(SL, ST);
1478 end;
1479 end
1480 else
1481 slFetched := False;
1482
1483 if SL = nil then Exit;
1484
1485 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1486 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1487 begin
1488 if not slReturnPressed then
1489 begin
1490 Srv := GetServerFromTable(slSelection, SL, ST);
1491 if Srv.Password then
1492 begin
1493 PromptIP := Srv.IP;
1494 PromptPort := Srv.Port;
1495 gState := STATE_MENU;
1496 g_GUI_ShowWindow('ClientPasswordMenu');
1497 SL := nil;
1498 ST := nil;
1499 slReturnPressed := True;
1500 Exit;
1501 end
1502 else
1503 g_Game_StartClient(Srv.IP, Srv.Port, '');
1504 SL := nil;
1505 ST := nil;
1506 slReturnPressed := True;
1507 Exit;
1508 end;
1509 end
1510 else
1511 slReturnPressed := False;
1512
1513 if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) or e_KeyPressed(VK_DOWN) or
1514 e_KeyPressed(JOY0_DOWN) or e_KeyPressed(JOY1_DOWN) or e_KeyPressed(JOY2_DOWN) or e_KeyPressed(JOY3_DOWN) then
1515 begin
1516 if not slDirPressed then
1517 begin
1518 Inc(slSelection);
1519 if slSelection > High(ST) then slSelection := 0;
1520 slDirPressed := True;
1521 end;
1522 end;
1523
1524 if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) or e_KeyPressed(VK_UP) or
1525 e_KeyPressed(JOY0_UP) or e_KeyPressed(JOY1_UP) or e_KeyPressed(JOY2_UP) or e_KeyPressed(JOY3_UP) then
1526 begin
1527 if not slDirPressed then
1528 begin
1529 if slSelection = 0 then slSelection := Length(ST);
1530 Dec(slSelection);
1531
1532 slDirPressed := True;
1533 end;
1534 end;
1535
1536 if e_KeyPressed(IK_RIGHT) or e_KeyPressed(IK_KPRIGHT) or e_KeyPressed(VK_RIGHT) or
1537 e_KeyPressed(JOY0_RIGHT) or e_KeyPressed(JOY1_RIGHT) or e_KeyPressed(JOY2_RIGHT) or e_KeyPressed(JOY3_RIGHT) then
1538 begin
1539 if not slDirPressed then
1540 begin
1541 Inc(ST[slSelection].Current);
1542 if ST[slSelection].Current > High(ST[slSelection].Indices) then ST[slSelection].Current := 0;
1543 slDirPressed := True;
1544 end;
1545 end;
1546
1547 if e_KeyPressed(IK_LEFT) or e_KeyPressed(IK_KPLEFT) or e_KeyPressed(VK_LEFT) or
1548 e_KeyPressed(JOY0_LEFT) or e_KeyPressed(JOY1_LEFT) or e_KeyPressed(JOY2_LEFT) or e_KeyPressed(JOY3_LEFT) then
1549 begin
1550 if not slDirPressed then
1551 begin
1552 if ST[slSelection].Current = 0 then ST[slSelection].Current := Length(ST[slSelection].Indices);
1553 Dec(ST[slSelection].Current);
1554
1555 slDirPressed := True;
1556 end;
1557 end;
1558
1559 if (not e_KeyPressed(IK_DOWN)) and
1560 (not e_KeyPressed(IK_UP)) and
1561 (not e_KeyPressed(IK_RIGHT)) and
1562 (not e_KeyPressed(IK_LEFT)) and
1563 (not e_KeyPressed(IK_KPDOWN)) and
1564 (not e_KeyPressed(IK_KPUP)) and
1565 (not e_KeyPressed(IK_KPRIGHT)) and
1566 (not e_KeyPressed(IK_KPLEFT)) and
1567 (not e_KeyPressed(VK_DOWN)) and
1568 (not e_KeyPressed(VK_UP)) and
1569 (not e_KeyPressed(VK_RIGHT)) and
1570 (not e_KeyPressed(VK_LEFT)) and
1571 (not e_KeyPressed(JOY0_UP)) and (not e_KeyPressed(JOY1_UP)) and (not e_KeyPressed(JOY2_UP)) and (not e_KeyPressed(JOY3_UP)) and
1572 (not e_KeyPressed(JOY0_DOWN)) and (not e_KeyPressed(JOY1_DOWN)) and (not e_KeyPressed(JOY2_DOWN)) and (not e_KeyPressed(JOY3_DOWN)) and
1573 (not e_KeyPressed(JOY0_LEFT)) and (not e_KeyPressed(JOY1_LEFT)) and (not e_KeyPressed(JOY2_LEFT)) and (not e_KeyPressed(JOY3_LEFT)) and
1574 (not e_KeyPressed(JOY0_RIGHT)) and (not e_KeyPressed(JOY1_RIGHT)) and (not e_KeyPressed(JOY2_RIGHT)) and (not e_KeyPressed(JOY3_RIGHT))
1575 then
1576 slDirPressed := False;
1577 end;
1578
1579
1580 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024