{$IFNDEF OS2}
{$O+,F+}
{$ENDIF}
{$I-}

{*********************************************************}
{*                     TMENUS.PAS                        *}
{*                                                       *}
{*  Copyright (c) Vlad Bakaev, 1995-98,                  *}
{*  Copyright (c) Konstantin Klyagin, 1995-98,           *}
{*                exspecially for Tornado BBS System     *}
{*                                                       *}
{*********************************************************}

Unit tMenus;

Interface

Uses
{$IFDEF OS2}
  Os2Base,
{$ENDIF}
{$IFNDEF WIN32}
  DOS,
{$ELSE}
  OpCrt,
  Classes,
{$ENDIF}
  tMisc,
  Log,
  tGlob,
  Parse,
  Resource;

Const
  ActionsNum = 53;

  Actions : Array [1..ActionsNum] Of String [15] = (
  'Gosub_Menu',                { Name of menu       }
  'DownLoad',                  { Filename(s)        }
  'UpLoad',                    { Directory          }
  'Return',                    {                    }
  'LogOff',         {  5 }     {                    }
  'Change_FArea',              { Number of area     }
  'User_Info',                 { UserName           }
  'Msg_Post',                  { Number of area     }
  'FileList',                  { Number of area     }
  'ArcView',        { 10 }     { Name of archive    }
  'Display_File',              { Filename           }
  'Page_SysOp',                { Theme              }
  'Shell',                     {                    }
  'Change_Msg_Area',           { Number of area     }
  'Msg_Read',       { 15 }     { Number of area     }
  'Msg_List',                  { Number of area     }
  'Display_Text',              {                    }
  'Re_Login',                  { User name          }
  'System_Info',               {                    }
  'Goto_Menu',      { 20 }     { Name Of Menu       }
  'Exec',                      { Program Name       }
  'Scan_NewFiles',             {                    }
  'Scan_PrivMail',             {                    }
  'Send_Msg',                  {                    }
  'Set_Msg_Off',    { 25 }     {                    }
  'Set_Msg_On',                {                    }
  'Line_List',                 {                    }
  'Change_Param',              {                    }
  'Todays_Callers',            {                    }
  'News',           { 30 }     {                    }
  'Show_Raw_Dir',              {                    }
  'Type_File',                 { File Name          }
  'Global_Search',             { WildCard           }
  'Conference',                {                    }
  'Exec_Script',    { 35 }     { File Name          }
  'Next_MsgArea',              {                    }
  'Prev_MsgArea',              {                    }
  'Next_FileArea',             {                    }
  'Prev_FileArea',             {                    }
  'Change_FGroup',  { 40 }     { Group number       }
  'Change_MGroup',             { Group number       }
  'Next_FileGroup',            {                    }
  'Prev_FileGroup',            {                    }
  'Next_MsgGroup',             {                    }
  'Prev_MsgGroup',  { 45 }     {                    }
  'UpLoad_Priv',               { Username           }
  'HTML',                      { Filename           }
  'DownLoad_QWK',              {                    }
  'UpLoad_QWK',                {                    }
  'Select_QWK',     { 50 }     {                    }
  'Exec_Rexx',                 {                    }
  'Telnet',                    {                    }
  'Finger'                     {                    }
  );

  {Menu Commands}
  cGoTo = 20;
  cGosub = 1;
  cReturn = 4;

  {File Areas Commands}
  cChangeFileGroup = 40;
  cChangeFileArea = 6;
  cDownLoad = 2;
  cUpLoad = 3;
  cFileList = 9;
  cArcView = 10;
  cShowRawDir = 31;
  cTypeFile = 32;
  cGlobalSearch = 33;
  cNextFileArea = 38;
  cPrevFileArea = 39;
  cNextFileGroup = 42;
  cPrevFileGroup = 43;
  cUploadPriv = 46;

  {Message Areas Commands}
  cChangeMsgGroup = 41;
  cChangeMsgArea = 14;
  cReadMsgs = 15;
  cListMsgs = 16;
  cPostMsg = 8;
  cNextMsgArea = 36;
  cPrevMsgArea = 37;
  cNextMsgGroup = 44;
  cPrevMsgGroup = 45;
  cDownLoadQWK = 48;
  cUpLoadQWK = 49;
  cSelectQWK = 50;

  {File Displaying Commands}
  cDisplayFile = 11;

  {General System Commands}
  cUserInfo = 7;
  cPageSysOp = 12;
  cLogOff = 5;
  cShell = 13;
  cDisplayOnly = 17;
  cReLogin = 18;
  cVerInfo = 19;
  cExec = 21;
  cScan_NewFiles = 22;
  cScan_PrivMail = 23;
  cChangeParam = 28;
  cTodaysCallers = 29;
  cNews = 30;
  cExecScript = 35;
  cHTML = 47;
  cExecRexx = 51;
  cTelnet = 52;
  cFinger = 53;

  {MultiLine Commands}
  cSend_Msg = 24;
  cSet_Msg_Off = 25;
  cSet_Msg_On = 26;
  cLine_List = 27;
  cConference = 34;

