1 (* Copyright (C) Doom 2D: Forever Developers
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, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
41 Players
, MaxPlayers
, LocalPl
, Bots
: Byte;
45 PingAddr
: ENetAddress
;
47 pTNetServer
= ^TNetServer
;
48 TNetServerRow
= record
49 Indices
: Array of Integer;
53 TNetServerList
= array of TNetServer
;
54 pTNetServerList
= ^TNetServerList
;
55 TNetServerTable
= array of TNetServerRow
;
58 NetMHost
: pENetHost
= nil;
59 NetMPeer
: pENetPeer
= nil;
61 slCurrent
: TNetServerList
= nil;
62 slTable
: TNetServerTable
= nil;
63 slWaitStr
: string = '';
64 slReturnPressed
: Boolean = True;
66 procedure g_Net_Slist_Set(IP
: string; Port
: Word);
67 function g_Net_Slist_Fetch(var SL
: TNetServerList
): Boolean;
68 procedure g_Net_Slist_Update();
69 procedure g_Net_Slist_Remove();
70 function g_Net_Slist_Connect(): Boolean;
71 procedure g_Net_Slist_Check();
72 procedure g_Net_Slist_Disconnect();
73 procedure g_Net_Slist_WriteInfo();
75 procedure g_Serverlist_GenerateTable(SL
: TNetServerList
; var ST
: TNetServerTable
);
76 procedure g_Serverlist_Draw(var SL
: TNetServerList
; var ST
: TNetServerTable
);
77 procedure g_Serverlist_Control(var SL
: TNetServerList
; var ST
: TNetServerTable
);
82 SysUtils
, e_msg
, e_input
, e_graphics
, e_log
, g_window
, g_net
, g_console
,
83 g_map
, g_game
, g_sound
, g_gui
, g_menu
, g_options
, g_language
, wadreader
;
87 slSelection
: Byte = 0;
88 slFetched
: Boolean = False;
89 slDirPressed
: Boolean = False;
91 function GetTimerMS(): Int64;
93 Result
:= GetTimer() {div 1000};
96 procedure PingServer(var S
: TNetServer
; Sock
: ENetSocket
);
99 Ping
: array [0..9] of Byte;
102 ClTime
:= GetTimerMS();
104 Buf
.data
:= Addr(Ping
[0]);
105 Buf
.dataLength
:= 2+8;
109 Int64(Addr(Ping
[2])^) := ClTime
;
111 enet_socket_send(Sock
, Addr(S
.PingAddr
), @Buf
, 1);
114 procedure PingBcast(Sock
: ENetSocket
);
118 S
.IP
:= '255.255.255.255';
119 S
.Port
:= NET_PING_PORT
;
120 enet_address_set_host(Addr(S
.PingAddr
), PChar(Addr(S
.IP
[1])));
122 S
.PingAddr
.port
:= S
.Port
;
126 function g_Net_Slist_Fetch(var SL
: TNetServerList
): Boolean;
139 procedure ProcessLocal();
142 SetLength(SL
, I
+ 1);
145 IP
:= DecodeIPV4(SvAddr
.host
);
146 Port
:= InMsg
.ReadWord();
147 Ping
:= InMsg
.ReadInt64();
148 Ping
:= GetTimerMS() - Ping
;
149 Name
:= InMsg
.ReadString();
150 Map
:= InMsg
.ReadString();
151 GameMode
:= InMsg
.ReadByte();
152 Players
:= InMsg
.ReadByte();
153 MaxPlayers
:= InMsg
.ReadByte();
154 Protocol
:= InMsg
.ReadByte();
155 Password
:= InMsg
.ReadByte() = 1;
156 LocalPl
:= InMsg
.ReadByte();
157 Bots
:= InMsg
.ReadWord();
160 procedure CheckLocalServers();
164 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
165 if Sock
= ENET_SOCKET_NULL
then Exit
;
166 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
167 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
172 InMsg
.Alloc(NET_BUFSIZE
);
173 Buf
.data
:= InMsg
.Data
;
174 Buf
.dataLength
:= InMsg
.MaxSize
;
175 while GetTimerMS() - T
<= 500 do
179 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
180 if RX
<= 0 then continue
;
183 InMsg
.BeginReading();
185 if InMsg
.ReadChar() <> 'D' then continue
;
186 if InMsg
.ReadChar() <> 'F' then continue
;
192 enet_socket_destroy(Sock
);
194 if Length(SL
) = 0 then SL
:= nil;
200 if (NetMHost
<> nil) or (NetMPeer
<> nil) then
206 if not g_Net_Slist_Connect
then
212 e_WriteLog('Fetching serverlist...', TMsgType
.Notify
);
213 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_FETCH
]);
216 NetOut
.Write(Byte(NET_MMSG_GET
));
218 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
219 enet_peer_send(NetMPeer
, NET_MCHAN_MAIN
, P
);
220 enet_host_flush(NetMHost
);
222 while enet_host_service(NetMHost
, @NetMEvent
, 5000) > 0 do
224 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
226 if not InMsg
.Init(NetMEvent
.packet
^.data
, NetMEvent
.packet
^.dataLength
, True) then continue
;
228 MID
:= InMsg
.ReadByte();
230 if MID
<> NET_MMSG_GET
then continue
;
232 Cnt
:= InMsg
.ReadByte();
233 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_SLIST_RETRIEVED
], [Cnt
]), True);
239 for I
:= 0 to Cnt
- 1 do
242 SL
[I
].IP
:= InMsg
.ReadString();
243 SL
[I
].Port
:= InMsg
.ReadWord();
244 SL
[I
].Name
:= InMsg
.ReadString();
245 SL
[I
].Map
:= InMsg
.ReadString();
246 SL
[I
].GameMode
:= InMsg
.ReadByte();
247 SL
[I
].Players
:= InMsg
.ReadByte();
248 SL
[I
].MaxPlayers
:= InMsg
.ReadByte();
249 SL
[I
].Protocol
:= InMsg
.ReadByte();
250 SL
[I
].Password
:= InMsg
.ReadByte() = 1;
251 enet_address_set_host(Addr(SL
[I
].PingAddr
), PChar(Addr(SL
[I
].IP
[1])));
253 SL
[I
].PingAddr
.port
:= NET_PING_PORT
;
262 g_Net_Slist_Disconnect
;
265 if Length(SL
) = 0 then
271 Sock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
272 if Sock
= ENET_SOCKET_NULL
then Exit
;
273 enet_socket_set_option(Sock
, ENET_SOCKOPT_NONBLOCK
, 1);
275 for I
:= Low(SL
) to High(SL
) do
276 PingServer(SL
[I
], Sock
);
278 enet_socket_set_option(Sock
, ENET_SOCKOPT_BROADCAST
, 1);
283 InMsg
.Alloc(NET_BUFSIZE
);
284 Buf
.data
:= InMsg
.Data
;
285 Buf
.dataLength
:= InMsg
.MaxSize
;
287 while GetTimerMS() - T
<= 500 do
291 RX
:= enet_socket_receive(Sock
, @SvAddr
, @Buf
, 1);
292 if RX
<= 0 then continue
;
295 InMsg
.BeginReading();
297 if InMsg
.ReadChar() <> 'D' then continue
;
298 if InMsg
.ReadChar() <> 'F' then continue
;
301 for I
:= Low(SL
) to High(SL
) do
302 if (SL
[I
].PingAddr
.host
= SvAddr
.host
) and
303 (SL
[I
].PingAddr
.port
= SvAddr
.port
) then
307 Port
:= InMsg
.ReadWord();
308 Ping
:= InMsg
.ReadInt64();
309 Ping
:= GetTimerMS() - Ping
;
310 Name
:= InMsg
.ReadString();
311 Map
:= InMsg
.ReadString();
312 GameMode
:= InMsg
.ReadByte();
313 Players
:= InMsg
.ReadByte();
314 MaxPlayers
:= InMsg
.ReadByte();
315 Protocol
:= InMsg
.ReadByte();
316 Password
:= InMsg
.ReadByte() = 1;
317 LocalPl
:= InMsg
.ReadByte();
318 Bots
:= InMsg
.ReadWord();
329 enet_socket_destroy(Sock
);
332 procedure g_Net_Slist_WriteInfo();
337 Wad
:= g_ExtractWadNameNoPath(gMapInfo
.Map
);
338 Map
:= g_ExtractFileName(gMapInfo
.Map
);
340 NetOut
.Write(NetServerName
);
342 NetOut
.Write(Wad
+ ':\' + Map
);
343 NetOut
.Write(gGameSettings
.GameMode
);
345 Cli
:= NetClientCount
;
348 NetOut
.Write(NetMaxClients
);
350 NetOut
.Write(Byte(NET_PROTOCOL_VER
));
351 NetOut
.Write(Byte(NetPassword
<> ''));
354 procedure g_Net_Slist_Update
;
360 if (NetMHost
= nil) or (NetMPeer
= nil) then Exit
;
363 NetOut
.Write(Byte(NET_MMSG_UPD
));
364 NetOut
.Write(NetAddr
.port
);
366 g_Net_Slist_WriteInfo();
368 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
369 enet_peer_send(NetMPeer
, NET_MCHAN_UPD
, P
);
371 enet_host_flush(NetMHost
);
375 procedure g_Net_Slist_Remove
;
379 if (NetMHost
= nil) or (NetMPeer
= nil) then Exit
;
381 NetOut
.Write(Byte(NET_MMSG_DEL
));
382 NetOut
.Write(NetAddr
.port
);
384 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, Cardinal(ENET_PACKET_FLAG_RELIABLE
));
385 enet_peer_send(NetMPeer
, NET_MCHAN_MAIN
, P
);
387 enet_host_flush(NetMHost
);
391 function g_Net_Slist_Connect
: Boolean;
395 NetMHost
:= enet_host_create(nil, 1, NET_MCHANS
, 0, 0);
396 if (NetMHost
= nil) then
398 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
402 NetMPeer
:= enet_host_connect(NetMHost
, @NetSlistAddr
, NET_MCHANS
, 0);
403 if (NetMPeer
= nil) then
405 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
406 enet_host_destroy(NetMHost
);
411 if (enet_host_service(NetMHost
, @NetMEvent
, 3000) > 0) then
412 if NetMEvent
.kind
= ENET_EVENT_TYPE_CONNECT
then
415 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_CONN
]);
419 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
420 enet_packet_destroy(NetMEvent
.packet
);
422 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_SLIST_ERROR
], True);
428 procedure g_Net_Slist_Disconnect
;
430 if (NetMHost
= nil) and (NetMPeer
= nil) then Exit
;
432 if NetMode
= NET_SERVER
then g_Net_Slist_Remove
;
434 enet_peer_disconnect(NetMPeer
, 0);
435 enet_host_flush(NetMHost
);
437 enet_peer_reset(NetMPeer
);
438 enet_host_destroy(NetMHost
);
443 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_DISC
]);
446 procedure g_Net_Slist_Check
;
448 if (NetMHost
= nil) or (NetMPeer
= nil) then Exit
;
450 while (enet_host_service(NetMHost
, @NetMEvent
, 0) > 0) do
452 if NetMEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
then
454 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_SLIST_LOST
], True);
455 if NetMPeer
<> nil then enet_peer_reset(NetMPeer
);
456 if NetMHost
<> nil then enet_host_destroy(NetMHost
);
462 if NetMEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
463 enet_packet_destroy(NetMEvent
.packet
);
467 procedure g_Net_Slist_Set(IP
: string; Port
: Word);
471 enet_address_set_host(@NetSlistAddr
, PChar(Addr(IP
[1])));
472 NetSlistAddr
.Port
:= Port
;
473 e_WriteLog('Masterserver address set to ' + IP
+ ':' + IntToStr(Port
), TMsgType
.Notify
);
477 function GetServerFromTable(Index
: Integer; SL
: TNetServerList
; ST
: TNetServerTable
): TNetServer
;
480 Result
.Protocol
:= 0;
486 Result
.MaxPlayers
:= 0;
490 Result
.GameMode
:= 0;
491 Result
.Password
:= false;
492 FillChar(Result
.PingAddr
, SizeOf(ENetAddress
), 0);
495 if (Index
< 0) or (Index
>= Length(ST
)) then
497 Result
:= SL
[ST
[Index
].Indices
[ST
[Index
].Current
]];
500 procedure g_Serverlist_Draw(var SL
: TNetServerList
; var ST
: TNetServerTable
);
503 sy
, i
, y
, mw
, mx
, l
: Integer;
513 e_CharFont_GetSize(gMenuFont
, _lc
[I_NET_SLIST
], ww
, hh
);
514 e_CharFont_Print(gMenuFont
, (gScreenWidth
div 2) - (ww
div 2), 16, _lc
[I_NET_SLIST
]);
516 e_TextureFontGetSize(gStdFont
, cw
, ch
);
518 ip
:= _lc
[I_NET_SLIST_HELP
];
519 mw
:= (Length(ip
) * cw
) div 2;
521 e_DrawFillQuad(16, 64, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 110);
522 e_DrawQuad(16, 64, gScreenWidth
-16, gScreenHeight
-44, 255, 127, 0);
524 e_TextureFontPrintEx(gScreenWidth
div 2 - mw
, gScreenHeight
-24, ip
, gStdFont
, 225, 225, 225, 1);
528 l
:= Length(slWaitStr
) div 2;
529 e_DrawFillQuad(16, 64, gScreenWidth
-16, gScreenHeight
-44, 64, 64, 64, 128);
530 e_DrawQuad(gScreenWidth
div 2 - 192, gScreenHeight
div 2 - 10,
531 gScreenWidth
div 2 + 192, gScreenHeight
div 2 + 11, 255, 127, 0);
532 e_TextureFontPrint(gScreenWidth
div 2 - cw
* l
, gScreenHeight
div 2 - ch
div 2,
533 slWaitStr
, gStdFont
);
538 if (slSelection
< Length(ST
)) then
541 sy
:= y
+ 42 * I
- 4;
542 Srv
:= GetServerFromTable(I
, SL
, ST
);
543 ip
:= _lc
[I_NET_ADDRESS
] + ' ' + Srv
.IP
+ ':' + IntToStr(Srv
.Port
);
545 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_YES
]
547 ip
:= ip
+ ' ' + _lc
[I_NET_SERVER_PASSWORD
] + ' ' + _lc
[I_MENU_NO
];
549 if Length(ST
) > 0 then
552 mw
:= (gScreenWidth
- 188);
555 e_DrawFillQuad(16 + 1, sy
, gScreenWidth
- 16 - 1, sy
+ 40, 64, 64, 64, 0);
556 e_DrawLine(1, 16 + 1, sy
, gScreenWidth
- 16 - 1, sy
, 205, 205, 205);
557 e_DrawLine(1, 16 + 1, sy
+ 41, gScreenWidth
- 16 - 1, sy
+ 41, 255, 255, 255);
559 e_DrawLine(1, 16, 85, gScreenWidth
- 16, 85, 255, 127, 0);
560 e_DrawLine(1, 16, gScreenHeight
-64, gScreenWidth
-16, gScreenHeight
-64, 255, 127, 0);
562 e_DrawLine(1, mx
- 70, 64, mx
- 70, gScreenHeight
-44, 255, 127, 0);
563 e_DrawLine(1, mx
, 64, mx
, gScreenHeight
-64, 255, 127, 0);
564 e_DrawLine(1, mx
+ 52, 64, mx
+ 52, gScreenHeight
-64, 255, 127, 0);
565 e_DrawLine(1, mx
+ 104, 64, mx
+ 104, gScreenHeight
-64, 255, 127, 0);
567 e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont
, 255, 127, 0, 1);
568 e_TextureFontPrintEx(mx
- 68, 68, 'PING', gStdFont
, 255, 127, 0, 1);
569 e_TextureFontPrintEx(mx
+ 2, 68, 'MODE', gStdFont
, 255, 127, 0, 1);
570 e_TextureFontPrintEx(mx
+ 54, 68, 'PLRS', gStdFont
, 255, 127, 0, 1);
571 e_TextureFontPrintEx(mx
+ 106, 68, 'VER', gStdFont
, 255, 127, 0, 1);
574 for I
:= 0 to High(ST
) do
576 Srv
:= GetServerFromTable(I
, SL
, ST
);
578 e_TextureFontPrintEx(18, y
, Srv
.Name
, gStdFont
, 255, 255, 255, 1);
579 e_TextureFontPrintEx(18, y
+ 16, Srv
.Map
, gStdFont
, 210, 210, 210, 1);
581 // Ping and similar count
582 if (Srv
.Ping
< 0) or (Srv
.Ping
> 999) then
583 e_TextureFontPrintEx(mx
- 68, y
, _lc
[I_NET_SLIST_NO_ACCESS
], gStdFont
, 255, 0, 0, 1)
586 e_TextureFontPrintEx(mx
- 68, y
, '<1' + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1)
588 e_TextureFontPrintEx(mx
- 68, y
, IntToStr(Srv
.Ping
) + _lc
[I_NET_SLIST_PING_MS
], gStdFont
, 255, 255, 255, 1);
590 if Length(ST
[I
].Indices
) > 1 then
591 e_TextureFontPrintEx(mx
- 68, y
+ 16, '< ' + IntToStr(Length(ST
[I
].Indices
)) + ' >', gStdFont
, 210, 210, 210, 1);
594 e_TextureFontPrintEx(mx
+ 2, y
, g_Game_ModeToText(Srv
.GameMode
), gStdFont
, 255, 255, 255, 1);
597 e_TextureFontPrintEx(mx
+ 54, y
, IntToStr(Srv
.Players
) + '/' + IntToStr(Srv
.MaxPlayers
), gStdFont
, 255, 255, 255, 1);
598 e_TextureFontPrintEx(mx
+ 54, y
+ 16, IntToStr(Srv
.LocalPl
) + '+' + IntToStr(Srv
.Bots
), gStdFont
, 210, 210, 210, 1);
601 e_TextureFontPrintEx(mx
+ 106, y
, IntToStr(Srv
.Protocol
), gStdFont
, 255, 255, 255, 1);
606 e_TextureFontPrintEx(20, gScreenHeight
-61, ip
, gStdFont
, 205, 205, 205, 1);
607 ip
:= IntToStr(Length(ST
)) + _lc
[I_NET_SLIST_SERVERS
];
608 e_TextureFontPrintEx(gScreenWidth
- 48 - (Length(ip
) + 1)*cw
,
609 gScreenHeight
-61, ip
, gStdFont
, 205, 205, 205, 1);
612 procedure g_Serverlist_GenerateTable(SL
: TNetServerList
; var ST
: TNetServerTable
);
616 function FindServerInTable(Name
: string): Integer;
623 for i
:= Low(ST
) to High(ST
) do
625 if Length(ST
[i
].Indices
) = 0 then
627 if SL
[ST
[i
].Indices
[0]].Name
= Name
then
634 function ComparePing(i1
, i2
: Integer): Boolean;
640 if (p1
< 0) then p1
:= 999;
641 if (p2
< 0) then p2
:= 999;
644 procedure SortIndices(var ind
: Array of Integer);
649 for I
:= High(ind
) downto Low(ind
) do
650 for J
:= Low(ind
) to High(ind
) - 1 do
651 if ComparePing(ind
[j
], ind
[j
+1]) then
658 procedure SortRows();
663 for I
:= High(ST
) downto Low(ST
) do
664 for J
:= Low(ST
) to High(ST
) - 1 do
665 if ComparePing(ST
[j
].Indices
[0], ST
[j
+1].Indices
[0]) then
676 for i
:= Low(SL
) to High(SL
) do
678 j
:= FindServerInTable(SL
[i
].Name
);
682 SetLength(ST
, j
+ 1);
684 SetLength(ST
[j
].Indices
, 1);
685 ST
[j
].Indices
[0] := i
;
689 SetLength(ST
[j
].Indices
, Length(ST
[j
].Indices
) + 1);
690 ST
[j
].Indices
[High(ST
[j
].Indices
)] := i
;
694 for i
:= Low(ST
) to High(ST
) do
695 SortIndices(ST
[i
].Indices
);
700 procedure g_Serverlist_Control(var SL
: TNetServerList
; var ST
: TNetServerTable
);
705 if gConsoleShow
or gChatShow
then
708 qm
:= g_ProcessMessages(); // this updates kbd
710 if qm
or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) then
714 gState
:= STATE_MENU
;
715 g_GUI_ShowWindow('MainMenu');
716 g_GUI_ShowWindow('NetGameMenu');
717 g_GUI_ShowWindow('NetClientMenu');
718 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
722 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(VK_JUMP
) then
724 if not slFetched
then
726 slWaitStr
:= _lc
[I_NET_SLIST_WAIT
];
729 g_window
.ReDrawWindow
;
731 if g_Net_Slist_Fetch(SL
) then
734 slWaitStr
:= _lc
[I_NET_SLIST_NOSERVERS
];
738 slWaitStr
:= _lc
[I_NET_SLIST_ERROR
];
741 g_Serverlist_GenerateTable(SL
, ST
);
747 if SL
= nil then Exit
;
749 if e_KeyPressed(IK_RETURN
) or e_KeyPressed(IK_KPRETURN
) or e_KeyPressed(VK_FIRE
) or e_KeyPressed(VK_OPEN
) then
751 if not slReturnPressed
then
753 Srv
:= GetServerFromTable(slSelection
, SL
, ST
);
757 PromptPort
:= Srv
.Port
;
758 gState
:= STATE_MENU
;
759 g_GUI_ShowWindow('ClientPasswordMenu');
762 slReturnPressed
:= True;
766 g_Game_StartClient(Srv
.IP
, Srv
.Port
, '');
769 slReturnPressed
:= True;
774 slReturnPressed
:= False;
776 if e_KeyPressed(IK_DOWN
) or e_KeyPressed(IK_KPDOWN
) or e_KeyPressed(VK_DOWN
) then
778 if not slDirPressed
then
781 if slSelection
> High(ST
) then slSelection
:= 0;
782 slDirPressed
:= True;
786 if e_KeyPressed(IK_UP
) or e_KeyPressed(IK_KPUP
) or e_KeyPressed(VK_UP
) then
788 if not slDirPressed
then
790 if slSelection
= 0 then slSelection
:= Length(ST
);
793 slDirPressed
:= True;
797 if e_KeyPressed(IK_RIGHT
) or e_KeyPressed(IK_KPRIGHT
) or e_KeyPressed(VK_RIGHT
) then
799 if not slDirPressed
then
801 Inc(ST
[slSelection
].Current
);
802 if ST
[slSelection
].Current
> High(ST
[slSelection
].Indices
) then ST
[slSelection
].Current
:= 0;
803 slDirPressed
:= True;
807 if e_KeyPressed(IK_LEFT
) or e_KeyPressed(IK_KPLEFT
) or e_KeyPressed(VK_LEFT
) then
809 if not slDirPressed
then
811 if ST
[slSelection
].Current
= 0 then ST
[slSelection
].Current
:= Length(ST
[slSelection
].Indices
);
812 Dec(ST
[slSelection
].Current
);
814 slDirPressed
:= True;
818 if (not e_KeyPressed(IK_DOWN
)) and
819 (not e_KeyPressed(IK_UP
)) and
820 (not e_KeyPressed(IK_RIGHT
)) and
821 (not e_KeyPressed(IK_LEFT
)) and
822 (not e_KeyPressed(IK_KPDOWN
)) and
823 (not e_KeyPressed(IK_KPUP
)) and
824 (not e_KeyPressed(IK_KPRIGHT
)) and
825 (not e_KeyPressed(IK_KPLEFT
)) and
826 (not e_KeyPressed(VK_DOWN
)) and
827 (not e_KeyPressed(VK_UP
)) and
828 (not e_KeyPressed(VK_RIGHT
)) and
829 (not e_KeyPressed(VK_LEFT
)) then
830 slDirPressed
:= False;