mysticbbs/mystic/bbs_menus.pas

1111 lines
34 KiB
ObjectPascal
Raw Normal View History

Unit BBS_Menus;
2012-02-13 15:27:52 -08:00
{$I M_OPS.PAS}
Interface
Uses
BBS_Common,
BBS_MenuData,
MPL_Execute;
2012-02-13 15:27:52 -08:00
Type
TMenuEngine = Class
Owner : Pointer;
Data : TMenuData;
Stack : Array[1..mysMaxMenuStack] of String[mysMaxMenuNameLen];
StackPos : Byte;
MenuName : String[20];
MenuOld : String[20];
ExtKeys : String;
UseHotKeys : Boolean;
ReDraw : Boolean;
SetAction : Boolean;
UseTimer : Boolean;
TimerCount : LongInt;
TimerReload : Boolean;
ViewOnly : Boolean;
Constructor Create (O: Pointer);
2012-02-13 15:27:52 -08:00
Destructor Destroy; Override;
Function StripSecurity (Str: String) : String;
Function ReplaceSecurity (Str: String; SecLevel: Byte) : String;
Procedure ToggleAccessFlags (Cmd: String; Var Flags: AccessFlagType);
Function LoadMenu (Forced: Boolean) : Boolean;
Procedure ExecuteMenu (Load, Forced, View, Action: Boolean);
Function ExecuteCommandList (Num, JumpID: LongInt) : Byte;
Function ExecuteByHotkey (Key: String; Interval: LongInt) : Byte;
Function ExecuteCommand (Cmd, CmdData: String) : Boolean;
2012-07-24 01:07:26 -07:00
Function SpecialKey (Str: String) : Boolean;
Function MenuGetKey : Char;
Function ShowMenu : Boolean;
Procedure GenerateMenu;
Procedure DoStandardMenu;
Procedure DoLightBarMenu;
2012-02-13 15:27:52 -08:00
End;
Implementation
Uses
m_Strings,
m_DateTime,
BBS_Core,
BBS_IO,
BBS_NodeInfo,
BBS_General,
BBS_Doors,
BBS_NodeChat,
BBS_UserChat,
BBS_Ansi_Help,
BBS_Cfg_Main,
BBS_Cfg_Events,
BBS_Cfg_UserEdit,
BBS_Cfg_Vote;
Constructor TMenuEngine.Create (O: Pointer);
2012-02-13 15:27:52 -08:00
Begin
Inherited Create;
StackPos := 0;
MenuName := '';
MenuOld := '';
Owner := O;
Data := TMenuData.Create;
Redraw := True;
2012-02-13 15:27:52 -08:00
End;
Destructor TMenuEngine.Destroy;
2012-02-13 15:27:52 -08:00
Begin
Data.Free;
2012-02-13 15:27:52 -08:00
Inherited Destroy;
End;
Function TMenuEngine.StripSecurity (Str : String) : String;
2012-02-13 15:27:52 -08:00
Begin
Delete (Str, Pos('@S', Str), 2);
Result := Str;
End;
Function TMenuEngine.ReplaceSecurity (Str: String; SecLevel: Byte) : String;
2012-02-13 15:27:52 -08:00
Var
A : Byte;
Begin
A := Pos('@', Str);
If A > 0 Then Begin
Delete (Str, A, 2);
Insert (strI2S(SecLevel), Str, A);
2012-02-13 15:27:52 -08:00
End;
Result := Str;
End;
Procedure TMenuEngine.ToggleAccessFlags (Cmd: String; Var Flags: AccessFlagType);
2012-02-13 15:27:52 -08:00
Var
Count : Byte;
2012-02-13 15:27:52 -08:00
Begin
Count := 1;
While Count <= Length(Cmd) Do Begin
If (Cmd[Count] in ['+','-','!']) and (Cmd[Count + 1] in ['A'..'Z']) Then Begin
Case Cmd[Count] of
'+' : Flags := Flags + [Ord(Cmd[Count + 1]) - 64];
'-' : Flags := Flags - [Ord(Cmd[Count + 1]) - 64];
'!' : If Ord(Cmd[2]) - 64 in Flags Then
Flags := Flags - [Ord(Cmd[Count + 1]) - 64]
2012-02-13 15:27:52 -08:00
Else
Flags := Flags + [Ord(Cmd[Count + 1]) - 64];
2012-02-13 15:27:52 -08:00
End;
Inc (Count);
2012-02-13 15:27:52 -08:00
End;
Inc (Count);
End;
2012-02-13 15:27:52 -08:00
End;
Function TMenuEngine.ExecuteCommand (Cmd, CmdData: String) : Boolean;
2012-02-13 15:27:52 -08:00
Var
Loop1 : LongInt;
Help : TAnsiMenuHelp;
2012-02-13 15:27:52 -08:00
Begin
Result := False;
If Cmd[0] <> #2 Then Exit;
2012-02-13 15:27:52 -08:00
Case Cmd[1] of
'-' : Case Cmd[2] of
'D' : ToggleAccessFlags(CmdData, Session.User.ThisUser.AF2);
'F' : ToggleAccessFlags(CmdData, Session.User.ThisUser.AF1);
2012-07-24 00:18:37 -07:00
'I' : TimerCount := strS2I(CmdData);
'N' : Session.User.AcsOkFlag := Session.io.GetYN(CmdData, False);
'P' : Session.User.AcsOkFlag := Session.io.GetPW(Copy(CmdData, 1, Pos(';', CmdData) - 1), Session.GetPrompt(417),
strUpper(Copy(CmdData, Pos(';', CmdData) + 1, Length(CmdData))));
'S' : Session.SystemLog(CmdData);
'Y' : Session.User.AcsOkFlag := Session.io.GetYN(CmdData, True);
2012-02-13 15:27:52 -08:00
End;
'A' : Case Cmd[2] of
'E' : AutoSig_Edit;
'T' : Session.User.ThisUser.SigUse := Session.io.GetYN(Session.GetPrompt(335), False);
'V' : AutoSig_View;
End;
'D' : Case Cmd[2] of
'-' : ExecuteDoor (0, CmdData);
'C' : ExecuteDoor (3, CmdData);
'D' : ExecuteDoor (1, CmdData);
'G' : ExecuteDoor (2, CmdData);
'3' : ExecuteDoor (4, CmdData);
2012-02-13 15:27:52 -08:00
End;
'F' : Case Cmd[2] of
'A' : Session.FileBase.ChangeFileArea(CmdData);
2012-02-13 15:27:52 -08:00
'D' : Begin
Session.io.OutFile ('download', True, 0);
If (Session.FileBase.BatchNum > 0) and (Session.io.GetYN(Session.GetPrompt(85), True)) Then
2012-02-13 16:54:23 -08:00
Session.FileBase.DownloadBatch
2012-02-13 15:27:52 -08:00
Else
Session.FileBase.DownloadFile;
End;
'F' : Session.FileBase.DownloadFileList (strUpper(CmdData));
'G' : Session.FileBase.FileGroupChange (CmdData, True, True);
'L' : Session.FileBase.ListFiles (1, strUpper(CmdData));
'N' : Session.FileBase.NewFileScan(UpCase(CmdData[1]));
2012-02-13 16:54:23 -08:00
'P' : Session.FileBase.SetFileScanDate;
'S' : Session.FileBase.FileSearch;
'U' : Session.FileBase.UploadFile;
'V' : Session.FileBase.ViewFile;
'Z' : Session.FileBase.ToggleFileNewScan;
'1' : Session.FileBase.MassUpload;
2012-02-13 15:27:52 -08:00
'2' : Session.FileBase.DirectoryEditor(False, '');
'3' : Session.FileBase.SendFile (CmdData);
2012-02-13 15:27:52 -08:00
End;
'B' : Case Cmd[2] of
'A' : Add_BBS_List (CmdData);
'L' : View_BBS_List (True, CmdData);
'S' : View_BBS_List (False, CmdData);
2012-02-13 15:27:52 -08:00
End;
'G' : Case Cmd[2] of
'1' : ShowBBSHistory(strS2I(CmdData));
'A' : View_Directory(CmdData, 0);
'D' : Session.io.OutFile (CmdData, True, 0);
'E' : Session.User.Edit_User_Settings(strS2I(CmdData));
2012-02-13 15:27:52 -08:00
'H',
'I' : Begin
If Cmd[2] = 'H' Then Begin
If Session.FileBase.BatchNum > 0 Then Begin
Session.io.PromptInfo[1] := strI2S(Session.FileBase.BatchNum);
If Session.io.GetYN(Session.GetPrompt(121), False) Then
2012-02-13 16:54:23 -08:00
Session.FileBase.DownloadBatch;
2012-02-13 15:27:52 -08:00
End;
Session.io.OutFile ('logoff', True, 0);
End;
Session.SystemLog ('User logged off');
Halt(0);
End;
2012-02-22 00:41:08 -08:00
'L' : ShowLastCallers;
2012-02-13 15:27:52 -08:00
'O' : Begin
MenuOld := MenuName;
MenuName := CmdData;
2012-02-13 15:27:52 -08:00
Result := True;
End;
'N' : ShowOneLiners (CmdData);
'P' : {$IFNDEF UNIX} PageForSysopChat (Pos('/F', strUpper(CmdData)) > 0) {$ENDIF};
2012-02-13 15:27:52 -08:00
'R' : Begin
If StackPos > 0 Then Begin
2012-02-13 15:27:52 -08:00
MenuOld := MenuName;
MenuName := Stack[StackPos];
2012-02-13 15:27:52 -08:00
Result := True;
Dec (StackPos);
2012-02-13 15:27:52 -08:00
End;
End;
'S' : Begin
MenuOld := MenuName;
If StackPos = 8 Then Begin
For Loop1 := 1 to 7 Do
Stack[Loop1 + 1] := Stack[Loop1];
2012-02-13 15:27:52 -08:00
Dec (StackPos);
2012-02-13 15:27:52 -08:00
End;
Inc (StackPos);
2012-02-13 15:27:52 -08:00
Stack[StackPos] := MenuName;
MenuName := CmdData;
2012-02-13 15:27:52 -08:00
Result := True;
End;
'T' : Begin
Session.io.OutFull (CmdData);
Session.io.BufFlush;
End;
'U' : ShowUserList (strUpper(CmdData));
'X' : Result := ExecuteMPL(NIL, CmdData) = 2;
2012-02-13 15:27:52 -08:00
'?' : Begin
// online ANSI help system (BBSHTML) prototype
Help := TAnsiMenuHelp.Create;
Help.OpenHelp (Session.Theme.TextPath + CmdData + ';ansihelp;INDEX');
2012-02-13 15:27:52 -08:00
Help.Free;
End;
End;
'M' : Case Cmd[2] of
'A' : Session.Msgs.ChangeArea(CmdData);
2012-02-13 16:54:23 -08:00
'C' : Session.Msgs.CheckEMail;
'D' : Session.Msgs.SetMessagePointers;
'G' : Session.Msgs.MessageGroupChange (CmdData, True, True);
2012-02-13 15:27:52 -08:00
'M' : Session.Msgs.SendMassEmail;
'N' : Session.Msgs.MessageNewScan (strUpper(CmdData));
'P' : Session.Msgs.PostMessage (False, CmdData);
'Q' : Session.Msgs.MessageQuickScan(strUpper(CmdData));
2012-02-13 15:27:52 -08:00
'R' : Begin
If CmdData = '' Then CmdData := ' ';
2012-02-13 15:27:52 -08:00
Session.Msgs.ReadMessages(UpCase(CmdData[1]), '');
2012-02-13 15:27:52 -08:00
End;
'S' : Session.Msgs.GlobalMessageSearch(UpCase(CmdData[1]));
2012-02-13 16:54:23 -08:00
'V' : Session.Msgs.ViewSentEmail;
'W' : Session.Msgs.PostMessage (True, CmdData);
'X' : Session.Msgs.PostTextFile(CmdData, False);
2012-02-13 16:54:23 -08:00
'Z' : Session.Msgs.ToggleNewScan(False);
2012-02-13 15:27:52 -08:00
End;
'N' : Case Cmd[2] of
'A' : Set_Node_Action (CmdData);
2012-02-13 15:27:52 -08:00
'C' : Node_Chat;
'P' : PageUserForChat;
'S' : Send_Node_Message (3, CmdData, 0);
2012-02-13 15:27:52 -08:00
'W' : Show_Whos_Online;
End;
'O' : Case Cmd[2] of
2012-02-13 16:54:23 -08:00
'S' : Session.Msgs.ToggleNewScan(True);
'D' : Session.Msgs.DownloadQWK(False, CmdData);
'E' : Session.Msgs.DownloadQWK(True, CmdData);
2012-02-13 16:54:23 -08:00
'U' : Session.Msgs.UploadREP;
2012-02-13 15:27:52 -08:00
End;
'Q' : Case Cmd[2] of
'A' : Session.FileBase.BatchAdd;
'C' : Session.FileBase.BatchClear;
'D' : Session.FileBase.BatchDelete;
'L' : Session.FileBase.BatchList;
End;
'T' : Case Cmd[2] of
'D' : Add_TimeBank;
'W' : Get_TimeBank;
End;
'V' : Case Cmd[2] of
'A' : Add_Booth;
'N' : Voting_Booth_New;
'R' : Voting_Result (strS2I(CmdData));
'V' : Voting_Booth (False, strS2I(CmdData));
2012-02-13 15:27:52 -08:00
End;
'X' : Case Cmd[2] of
'A' : Begin
Session.io.OutFile('newuser', True, 0);
If Session.io.GetYN(Session.GetPrompt(269), True) Then Begin
Session.User.CreateNewUser('');
Session.User.User_Logon2;
MenuName := Config.MatrixMenu;
Result := True;
End;
End;
'C' : If Session.User.GetMatrixUser Then Begin
If Session.User.Access(Config.MatrixAcs) Then Begin
Session.io.PromptInfo[1] := Config.MatrixPW;
Session.io.OutFull (Session.GetPrompt(270));
End Else
Session.io.OutFull (Session.GetPrompt(271));
End;
'L' : If Session.io.GetPW (Session.GetPrompt(272), Session.GetPrompt(423), Config.MatrixPW) Then Begin
Session.User.MatrixOK := True;
Result := True;
End;
'P' : {$IFNDEF UNIX} If Session.User.GetMatrixUser Then
PageForSysopChat (Pos('/F', strUpper(CmdData)) > 0) {$ENDIF};
2012-02-13 15:27:52 -08:00
End;
'*' : Begin
2012-07-15 13:14:39 -07:00
If Not Session.io.GetPW (Session.GetPrompt(493), Session.GetPrompt(417), Config.SysopPW) Then Exit;
2012-02-13 15:27:52 -08:00
Case Cmd[2] of
'#' : Begin
Configuration_ExecuteEditor('M');
2012-02-13 15:27:52 -08:00
Result := True;
End;
'A' : Configuration_ExecuteEditor('A');
'E' : Event_Editor;
'F' : Configuration_ExecuteEditor('F');
2012-02-26 03:51:59 -08:00
'G' : Configuration_ExecuteEditor('G');
2012-02-26 12:44:07 -08:00
'L' : Configuration_ExecuteEditor('L');
'M' : Configuration_ExecuteEditor('B');
2012-02-13 15:27:52 -08:00
'P' : Configuration_ExecuteEditor('P');
2012-07-19 18:12:42 -07:00
'R' : Configuration_ExecuteEditor('R');
2012-02-13 15:27:52 -08:00
'S' : Configuration_MainMenu;
2012-03-17 11:11:50 -07:00
'U' : Configuration_UserEditor;
2012-02-13 15:27:52 -08:00
'V' : Vote_Editor;
End;
End;
End;
End;
Function TMenuEngine.ExecuteCommandList (Num, JumpID: LongInt) : Byte;
// 0 = no commands ran, 1 = commands ran, 2 = load new menu
2012-02-13 15:27:52 -08:00
Var
Count : LongInt;
2012-02-13 15:27:52 -08:00
Begin
Result := 0;
If ViewOnly Then Exit;
2012-02-13 15:27:52 -08:00
If Not TBBSCore(Owner).User.Access(Data.Item[Num]^.Access) Then Exit;
2012-02-13 15:27:52 -08:00
Redraw := Boolean(Data.Item[Num]^.Redraw);
For Count := 1 to Data.Item[Num]^.Commands Do Begin
If JumpID <> -1 Then
If JumpID <> Data.Item[Num]^.CmdData[Count]^.JumpID Then Continue;
If TBBSCore(Owner).User.Access(Data.Item[Num]^.CmdData[Count]^.Access) Then Begin
Result := 1;
2012-07-23 21:55:23 -07:00
If ExecuteCommand(Data.Item[Num]^.CmdData[Count]^.MenuCmd, Data.Item[Num]^.CmdData[Count]^.Data) Then Begin
Result := 2;
Exit;
End;
End;
2012-02-13 15:27:52 -08:00
End;
End;
2012-02-13 15:27:52 -08:00
Function TMenuEngine.ExecuteByHotkey (Key: String; Interval: LongInt) : Byte;
// 0 = no commands ran, 1 = commands ran, 2 = load new menu
Var
Count : LongInt;
Begin
Result := 0;
Key := strUpper(Key);
2012-02-13 15:27:52 -08:00
For Count := 1 to Data.NumItems Do Begin
If Data.Item[Count] = Nil Then Begin
Result := 2;
Break;
End;
2012-02-13 15:27:52 -08:00
If Data.Item[Count]^.HotKey = Key Then Begin
If Key <> 'TIMER' Then
Result := ExecuteCommandList(Count, -1)
Else
If (Interval MOD Data.Item[Count]^.Timer <> 0) Then
Continue
Else Begin
Case Data.Item[Count]^.TimerType of
0 : Result := ExecuteCommandList(Count, -1);
1,
2 : If Data.Item[Count]^.TimerShow Then Begin
Result := ExecuteCommandList(Count, -1);
Data.Item[Count]^.TimerShow := False;
End;
End;
End;
If Result = 2 Then Break;
End;
End;
End;
2012-02-13 15:27:52 -08:00
Function TMenuEngine.ShowMenu : Boolean;
Begin
With TBBSCore(Owner) Do Begin
Result := Not io.OutFile (ReplaceSecurity(Data.Info.DispFile, User.ThisUser.Security), False, 0);
2012-02-13 15:27:52 -08:00
If Result And (Pos('@S', Data.Info.DispFile) > 0) Then
Result := Not io.OutFile(StripSecurity(Data.Info.DispFile), False, 0);
End;
End;
2012-07-24 01:07:26 -07:00
Function TMenuEngine.SpecialKey (Str: String) : Boolean;
Begin
Result :=
(Str = 'AFTER') or
(Str = 'EVERY') or
(Str = 'FIRSTCMD') or
(Str = 'LINEFEED') or
(Str = 'TIMER');
End;
Procedure TMenuEngine.GenerateMenu;
Var
Format : Byte;
Listed : Word;
Count : LongInt;
Begin
If UseTimer Then Begin
For Count := 1 to Data.NumItems Do
If Data.Item[Count]^.TimerType = 2 Then
Data.Item[Count]^.TimerShow := True;
End;
If ShowMenu Then Begin
Case Data.Info.DispCols of
1 : Format := 79;
2 : Format := 39;
3 : Format := 26;
4 : Format := 19;
2012-02-13 15:27:52 -08:00
End;
TBBSCore(Owner).io.OutFullLn (Data.Info.Header);
2012-02-13 15:27:52 -08:00
Listed := 0;
2012-02-13 15:27:52 -08:00
For Count := 1 to Data.NumItems Do Begin
If (Data.Item[Count]^.ShowType = 2) or
2012-08-04 16:18:10 -07:00
((Data.Item[Count]^.Text = '') and (Data.Item[Count]^.HotKey <> 'LINEFEED')) or
(Data.Item[Count]^.HotKey = 'EVERY') or
(Data.Item[Count]^.HotKey = 'AFTER') or
(Data.Item[Count]^.HotKey = 'FIRSTCMD') or
((Data.Item[Count]^.ShowType = 0) And (Not TBBSCore(Owner).User.Access(Data.Item[Count]^.Access)))
Then Continue;
2012-02-13 15:27:52 -08:00
If Data.Item[Count]^.HotKey = 'LINEFEED' Then Begin
If Listed MOD Data.Info.DispCols <> 0 Then Session.io.OutRawLn('');
2012-02-13 15:27:52 -08:00
2012-08-04 16:18:10 -07:00
Session.io.OutFullLn(Data.Item[Count]^.Text);
While Listed Mod Data.Info.DispCols <> 0 Do Inc(Listed);
End Else Begin
Inc (Listed);
If Format = 79 Then
TBBSCore(Owner).io.OutFull(Data.Item[Count]^.Text)
Else
TBBSCore(Owner).io.OutFull(strPadR(Data.Item[Count]^.Text, Format + Length(Data.Item[Count]^.Text) - strMCILen(Data.Item[Count]^.Text), ' '));
2012-07-24 00:18:37 -07:00
While Screen.CursorX < Format Do
Session.io.BufAddChar(' ');
If Listed MOD Data.Info.DispCols = 0 Then
TBBSCore(Owner).io.OutFullLn ('');
End;
2012-02-13 15:27:52 -08:00
End;
If Listed MOD Data.Info.DispCols <> 0 Then
TBBSCore(Owner).io.OutFullLn ('');
TBBSCore(Owner).io.BufFlush;
2012-02-13 15:27:52 -08:00
End;
If ExecuteByHotKey('AFTER', 0) = 2 Then Exit;
If Data.Info.Footer <> '' Then
TBBSCore(Owner).io.OutFull(Data.Info.Footer);
TBBSCore(Owner).io.BufFlush;
2012-02-13 15:27:52 -08:00
End;
Procedure TMenuEngine.DoStandardMenu;
2012-02-13 15:27:52 -08:00
Var
2012-07-24 01:07:26 -07:00
Ch : Char;
Temp : String[mysMaxMenuInput];
Count : LongInt;
Found : Boolean;
ValidKey : Boolean;
2012-02-13 15:27:52 -08:00
Procedure Translate;
2012-02-13 15:27:52 -08:00
Begin
Case Ch of
#09 : Temp := 'TAB';
#27 : Temp := 'ESCAPE';
#71 : Temp := 'HOME';
#72 : Temp := 'UP';
#73 : Temp := 'PAGEUP';
#75 : Temp := 'LEFT';
#77 : Temp := 'RIGHT';
#79 : Temp := 'END';
#80 : Temp := 'DOWN';
#81 : Temp := 'PAGEDOWN'
End;
2012-02-13 15:27:52 -08:00
End;
Procedure AddChar;
2012-02-13 15:27:52 -08:00
Begin
Temp := Temp + UpCase(Ch);
2012-02-13 15:27:52 -08:00
Case Data.Info.CharType of
0 : TBBSCore(Owner).io.OutRaw(UpCase(Ch));
1 : TBBSCore(Owner).io.OutRaw(LoCase(Ch));
2 : {hidden};
End;
2012-02-13 15:27:52 -08:00
End;
Begin
While Not TBBSCore(Owner).ShutDown Do Begin
If Not ViewOnly Then
If ExecuteByHotKey('EVERY', 0) = 2 Then Exit;
2012-02-13 15:27:52 -08:00
If ReDraw Then GenerateMenu;
2012-02-13 15:27:52 -08:00
TBBSCore(Owner).io.AllowArrow := True;
2012-02-13 15:27:52 -08:00
If SetAction Then
If Data.Info.NodeStatus <> '' Then
Set_Node_Action(Data.Info.NodeStatus)
Else
Set_Node_Action(TBBSCore(Owner).GetPrompt(346));
2012-02-13 15:27:52 -08:00
Temp := '';
2012-02-13 15:27:52 -08:00
While Not TBBSCore(Owner).ShutDown Do Begin
Ch := MenuGetKey;
2012-02-13 15:27:52 -08:00
If TBBSCore(Owner).ShutDown Then Exit;
2012-02-13 15:27:52 -08:00
If UseTimer And (Ch = #02) Then Begin
If TimerReload Then Exit;
If ReDraw Then Break;
End;
Case Ch of
#08 : If Length(Temp) > 0 Then Begin
Dec (Temp[0]);
2012-02-13 15:27:52 -08:00
TBBSCore(Owner).io.OutBS(1, True);
End;
#09,
#27 : If Pos(Ch, ExtKeys) > 0 Then Begin
Translate;
2012-02-13 15:27:52 -08:00
Break;
End;
2012-02-13 15:27:52 -08:00
#13 : Begin
If Temp = '' Then Temp := 'ENTER';
Break;
2012-02-13 15:27:52 -08:00
End;
#32..
#126: If Length(Temp) < mysMaxMenuInput Then Begin
If TBBSCore(Owner).io.IsArrow And (Pos(Ch, ExtKeys) > 0) Then Begin
Translate;
Break;
End;
If UseHotKeys Then Begin
2012-07-24 01:07:26 -07:00
ValidKey := False;
Found := False;
Count := 0;
2012-02-13 15:27:52 -08:00
Repeat
Inc (Count);
2012-07-24 00:18:37 -07:00
If SpecialKey(Data.Item[Count]^.HotKey) Or Not TBBSCore(Owner).User.Access(Data.Item[Count]^.Access) Then Continue;
Found := Data.Item[Count]^.HotKey = Temp + UpCase(Ch);
2012-07-24 01:07:26 -07:00
If Not ValidKey Then
ValidKey := Temp + UpCase(Ch) = Copy(Data.Item[Count]^.HotKey, 1, Length(Temp + Ch));
Until Found or (Count >= Data.NumItems);
If Found And (TBBSCore(Owner).User.Access(Data.Item[Count]^.Access)) Then Begin
AddChar;
Break;
End Else
2012-07-24 01:07:26 -07:00
If ValidKey Then AddChar;
2012-02-13 15:27:52 -08:00
End Else
AddChar;
2012-02-13 15:27:52 -08:00
End;
End;
End;
If Data.Info.CharType <> 2 Then
TBBSCore(Owner).io.OutRawLn('');
If ViewOnly Then Exit;
If Not TBBSCore(Owner).ShutDown Then
If ExecuteByHotKey(Temp, 0) = 2 Then
Exit;
2012-02-13 15:27:52 -08:00
End;
End;
2012-02-13 15:27:52 -08:00
Function TMenuEngine.MenuGetKey : Char;
Var
LastSec : LongInt;
Begin
Session.io.BufFlush;
Session.io.PurgeInputBuffer;
LastSec := TimerSeconds;
While Not TBBSCore(Owner).ShutDown Do Begin
Result := TBBSCore(Owner).io.InKey(1000);
If TBBSCore(Owner).ShutDown Then Exit;
If TimerSeconds <> LastSec Then Begin
LastSec := TimerSeconds;
If Session.io.DoInputEvents(Result) Then Exit;
If UseTimer Then Begin
Inc (TimerCount);
Case ExecuteByHotkey('TIMER', TimerCount) of
1 : If ReDraw Then Begin
Result := #02;
Exit;
End;
2 : Begin
TimerReload := True;
Result := #02;
Exit;
End;
End;
If TimerCount = 1000000000 Then TimerCount := 0;
End;
End;
If Result <> #255 Then Break;
End;
End;
Procedure TMenuEngine.DoLightBarMenu;
Var
TempStr : String;
PromptX : Byte;
PromptY : Byte;
PromptA : Byte;
Function ValidLightBar (BarPos: Word) : Boolean;
Begin
Result := False;
If BarPos = 0 Then Exit;
Result := (Data.Item[BarPos]^.HotKey <> 'EVERY') And
(Data.Item[BarPos]^.HotKey <> 'AFTER') And
(Data.Item[BarPos]^.HotKey <> 'FIRSTCMD') And
(Data.Item[BarPos]^.TextLo <> '') And
(Data.Item[BarPos]^.TextHi <> '') And
(Data.Item[BarPos]^.ShowType <> 2) And
((((Data.Item[BarPos]^.ShowType = 0) And (TBBSCore(Owner).User.Access(Data.Item[BarPos]^.Access)) Or (Data.Item[BarPos]^.ShowType = 1)))
);
End;
Procedure DrawBar (Num: Word; High: Boolean);
2012-02-13 15:27:52 -08:00
Var
Str : String;
2012-02-13 15:27:52 -08:00
Begin
If Num = 0 Then Exit;
2012-02-13 15:27:52 -08:00
If High Then
Str := Data.Item[Num]^.TextHi
Else
Str := Data.Item[Num]^.TextLo;
2012-02-13 15:27:52 -08:00
If Str = '' Then Exit;
2012-02-13 15:27:52 -08:00
TBBSCore(Owner).io.AnsiGotoXY(Data.Item[Num]^.X, Data.Item[Num]^.Y);
TBBSCore(Owner).io.OutFull(Str);
End;
Procedure AddChar (Ch: Char);
Var
SavedAttr : Byte;
Str : String = '';
Offset : Byte;
Begin
If Data.Info.CharType = 2 Then Begin // hidden
TempStr := TempStr + UpCase(Ch);
Exit;
End;
SavedAttr := Screen.TextAttr; // tbbscore
If Ch = #08 Then
Offset := Length(TempStr) + 1
Else
Offset := Length(TempStr);
2012-07-24 00:18:37 -07:00
TBBSCore(Owner).io.BufAddStr (#27 + '[s');
TBBSCore(Owner).io.AnsiGotoXY (PromptX + Offset, PromptY);
TBBSCore(Owner).io.AnsiColor (PromptA);
If Ch = #08 Then
Str := Str + #8#32#8
Else Begin
Case Data.Info.CharType of
0 : Ch := UpCase(Ch);
1 : Ch := LoCase(Ch);
2012-02-13 15:27:52 -08:00
End;
Str := Str + Ch;
TempStr := TempStr + UpCase(Ch);
2012-02-13 15:27:52 -08:00
End;
TBBSCore(Owner).io.BufAddStr(Str);
TBBSCore(Owner).io.AnsiColor(SavedAttr);
TBBSCore(Owner).io.BufAddStr(#27 + '[u');
TBBSCore(Owner).io.BufFlush;
End;
Var
Count : Word;
CursorPos : Word;
TempPos : Word;
Ch : Char;
Found : Boolean;
ValidKey : Boolean;
2012-08-04 16:18:10 -07:00
Function ExecuteGridCommand (NewCmd, ExecType: LongInt) : LongInt;
Begin
If ValidLightBar(NewCmd) Then Begin
Result := ExecuteCommandList(CursorPos, ExecType);
If Result <> 2 Then Begin
DrawBar (CursorPos, False);
CursorPos := NewCmd;
DrawBar (CursorPos, True);
Session.io.BufFlush;
End;
End Else
Result := ExecuteCommandList(CursorPos, ExecType);
End;
Begin
CursorPos := 0;
2012-02-13 15:27:52 -08:00
While Not TBBSCore(Owner).ShutDown Do Begin
If Not ViewOnly Then
2012-07-23 21:55:23 -07:00
ExecuteByHotKey('EVERY', 0);
2012-02-13 15:27:52 -08:00
If SetAction Then
If Data.Info.NodeStatus <> '' Then
Set_Node_Action(Data.Info.NodeStatus)
Else
Set_Node_Action(TBBSCore(Owner).GetPrompt(346));
2012-02-13 15:27:52 -08:00
If ReDraw Then Begin
If UseTimer Then Begin
For Count := 1 to Data.NumItems Do
If Data.Item[Count]^.TimerType = 2 Then
Data.Item[Count]^.TimerShow := True;
End;
ShowMenu;
2012-02-13 15:27:52 -08:00
If Data.Info.Header <> '' Then
TBBSCore(Owner).io.OutFull(Data.Info.Header);
2012-02-13 15:27:52 -08:00
If Data.Info.Footer <> '' Then
TBBSCore(Owner).io.OutFull(Data.Info.Footer);
2012-06-30 17:23:39 -07:00
TBBSCore(Owner).io.BufFlush;
PromptX := Screen.CursorX; //tbbscore
PromptY := Screen.CursorY; //tbbscore
PromptA := Screen.TextAttr; //tbbscore
End;
For Count := 1 to Data.NumItems Do
If ValidLightBar(Count) Then Begin
2012-08-04 16:18:10 -07:00
If CursorPos = 0 Then CursorPos := Count;
2012-08-04 16:18:10 -07:00
DrawBar (Count, False);
End;
TBBSCore(Owner).io.AllowArrow := True;
If Not ViewOnly Then
2012-07-23 21:55:23 -07:00
ExecuteByHotKey('AFTER', 0);
DrawBar (CursorPos, True);
TempStr := '';
While Not TBBSCore(Owner).ShutDown Do Begin
Ch := MenuGetKey;
If UseTimer And (Ch = #02) Then Begin
If TimerReload Then Exit;
If ReDraw Then Break;
End;
If TBBSCore(Owner).ShutDown Then Exit;
If TBBSCore(Owner).io.IsArrow Then Begin
2012-08-04 16:18:10 -07:00
Case Data.Info.MenuType of
1 : Case Ch of
#71 : Case ExecuteByHotKey('HOME', -1) of
0 : ;
1 : Break;
2 : Exit;
End;
#73 : Case ExecuteByHotKey('PAGEUP', -1) of
0 : ;
1 : Break;
2 : Exit;
End;
#79 : Case ExecuteByHotKey('END', -1) of
0 : ;
1 : Break;
2 : Exit;
End;
#81 : Case ExecuteByHotKey('PAGEDOWN', -1) of
0 : ;
1 : Break;
2 : Exit;
End;
2012-08-04 16:18:10 -07:00
#72,
#75 : Begin
TempPos := CursorPos;
While TempPos > 1 Do Begin
Dec (TempPos);
2012-08-04 16:18:10 -07:00
If ValidLightBar(TempPos) Then Begin
DrawBar (CursorPos, False);
DrawBar (TempPos, True);
2012-08-04 16:18:10 -07:00
CursorPos := TempPos;
2012-08-04 16:18:10 -07:00
Break;
End;
2012-02-13 15:27:52 -08:00
End;
End;
2012-08-04 16:18:10 -07:00
#77,
#80 : Begin
TempPos := CursorPos;
While TempPos < Data.NumItems Do Begin
Inc (TempPos);
2012-08-04 16:18:10 -07:00
If ValidLightBar(TempPos) Then Begin
DrawBar (CursorPos, False);
DrawBar (TempPos, True);
2012-08-04 16:18:10 -07:00
CursorPos := TempPos;
2012-08-04 16:18:10 -07:00
Break;
End;
2012-02-13 15:27:52 -08:00
End;
End;
2012-02-13 15:27:52 -08:00
End;
2012-08-04 16:18:10 -07:00
2 : Begin
Case Ch of
#71 : TempPos := ExecuteGridCommand(Data.Item[CursorPos]^.JumpHome, 9);
#72 : TempPos := ExecuteGridCommand(Data.Item[CursorPos]^.JumpUp, 1);
#73 : TempPos := ExecuteGridCommand(Data.Item[CursorPos]^.JumpPgUp, 7);
#75 : TempPos := ExecuteGridCommand(Data.Item[CursorPos]^.JumpLeft, 3);
#77 : TempPos := ExecuteGridCommand(Data.Item[CursorPos]^.JumpRight, 4);
#79 : TempPos := ExecuteGridCommand(Data.Item[CursorPos]^.JumpEnd, 10);
#80 : TempPos := ExecuteGridCommand(Data.Item[CursorPos]^.JumpDown, 2);
#81 : TempPos := ExecuteGridCommand(Data.Item[CursorPos]^.JumpPgDn, 8);
End;
Case TempPos of
0 : ;
1 : Break;
2 : Exit;
End;
End;
End;
End Else
Case Ch of
#08 : If Length(TempStr) > 0 Then Begin
Dec (TempStr[0]);
2012-08-04 16:18:10 -07:00
AddChar(#8);
2012-02-13 15:27:52 -08:00
End;
#09 : Begin
Case Data.Info.MenuType of
1 : Count := ExecuteByHotKey('TAB', -1);
2 : Count := ExecuteGridCommand(Data.Item[CursorPos]^.JumpEscape, 5);
End;
Case Count of
0 : ;
1 : Break;
2 : Exit;
End;
End;
#13 : Begin
TBBSCore(Owner).io.AnsiGotoXY(Data.Info.DoneX, Data.Info.DoneY);
If ViewOnly Then Exit;
If Data.Info.MenuType = 1 Then
Found := ExecuteCommandList(CursorPos, -1) = 2
Else
Found := ExecuteCommandList(CursorPos, 0) = 2;
If Found Then Exit Else Break;
End;
#27 : Begin
Case Data.Info.MenuType of
1 : Count := ExecuteByHotKey('ESCAPE', -1);
2 : Count := ExecuteGridCommand(Data.Item[CursorPos]^.JumpEscape, 6);
End;
Case Count of
0 : ;
1 : Break;
2 : Exit;
End;
End;
Else
If Length(TempStr) < mysMaxMenuInput Then Begin
Found := False;
ValidKey := False;
Count := 0;
Repeat
Inc (Count);
If SpecialKey(Data.Item[Count]^.HotKey) or Not TBBSCore(Owner).User.Access(Data.Item[Count]^.Access) Then Continue;
2012-07-24 01:07:26 -07:00
Found := Data.Item[Count]^.HotKey = TempStr + UpCase(Ch);
session.systemlog('comparing cmd: ' + data.item[count]^.hotkey + ' to ' + tempstr + upcase(ch));
If Not ValidKey Then
ValidKey := TempStr + UpCase(Ch) = Copy(Data.Item[Count]^.HotKey, 1, Length(TempStr + Ch));
session.systemlog('valid key is: ' + stri2s(ord(validkey)));
session.systemlog('found is: ' + stri2s(ord(found)));
Until Found or (Count >= Data.NumItems);
If Found And (TBBSCore(Owner).User.Access(Data.Item[Count]^.Access)) Then Begin
If Length(TempStr) > 0 Then AddChar (Ch);
If ValidLightBar(Count) Then Begin
DrawBar(CursorPos, False);
CursorPos := Count;
DrawBar(CursorPos, True);
End;
TBBSCore(Owner).io.AnsiGotoXY(Data.Info.DoneX, Data.Info.DoneY);
If Data.Info.MenuType = 1 Then
Found := ExecuteCommandList(Count, -1) = 2
Else
Found := ExecuteCommandList(Count, 0) = 2;
If Found Then Exit Else Break;
End Else
If ValidKey Then AddChar(Ch);
2012-02-13 15:27:52 -08:00
End;
End;
2012-02-13 15:27:52 -08:00
End;
End;
End;
2012-02-13 15:27:52 -08:00
Function TMenuEngine.LoadMenu (Forced: Boolean) : Boolean;
2012-02-13 15:27:52 -08:00
Begin
Result := True;
2012-07-15 13:14:39 -07:00
If Not Data.Load (False, TBBSCore(Owner).Theme.MenuPath + MenuName + '.mnu') Then Begin
Result := False;
2012-02-13 15:27:52 -08:00
If TBBSCore(Owner).Theme.Flags AND thmFallback <> 0 Then
Result := Data.Load (False, Config.MenuPath + MenuName + '.mnu');
2012-02-13 15:27:52 -08:00
If Not Result Then Begin
If Forced Then Begin
Session.io.OutFullLn ('|CRError Loading ' + MenuName + '.mnu');
Session.SystemLog ('Error Loading Menu: ' + MenuName);
Halt(1);
End;
Exit;
End;
End;
End;
Procedure TMenuEngine.ExecuteMenu (Load, Forced, View, Action: Boolean);
Var
Count : LongInt;
Begin
2012-07-23 21:55:23 -07:00
SetAction := Action;
ViewOnly := View;
If ViewOnly Then Begin
Case Data.Info.MenuType of
0 : DoStandardMenu;
1,
2 : If TBBSCore(Owner).io.Graphics > 0 Then
DoLightBarMenu
Else
DoStandardMenu;
2012-02-13 15:27:52 -08:00
End;
Exit;
End;
If Load Then
If Not LoadMenu(Forced) Then Exit;
2012-02-13 15:27:52 -08:00
If Not TBBSCore(Owner).User.Access(Data.Info.Access) Then Begin
If Data.Info.Fallback <> '' Then Begin
MenuName := Data.Info.Fallback;
Exit;
End;
MenuName := MenuOld;
2012-02-13 15:27:52 -08:00
TBBSCore(Owner).io.OutFull(TBBSCore(Owner).GetPrompt(149));
Exit;
2012-02-13 15:27:52 -08:00
End;
If Data.Info.Global Then
If Not Data.Load (True, TBBSCore(Owner).Theme.MenuPath + 'global.mnu') Then
If TBBSCore(Owner).Theme.Flags AND thmFallback <> 0 Then
Data.Load (True, Config.MenuPath + 'global.mnu');
If Data.Info.InputType = 0 Then
UseHotKeys := TBBSCore(Owner).User.ThisUser.HotKeys
2012-02-13 15:27:52 -08:00
Else
UseHotKeys := Not Boolean(Data.Info.InputType - 1);
2012-02-13 15:27:52 -08:00
ExtKeys := '';
UseTimer := False;
ReDraw := True;
TimerCount := 0;
TimerReload := False;
2012-02-13 15:27:52 -08:00
For Count := 1 to Data.NumItems Do Begin
If (Data.Item[Count]^.HotKey = 'EVERY') or
Not TBBSCore(Owner).User.Access(Data.Item[Count]^.Access) Then
Continue;
2012-02-13 15:27:52 -08:00
If Data.Item[Count]^.HotKey = 'FIRSTCMD' Then Begin
If ExecuteCommandList(Count, -1) = 2 Then Exit;
End Else
If Data.Item[Count]^.HotKey = 'TAB' Then ExtKeys := ExtKeys + #09 Else
If Data.Item[Count]^.HotKey = 'ESCAPE' Then ExtKeys := ExtKeys + #27 Else
If Data.Item[Count]^.HotKey = 'UP' Then ExtKeys := ExtKeys + #72 Else
If Data.Item[Count]^.HotKey = 'PAGEUP' Then ExtKeys := ExtKeys + #73 Else
If Data.Item[Count]^.HotKey = 'LEFT' Then ExtKeys := ExtKeys + #75 Else
If Data.Item[Count]^.HotKey = 'RIGHT' Then ExtKeys := ExtKeys + #77 Else
If Data.Item[Count]^.HotKey = 'DOWN' Then ExtKeys := ExtKeys + #80 Else
If Data.Item[Count]^.HotKey = 'PAGEDOWN' Then ExtKeys := ExtKeys + #81 Else
If Data.Item[Count]^.HotKey = 'HOME' Then ExtKeys := ExtKeys + #71 Else
If Data.Item[Count]^.HotKey = 'END' Then ExtKeys := ExtKeys + #79 Else
If Data.Item[Count]^.HotKey = 'TIMER' Then UseTimer := True;
End;
2012-02-13 15:27:52 -08:00
Case Data.Info.MenuType of
0 : DoStandardMenu;
1,
2 : If TBBSCore(Owner).io.Graphics > 0 Then
DoLightBarMenu
Else
DoStandardMenu;
End;
2012-02-13 15:27:52 -08:00
End;
End.