Var
  MenuFile         : Text;
  BufStr           : String;
  MenuEnd, IsOpen  : Boolean;
  mHeader          : tMenuHeader;
  MenuItems        : PMenuItemsCollection;

Function UseMenu (MenuName: PathStr): Boolean;

Implementation

Var
  MenuFileName : PathStr;
  LineNumber   : Word;

Procedure mReadLn (var S : String);
Var
  LineDef : String [20];
  N       : Byte;

Begin
  While Not EoF (MenuFile) Do
  Begin
    Inc (LineNumber);
    S := '';
    ReadLn (MenuFile, S);
    S := Trim (S);

    If Length (S) > 0 Then
    If S [1] = '{' Then
    Begin
      N := Pos ('}', S);
      If N < 3 Then Continue;
      LineDef := Trim (Copy (S, 2, N-2));
      While Pos (#32, LineDef) <> 0 Do Delete (LineDef, Pos (' ', LineDef), 1);
      If Not InRange (BbsLine, LineDef) Then Continue;
      Delete (S, 1, Pos('}', S));
      Exit;
    End;

    Exit;
  End;
End;

Procedure GetNearestSection (NameSection: String);
Begin
  While (UpString (Copy (BufStr, 1, 2 + Length (NameSection))) <> '[' + UpString (NameSection) + ']') And
        (Not EoF (MenuFile)) Do
  mReadLn(BufStr);
End;

Function Kill2SpaceInString (InStr: String): String;
Label
  For_Start,
  Wh_End;

Var
  First32 : Boolean;
  I, L    : Byte;
  BufStr  : String;
  Comed   : Boolean;

Begin
  If Length (Trim (InStr)) = 0 Then
  Begin
    Kill2SpaceInString := '';
    Exit;
  End;

  Comed := False;
  BufStr := InStr;
  First32 := (BufStr [1] = ' ');
  L := Length (BufStr);
  If L = 0 Then Goto Wh_End;
  I := 0;
  While I < L Do
  Begin
    Inc (I);
    For_Start:
    If (BufStr [I] = ' ') And Not Comed Then
      If (Not First32) And
         (BufStr [I + 1] = ' ') Or First32 And
         (BufStr [I + 1] <> ' ') Then
      Begin
        Delete (BufStr, I, 1);
        Dec (L); If I > L Then Goto Wh_End;
        Goto For_Start;
      End;
    If BufStr [I] <> ' ' Then First32 := False;
    If BufStr [I] = '"' Then Comed := Not Comed;
  End;
  Wh_End:
  Kill2SpaceInString := BufStr;
End;

Function InitMenuParser (MenuName: PathStr): Boolean;
Begin
  InitMenuParser := True;
  If IsOpen Then Exit;

  If Not FileExists (MenuName) Then
  Begin
    InitMenuParser := False;
    Exit;
  End;

  System. FileMode := 0;

  Assign (MenuFile, MenuName);
  Reset (MenuFile);

  System. FileMode := 2;

  MenuFileName := MenuName;
  MenuEnd := EoF (MenuFile);

  LineNumber := 0;
  IsOpen := True;
End;

Procedure ReadMenuHeader (Var MenuHeader: tMenuHeader);
Var
  S : String;

Label
  SkipLine;

Begin
  Close (MenuFile);
  ReSet (MenuFile);
  BufStr := '';
  LineNumber := 0;
  GetNearestSection ('Header');
  mReadLn (BufStr);
  Inc (LineNumber);
  FillChar (MenuHeader, SizeOf (MenuHeader), #0);

  With MenuHeader Do
  While ((Length (BufStr) = 0) Or (BufStr [1] <> '[')) And Not EoF (MenuFile) Do
  Begin

    BufStr := PlaceSubStr (BufStr, #9, '    ');
    If Pos (';', BufStr) <> 0 Then
      SetLength (BufStr, Pos (';', BufStr) - 1);

    BufStr := Kill2SpaceInString (BufStr);
    If (Length (BufStr) = 0) Or (BufStr [1] = ';') Then Goto SkipLine;

    If UpString (Copy (BufStr, 1, 11)) = 'DISPLAYFILE'  Then
      DisplayFile  :=  Copy (BufStr, 13, Length (BufStr) - 12);

    If UpString (Copy (BufStr, 1,  6)) = 'PROMPT' Then
    If BufStr [8] = '"' Then
    Begin
      Delete (BufStr, 1, 8); { Убираем кавычку и строку Prompt }
      Prompt := Copy (BufStr, 1, Pos ('"', BufStr) - 1);
    End;

    If UpString (Copy (BufStr, 1, 12)) = 'WRITEHOTKEYS' Then
      WriteHotKeys := (UpString (Copy (BufStr, 14, Length (BufStr) - 13)) = 'YES');

    If UpString (Copy (BufStr, 1, 12)) = 'ARROWS_SETUP' Then
    Begin
      BufStr := UpString (Copy (BufStr, 14, Length (BufStr) - 13));
      ArrowHor := Str2Long (ExtractWord (1, BufStr, [':', ',', ' ']));
      ArrowVer := Str2Long (ExtractWord (2, BufStr, [':', ',', ' ']));
      StartY := Str2Long (ExtractWord (3, BufStr, [':', ',', ' ']));
      StartX := Str2Long (ExtractWord (4, BufStr, [':', ',', ' ']));
      S := ExtractWord (5, BufStr, [':', ',', ' ']);
      S := 'GRAY/' + S;
      SelectedColor := Color2Byte (S);
    End;

    SkipLine:
    mReadLn (BufStr);
  End;

  MenuEnd := EoF (MenuFile);
  GetNearestSection ('Menu');
End;

Procedure ReadMenuItem (Var MenuItem: tMenuItem);
Var
  Result                : SysInt;
  _Action, _Security, T : String;

Label
  ErrorLine,
  SkipLine,
  ReadNext;

Begin
  FillChar (MenuItem, SizeOf (MenuItem), #0);

  _Action   := '';
  _Security := '';

 ReadNext:
  If Not MenuEnd Then mReadLn (BufStr) Else Goto SkipLine;

  BufStr := Kill2SpaceInString (PlaceSubStr (BufStr, #9, '    '));

  If (Length (BufStr) = 0) Or (BufStr [1] = ';') Then
  Begin
    MenuEnd := EoF (MenuFile);
    Goto ReadNext;
  End;

  _Action  := ExtractWord (1, BufStr, [' ']);
  Delete (BufStr, 1, Length (_Action)+1);

  If _Action [Length (_Action)] = '+' Then
  Begin
    MenuItem. AutoExec := True;
    _Action := Copy (_Action, 1, Length (_Action)-1);
  End;

  While (UpString (Actions [MenuItem. Action] ) <> UpString (_Action) ) And
        (MenuItem. Action <= ActionsNum) Do
  Inc (MenuItem. Action);

  If MenuItem. Action > ActionsNum Then
    goto ErrorLine;

  If BufStr [1] = '"' Then
  Begin
    Delete (BufStr, 1, 1); { Убираем кавычку }
    if Pos ('"', BufStr) = 0 then
    begin
     ErrorLine:
      MenuItem.Action := 0;
      LogWrite ('!', 'Line '+Long2Str(LineNumber-1)+' of file '+ Trim (NiceFileName
               (CompletePath (JustPathName (MenuFileName)) + JustFileName
               (MenuFileName), 50)) + ' is invalid');

      MenuEnd := EoF (MenuFile);
      goto ReadNext;
    end;
    MenuItem. OptData := Copy (BufStr, 1, Pos ('"', BufStr) - 1);
    Delete (BufStr, 1, Pos ('"', BufStr) + 1);
  End;

  T := Copy (BufStr, 1, Pos (' ', BufStr) - 1);
  If T [1] in ['A'..'Z', 'a'..'z'] then
  Begin
    MenuItem. Flags := T;
    Delete (BufStr, 1, Pos (' ', BufStr));
  End;

  _Security := Copy (BufStr, 1, Pos (' ', BufStr) - 1);
  Val (_Security, MenuItem. Security, Result);
  Delete (BufStr, 1, Pos (' ', BufStr) );

  If BufStr [1] = '"' Then
  Begin
    Delete (BufStr, 1, 1); { Убираем кавычку }
    if Pos ('"', BufStr) = 0 then goto ErrorLine;
    MenuItem. Display := Copy (BufStr, 1, Pos ('"', BufStr) - 1);
    Delete (BufStr, 1, Pos ('"', BufStr) + 1);
  End;

  If (BufStr = '') Or (MenuItem. Action = cDisplayOnly)
  Then MenuItem. HotKey := #0 Else
  With MenuItem Do
  Begin
    T := UpString (BufStr);
    If T = 'KEYB_UP' Then HotKey := kbUp Else
    If T = 'KEYB_DOWN' Then HotKey := kbDown Else
    If T = 'KEYB_RIGHT' Then HotKey := kbRight Else
    If T = 'KEYB_LEFT' Then HotKey := kbLeft Else
    If T = 'KEYB_HOME' Then HotKey := kbHome Else
    If T = 'KEYB_END' Then HotKey := kbEnd Else
    HotKey := BufStr [1];
  End;

 SkipLine:
  MenuEnd := EoF (MenuFile);
End;

Procedure DoneMenuParser;
Begin
  If IsOpen Then
  Begin
    Close (MenuFile);
    IsOpen := False;
  End;
End;

Function UseMenu (MenuName: PathStr): Boolean;
Var
  Item  : tMenuItem;

Begin
  UseMenu := False;
  MenuItems^. DeleteAll;

{  If Not InitMenuParser (lang (laMenus) + MenuName + '.mnu') Then}
  If Not InitMenuParser (CompletePath (lang (laMenus)) + MenuName + '.mnu') Then
  If MenuName <> 'main' Then
  Begin
    LogWrite ('!', sm (smErrorAccessToMenu) + lang (laMenus) + MenuName + '.mnu');
    Exit;
  End Else
  Begin
    LogWrite ('!', sm (smErrorAccessToMain) + lang (laMenus) + MenuName + '.mnu');
    Halt (204);
  End;

  ReadMenuHeader (mHeader);

  While True Do
  Begin
    ReadMenuItem (Item);
    If Item. Action = 0 Then Break;

    MenuItems^. Insert (NewMenuItem (Item));
  End;

  DoneMenuParser;
  UseMenu := True;
End;

End.