unit uBafClientTab;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// one tab of the client

interface

uses FMX.StdCtrls, FMX.TabControl, uBafTypes, FMX.Forms, System.Classes,
  System.SysUtils, FMX.Types, System.UITypes, FMX.Objects, FMX.ComboEdit,
  uBafInterpreter, uStringIniFile, FMX.Memo, uBafControls, System.Math,
  System.Contnrs;

type
  TBafClientTab = class(TPanel)
  protected
    FPanelControls: TPanel;
    FButtonClose: TButton;
    FPanelCaption: TPanel;
    FLabelCaption: TLabel;
    FPanelDesk: TPanel;
    FComboClose: boolean;
    FLine: TLine;
    FComboCmd: TComboEdit;
    FTimerCommand: string;

    FCmdTimer: TTimer;
    procedure CreatePanel(var APanel: TPanel; AParent: TFmxObject;
        AAlign: TAlignLayout);
    procedure CreateControls;
    procedure ButtonCloseClick(Sender: TObject);
    procedure ComboCmdKeyDown(Sender: TObject; var Key: Word;
        var KeyChar: Char; Shift: TShiftState);
    procedure ComboCloseUp(Sender: TObject);
    procedure FCmdTimerTimer(Sender: TObject);

  protected
    FTabType: TBafClientTabType;
    FIni: TStringIniFile;
    procedure CreateInter;
    procedure InterNeedCommand(AInter: TBafInterpreter; AName: string; ACode: TStrings);

    procedure InterLog(AInter: TBafInterpreter; ALogType, ALogText: string);
    procedure InterNeedInfo(AInter: TBafInterpreter; AName, AParam: string; var AInfo: string);
    procedure InterCaption(AInter: TBafInterpreter; ACaption: string);
    procedure InterShellExecOpen(AInter: TBafInterpreter; AFilename: string);
    procedure InterDebugLog(AInter: TBafInterpreter; ACaption: string);
    procedure InterDebugNode(AInter: TBafInterpreter; AIni: TStringIniFile);
    procedure InterChangeLanguage(Sender: TObject);
  private
    FCaption: string;
    FInter: TBafInterpreter;
    FCommand: string;
    FRightUserId: string;
    FPrior: TTabItem;
    procedure SetCaption(const Value: string);
    procedure SetRightUserId(const Value: string);
  protected
    FForm: TForm;
    FDebugTab: TTabItem;
    FPanelDebugOben, FPanelDebugUnten: TBafPanel;
    FMemoDebug: TMemo;
    FCheckDebug: TCheckBox;
    FButtonDebugClear: TButton;
    procedure CreateDebugTab(ADoDebug: boolean);
    procedure DebugCheckClick(Sender: TObject);
    procedure ButtonDebugClearClick(Sender: TObject);

  public
    constructor CreateTab(AOwner: TComponent; ATabType: TBafClientTabType;
        AForm: TForm = nil; ADoDebug: boolean = false);
    destructor Destroy; override;
    procedure DoCommand(ACmd: string);
    class procedure NewTab(ACaption, ACommand: string; ADoDebug: boolean);
    property Caption: string read FCaption write SetCaption;
    property Inter: TBafInterpreter read FInter;
    property RightUserId: string read FRightUserId write SetRightUserId;
    property Prior: TTabItem read FPrior write FPrior;
  end;


  procedure LoadCommands;

implementation

{ TBafClientTab }

uses foMain, uBafInterpreterModuleList, dmMain, foDebugLog, uBafDataCache;

var
  mvInter: integer;
  mvCommands: TStringList;

procedure NewCommand(ACommand: string);
var
  i: integer;
  s: string;
  LCombo: TComboEdit;
begin
  i := mvCommands.IndexOf(ACommand);
  if i > -1 then
    mvCommands.Delete(i);
  mvCommands.Insert(0, ACommand);

  for i := 0 to System.Math.Min(mvCommands.Count - 1, 20) do
    dataMain.UserIni.WriteString('Commands', 'cmd_' + IntToStr(i), mvCommands[i]);
  dataMain.UserIni.UpdateFile;

  for i := 0 to frmMain.BafTabList.Count - 1 do begin
    LCombo := (frmMain.BafTabList[i] as TBafClientTab).FComboCmd;
    s := LCombo.Text;
    LCombo.Items.Assign(mvCommands);
    LCombo.Text := s;
  end;
