DEADSOFTWARE

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