end;

procedure LoadCommands;
var
  i: integer;
  s: string;
begin
  for i := 0 to 20 do begin
    s := dataMain.UserIni.ReadString('Commands', 'cmd_' + IntToStr(i), '');
    if s <> '' then
      mvCommands.Add(s);
  end;
end;

procedure TBafClientTab.ButtonCloseClick(Sender: TObject);
begin
  Inter.IsConsole := false;
  frmDebugLog.CloseTab(FDebugTab);
  frmMain.CloseTab(Self, Prior);
end;

procedure TBafClientTab.ButtonDebugClearClick(Sender: TObject);
begin
  FMemoDebug.Lines.Clear;
end;

procedure TBafClientTab.ComboCloseUp(Sender: TObject);
begin
  FTimerCommand := FComboCmd.Text;
  FCmdTimer.Enabled := true;
end;

procedure TBafClientTab.ComboCmdKeyDown(Sender: TObject; var Key: Word;
  var KeyChar: Char; Shift: TShiftState);
begin
  if Key in [vkReturn, vkF12] then begin
    FTimerCommand := FComboCmd.Text;
    FCmdTimer.Enabled := true;
  end;
end;

procedure TBafClientTab.CreateControls;
begin
  CreatePanel(FPanelControls, Self, TAlignLayout.Top);
  FPanelControls.Height := 48;

  FLine := TLine.Create(Self);
  FLine.Parent := FPanelControls;
  FLine.LineType := TLineType.Bottom;
  FLine.Align := TAlignLayout.Client;
  FLine.Stroke.Color := TAlphaColorRec.DarkGray;

  FComboCmd := TComboEdit.Create(Self);
  FComboCmd.Parent := FPanelControls;
  FComboCmd.Position.X := 8;
  FComboCmd.Position.Y := 16;
  FComboCmd.Width := 400;
  FComboCmd.DropDownCount := 28;
  FComboCmd.OnKeyDown := ComboCmdKeyDown;
  FComboCmd.OnClosePopup := ComboCloseUp;

  FButtonClose := TButton.Create(Self);
  FButtonClose.Parent := FPanelControls;
  FButtonClose.Anchors := [TAnchorKind.akTop, TAnchorKind.akRight];
  FButtonClose.Width := 30;
  FButtonClose.Position.Y := 16;
  FButtonClose.Position.X := FPanelControls.Width - 38;
  FButtonClose.StyledSettings := [TStyledSetting.FontColor];
  FButtonClose.TextSettings.Font.Family := 'Font Awesome 5 Free';
  FButtonClose.StyleLookup := 'donetoolbutton';
  FButtonClose.Text := #$f410;
  FButtonClose.OnClick := ButtonCloseClick;

end;

procedure TBafClientTab.CreateDebugTab(ADoDebug: boolean);
begin
  try
    FDebugTab := frmDebugLog.TabControl1.Add;
    frmDebugLog.TabControl1.ActiveTab := FDebugTab;

    FPanelDebugOben := TBafPanel.Place(FDebugTab, TAlignLayout.Top);
    FPanelDebugOben.Height := 37;
    FCheckDebug := TCheckBox.Create(Self);
    FCheckDebug.Parent := FPanelDebugOben;
    FCheckDebug.Text := 'Aktiv';
    FCheckDebug.SetBounds(8, 8, 80, 24);
    FCheckDebug.IsChecked := ADoDebug;
    FInter.DebugLogActive := ADoDebug;
    FCheckDebug.OnClick := DebugCheckClick;

    FButtonDebugClear := TButton.Create(Self);
    FButtonDebugClear.Parent := FPanelDebugOben;
    FButtonDebugClear.Text := 'Clear log ';
    FButtonDebugClear.SetBounds(100, 8, 80, 24);
    FButtonDebugClear.OnClick := ButtonDebugClearClick;

    FPanelDebugUnten := TBafPanel.Place(FDebugTab, TAlignLayout.Client);
    FMemoDebug := TMemo.Create(Self);
    FMemoDebug.Parent := FPanelDebugUnten;
    FMemoDebug.Align := TAlignLayout.Client;
    FMemoDebug.Margins.Rect := Rect(8, 8, 8, 8);
    FMemoDebug.StyleLookup := 'Memotextstyle';
    FMemoDebug.WordWrap := false;

//    DebugCheckClick(FCheckDebug);
  except
    // sometimes it failes...
  end;
end;

procedure TBafClientTab.CreateInter;
begin
  inc(mvInter);
  FInter := TBafInterpreter.Create(itClient);
  FInter.Inter := FInter;
  FInter.Name := 'I' + IntToStr(mvInter);
  FInter.OnNeedCommand := InterNeedCommand;
  FInter.OnNeedInfo := InterNeedInfo;
  FInter.OnLog := InterLog;
  FInter.OnCaption := InterCaption;
  FInter.ParentPanel := FPanelDesk;
  FInter.OnDebugLog := InterDebugLog;
  FInter.OnDebugNode := InterDebugNode;
  FInter.OnClose := ButtonCloseClick;
  FInter.OnChangeLanguage := InterChangeLanguage;
  TBafInterpreterModuleList.CreateModule(FInter);
end;

procedure TBafClientTab.CreatePanel(var APanel: TPanel; AParent: TFmxObject;
  AAlign: TAlignLayout);
begin
  APanel := TPanel.Create(Self);
  APanel.Parent := AParent;
  APanel.Align := AAlign;
  APanel.StyleLookup := 'pushpanel';
end;

constructor TBafClientTab.CreateTab(AOwner: TComponent;
  ATabType: TBafClientTabType; AForm: TForm; ADoDebug: boolean);
begin
  inherited Create(AOwner);
  FForm := AForm;
  FTabType := ATabType;
  StyleLookup := 'pushpanel';

  if FTabType in [ttStandard] then begin
    CreateControls;
    FLabelCaption := TLabel.Create(Self);
    FLabelCaption.Parent := Self;
    FLabelCaption.Align := TAlignLayout.Top;
    FLabelCaption.Height := 40;
    FLabelCaption.Margins.Left := 8;
    FLabelCaption.Margins.Top := 8;
    FLabelCaption.StyledSettings := [];
    FLabelCaption.TextSettings.FontColor := TAlphaColorRec.Darkgray;
    FLabelCaption.TextSettings.Font.Style := [TFontStyle.fsBold];
    FLabelCaption.TextSettings.Font.Size := 24;
    FLabelCaption.Text := 'Neuer Tab';
  end;

  CreatePanel(FPanelDesk, Self, TAlignLayout.Client);


  CreateInter;
  if FTabType in [ttStandard] then
    CreateDebugTab(ADoDebug);
  FRightUserId := dataMain.RightUserId;
  FCmdTimer := TTimer.Create(Self);
  FCmdTimer.Enabled := false;
  FCmdTimer.Interval := 50;
  FCmdTimer.OnTimer := FCmdTimerTimer;
end;

procedure TBafClientTab.DebugCheckClick(Sender: TObject);
begin
  FInter.DebugLogActive := not FCheckDebug.IsChecked;
end;

destructor TBafClientTab.Destroy;
begin
  FreeAndNil(FInter);
  inherited;
end;

procedure TBafClientTab.DoCommand(ACmd: string);
var
  p: integer;
begin
  FCommand := ACmd;
  FComboCmd.Text := ACmd;
  NewCommand(ACmd);
  p := Pos('(', ACmd);
  if (Length(ACmd) > 1) and (ACmd[1] <> '#') then begin
    if p = 0 then begin
      Caption := ACmd;
      FCommand := ACmd;
    end
    else
      Caption := copy(ACmd, 1, p - 1);
  end;
  Inter.Execute(ACmd, true);
end;

procedure TBafClientTab.FCmdTimerTimer(Sender: TObject);
begin
  FCmdTimer.Enabled := false;
  DoCommand(FTimerCommand);
end;

procedure TBafClientTab.InterCaption(AInter: TBafInterpreter; ACaption: string);
begin
  case FTabType of
    ttStandard: FLabelCaption.Text := ACaption;
    ttToolbox: if Assigned(FForm) then
      FForm.Caption := ACaption;
  end;
end;

procedure TBafClientTab.InterChangeLanguage(Sender: TObject);
begin
  frmMain.LoadMenu;
end;

procedure TBafClientTab.InterDebugLog(AInter: TBafInterpreter;
  ACaption: string);
begin
  FMemoDebug.Lines.Add(ACaption);
  FMemoDebug.ScrollBy(0, MaxInt);
end;

procedure TBafClientTab.InterDebugNode(AInter: TBafInterpreter; AIni: TStringIniFile);
begin
  FIni := AIni;
  frmMain.DebugIni(AIni);
end;

procedure TBafClientTab.InterLog(AInter: TBafInterpreter; ALogType,
  ALogText: string);
begin
  frmMain.Log(ALogType, ALogText);
end;

procedure TBafClientTab.InterNeedCommand(AInter: TBafInterpreter; AName: string;
  ACode: TStrings);
begin
  AName := AnsiLowerCase(AName);
//  if not dataMain.GetCommand(AName, ACode) then
  if not gvBafCommandCache.GetCommand(AName, ACode) then
    InterLog(nil, 'E', 'Kommando nicht gefunden: ' + AName);
end;

procedure TBafClientTab.InterNeedInfo(AInter: TBafInterpreter; AName,
  AParam: string; var AInfo: string);
begin
  AName := AnsiLowerCase(AName);
  if AName = 'usrid' then AInfo := dataMain.GetUserInfo(AName, AParam)
  else if AName = 'rightusrid' then AInfo := dataMain.RightUserId
  else if AName = 'root' then AInfo := dataMain.Root
  else if AName = 'usrroot' then AInfo := dataMain.UserRoot
  else if AName = 'prog' then AInfo := 'BAF-Client ' + Caption
  else if AName = 'usrini' then AInfo := dataMain.UserIni.ReadString(CAT_USRDATA, AParam, '')
  else if AName = 'ini' then AInfo := dataMain.Ini.ReadString(CAT_DATA, AParam, '')


  // doesn't get info, only writing
  else if AName = 'settabcaption' then begin
    AInfo := '';
    Caption := AParam;
  end
  ;
end;

procedure TBafClientTab.InterShellExecOpen(AInter: TBafInterpreter;
  AFilename: string);
begin
   { TODO : ergänzen }
end;

class procedure TBafClientTab.NewTab(ACaption, ACommand: string; ADoDebug: boolean);
var
  LTab, LPrior: TTabItem;
  LBafTab: TBafClientTab;
  i: integer;
begin
  LPrior := frmMain.TabControl1.ActiveTab;
  LTab := frmMain.TabControl1.Insert(frmMain.TabControl1.TabCount - 1);
  LTab.Text := ACaption;
  frmMain.TabControl1.ActiveTab := LTab;

  LBafTab := TBafClientTab.CreateTab(LTab, ttStandard, nil, ADoDebug);
  LBafTab.Parent := LTab;
  LBafTab.Prior := LPrior;
  LBafTab.Align := TAlignLayout.Client;
  LBafTab.Caption := 'Neuer Tab';
  frmMain.BafTabList.Add(LBafTab);

  if ACommand <> '' then
    LBafTab.DoCommand(ACommand);

  for i := 0 to frmMain.BafTabList.Count - 1 do
    (frmMain.BafTabList[i] as TBafClientTab).FComboCmd.Items.Assign(mvCommands);
end;

procedure TBafClientTab.SetCaption(const Value: string);
begin
  FCaption := Value;
  (Parent.Parent as TTabItem).Text := Value;
//  FInter.ClientTabCaption := Value;
  FDebugTab.Text := Value;
end;

procedure TBafClientTab.SetRightUserId(const Value: string);
begin
  if Assigned(Self) then begin
    frmMain.DebugIni(FIni);
    if (FRightUserId <> Value) then begin
      DoCommand(FCommand);
      FRightUserId := Value;
    end;
  end;
end;

initialization
  mvCommands := TStringList.Create;

finalization
  FreeAndNil(mvCommands);

end.
