unit F_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Menus, ExtCtrls, StdCtrls, ComCtrls, CheckLst, ToolWin, Grids,
  ValEdit, ImgList, StdActns, ActnList, CommDlg, SVATimer,
  U_ScriptHost, U_LogEmitter;

type
  TfrmMain = class(TForm)
    mnuMain: TMainMenu;
    mnuFile: TMenuItem;
    mnuHelp: TMenuItem;
    mnuHelpAbout: TMenuItem;
    mnuFileExit: TMenuItem;
    pnlScriptInfo: TPanel;
    splScriptStatus: TSplitter;
    grbStatus: TGroupBox;
    splStatusLog: TSplitter;
    lbxLog: TListBox;
    pnlStatus: TPanel;
    lsvStatus: TListView;
    pnlScripts: TPanel;
    splScriptContent: TSplitter;
    pgcScript: TPageControl;
    tshConsole: TTabSheet;
    tshSource: TTabSheet;
    mmoConsole: TMemo;
    tbrMain: TToolBar;
    btnPause: TToolButton;
    ToolButton1: TToolButton;
    btnAddScript: TToolButton;
    mmoCode: TMemo;
    aclMain: TActionList;
    actPauseResume: TAction;
    tshInfo: TTabSheet;
    vleInformation: TValueListEditor;
    imlMain: TImageList;
    btnLoad: TToolButton;
    actFileExit: TFileExit;
    actEditCut: TEditCut;
    actEditCopy: TEditCopy;
    actEditPaste: TEditPaste;
    actEditSelectAll: TEditSelectAll;
    actEditUndo: TEditUndo;
    actEditDelete: TEditDelete;
    Edit1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Delete1: TMenuItem;
    SelectAll1: TMenuItem;
    Undo1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    TrayIcon: TTrayIcon;
    pumTray: TPopupMenu;
    mnuTrayPause: TMenuItem;
    mnuTrayExit: TMenuItem;
    mnuTrayHide: TMenuItem;
    actHideShow: TAction;
    ToolButton2: TToolButton;
    actScriptNew: TAction;
    actFileSave: TAction;
    actFileOpen: TFileOpen;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    actWindowTopmost: TAction;
    Createscript1: TMenuItem;
    N3: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    lsvScripts: TListView;
    imlScriptIcons: TImageList;
    ToolButton11: TToolButton;
    actFileRefresh: TAction;
    ToolButton12: TToolButton;
    Refresh1: TMenuItem;
    N4: TMenuItem;
    procedure actPauseResumeExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure actFileOpenAccept(Sender: TObject);
    procedure actScriptNewExecute(Sender: TObject);
    procedure actWindowTopmostExecute(Sender: TObject);
    procedure actFileOpenOpenDialogCanClose(Sender: TObject;
      var CanClose: Boolean);
    procedure lsvScriptsItemChecked(Sender: TObject; Item: TListItem);
    procedure lsvScriptsSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ZBarLog(Sender: TObject; Text: string; LogLevel: TLogLevel = llInfo; IndentLevel: integer = 0);
    procedure ScriptHostPropertyChanged(Sender: TObject; PropertyName: string; Values: array of const);
    procedure actFileRefreshExecute(Sender: TObject);
    procedure mnuHelpAboutClick(Sender: TObject);
    procedure pgcScriptChange(Sender: TObject);
    procedure actHideShowExecute(Sender: TObject);
    procedure TrayIconDblClick(Sender: TObject);
    procedure pumTrayPopup(Sender: TObject);
  private
    { Private declarations }
    FScriptHost: TScriptHost;

    procedure LoadScripts;
    procedure RefreshStatus(ZBar: OleVariant);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation
uses
  L_ScriptingUtils, Dialogs, ComObj, ShellAPI, U_Script;

{$R *.dfm}

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.FormCreate(Sender: TObject);
var
  Index, TryCount: integer;
begin
  mnuFileExit.ShortCut := ShortCut(VK_F4, [ssAlt]);

  Index := imlMain.AddIcon(Application.Icon);
  mnuHelpAbout.ImageIndex := Index;

  // Try to create the tray icon
  TryCount := 0;
  repeat
    Inc(TryCount);
    try
      TrayIcon.Visible := True;
      Break;
    except
      if TryCount > 10 then begin
        raise;
      end else begin
        Sleep(500);
      end;
    end;
  until (False);

  FScriptHost := TScriptHost.Create(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'Scripts\');
  FScriptHost.OnLog := ZBarLog;
  FScriptHost.OnPropertyChanged := ScriptHostPropertyChanged;
  FScriptHost.Enabled := True;

  RefreshStatus(FScriptHost.Poller.ZBar);

  LoadScripts;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.LoadScripts;
var
  Index: integer;
  Item: TListItem;
  Script: TScript;
  sgfi: SHFILEINFO;
  FileIcon: TIcon;
begin
  lsvScripts.Clear;
  // Load all the scripts
  FScriptHost.ScriptManager.Refresh;
  for Index := 0 to FScriptHost.ScriptManager.Count - 1 do begin
    Script := FScriptHost.ScriptManager.Script[Index];
    Item := lsvScripts.Items.Add;
    if Script.IsLibrary then begin
      Item.GroupID := 0;
    end else begin
      Item.GroupID := 1;
    end;
    Item.Caption := Script.Name;
    Item.Checked := Script.Enabled;
    Item.Data := Script;
    // Get icon for filename, add it to the imagelist
    if 0 <> SHGetFileInfo(PChar(string(Script.Name)), FILE_ATTRIBUTE_NORMAL, sgfi, SizeOf(sgfi),
                          SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES) then begin
      FileIcon := TIcon.Create;
      FileIcon.Handle := sgfi.hIcon;
      Item.ImageIndex := TListView(Item.ListView).SmallImages.AddIcon(FileIcon);
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.lsvScriptsItemChecked(Sender: TObject; Item: TListItem);
var
  Script: TScript;
begin
  if Item.GroupID = 0 then begin
    Item.Checked := True;
  end else begin
    Script := TScript(Item.Data);
    if Assigned(Script) then begin
      Script.Enabled := Item.Checked;
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.lsvScriptsSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
const
  YesNo: array[0..1] of string = ('No', 'Yes');
var
  SelItem: TListItem;
  Script: TScript;
  i: Integer;
begin
  SelItem := lsvScripts.Selected;
  if Assigned(SelItem) then begin
    Script := TScript(Item.Data);
    if Assigned(Script) then begin
      Script.Enabled := Item.Checked;
      while vleInformation.RowCount > 3 do begin
        vleInformation.DeleteRow(3);
      end;
      // Fill all the relevant data
      vleInformation.Values['Name'] := Script.Name;
      vleInformation.Values['Language'] := Script.Engine.Language;

      if not Script.IsLibrary then begin
        if Script.HandledCommands.Count = 0 then begin
          vleInformation.Values['Commands'] := '(none)';
        end else begin
          vleInformation.Values['Commands'] := Script.HandledCommands.DelimitedText;
        end;
        if Script.HandledKeys.Count = 0 then begin
          if Script.HandlesKeyPress(0, False) then begin
            vleInformation.Values['Keys'] := '(all)';
          end else begin
            vleInformation.Values['Keys'] := '(none)';
          end;
        end else begin
          vleInformation.Values['Keys'] := Script.HandledKeys.DelimitedText;
        end;
        vleInformation.Values['Updates'] := YesNo[integer(Script.HandlesUpdate)];
      end else begin
        for i := 0 to Script.Procedures.Count - 1 do begin
          if i = 0 then begin
            vleInformation.Values['Functions'] := Script.Procedures[0];
          end else begin
            vleInformation.InsertRow('', Script.Procedures[i], True);
          end;
        end;
      end;

      mmoConsole.Text := Script.&Public.Output;
      mmoCode.Text := Script.Source;
    end;
//  end else begin
//    while (vleInformation.RowCount > 1) or (vleInformation.Keys[0] <> '') do begin
//      vleInformation.DeleteRow(0);
//    end;
//    // TODO: Fill all the relevant data
//    vleInformation.Keys[0] := 'Commands';
  end;
//  pgcScript.Visible := (lsvScripts.ItemFocused <> nil);
  tshConsole.TabVisible := Assigned(SelItem);
  tshSource.TabVisible := Assigned(SelItem);
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.mnuHelpAboutClick(Sender: TObject);
var
  Text, Title: string;
begin
  Text := 'Script Host ZAAP'#13#10
          + #13#10
          + '© Martijn Coppoolse'#13#10
          + 'http://martijn.coppoolse.com/software/';
  Title := Application.Title;
  MessageBox(Handle, PChar(Text), PChar(Title), MB_ICONINFORMATION);
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.pgcScriptChange(Sender: TObject);
begin
  if Assigned(lsvScripts.Selected) and (pgcScript.ActivePage = tshConsole) then begin
    mmoConsole.Text := TScript(lsvScripts.Selected.Data).&Public.Output;
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.pumTrayPopup(Sender: TObject);
begin
  if Self.Visible then begin
    actHideShow.Caption := '&Hide';
    actHideShow.ImageIndex := 20;
    Self.SetFocus;
  end else begin
    actHideShow.Caption := 'S&how';
    actHideShow.ImageIndex := 19;
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.RefreshStatus(ZBar: OleVariant);
begin
  LockWindowUpdate(lsvStatus.Handle);
  try
    lsvStatus.Clear;
    with lsvStatus.Items.Add do begin
      Caption := 'hWnd';
      SubItems.Add(IntToHex(ZBar.ZTreeHWND, 4));
    end;
    with lsvStatus.Items.Add do begin
      Caption := 'Sequence #';
      SubItems.Add(IntToStr(ZBar.SequenceNumber));
    end;
    with lsvStatus.Items.Add do begin
      Caption := 'Command';
      SubItems.Add(Chr(integer(ZBar.ZtreeCommand)));
    end;
    with lsvStatus.Items.Add do begin
      Caption := 'Char';
      SubItems.Add(Chr(integer(ZBar.ZtreeCommandChar)));
    end;
    with lsvStatus.Items.Add do begin
      Caption := 'Screen';
      SubItems.Add(Chr(integer(ZBar.ZtreeScreenStatus)));
    end;
    with lsvStatus.Items.Add do begin
      Caption := 'Page';
      SubItems.Add(Chr(integer(ZBar.ZtreePage)));
    end;
    with lsvStatus.Items.Add do begin
      Caption := 'Stats screen';
      SubItems.Add(Chr(integer(ZBar.ZtreeStatsScreen)));
    end;
    with lsvStatus.Items.Add do begin
      Caption := 'Filename';
      SubItems.Add(ZBar.NewFilename);
    end;
    with lsvStatus.Items.Add do begin
      Caption := 'Other File';
      SubItems.Add(ZBar.OtherFilename);
    end;
    with lsvStatus.Items.Add do begin
      Caption := 'Assist Cmd';
      SubItems.Add(ZBar.AssistCommand);
    end;
    lsvStatus.Column[0].Width := -2;
    lsvStatus.Column[1].Width := -2;
  finally
    LockWindowUpdate(0);
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.ZBarLog(Sender: TObject; Text: string; LogLevel: TLogLevel = llInfo; IndentLevel: integer = 0);
var
  Indentation: string;
  Lines: TStringList;
  i, MaxWidth, LineWidth: integer;
begin
  LockWindowUpdate(lbxLog.Handle);
  try
    if LogLevel = llError then begin
      MessageBeep(MB_ICONWARNING);
    end;

    Indentation := StringOfChar(' ', IndentLevel * 2);
    Lines := TStringList.Create;
    try
      Lines.Text := Text;
      MaxWidth := lbxLog.ScrollWidth;
      for i := 0 to Lines.Count - 1 do begin
        lbxLog.AddItem(Indentation + Lines[i], nil);
        LineWidth := Trunc(Self.Canvas.TextWidth(Indentation + Lines[i]) * 1.1);
        if LineWidth > MaxWidth then begin
          MaxWidth := LineWidth;
        end;
      end;
      lbxlog.ItemIndex := lbxLog.Items.Count - 1;
      lbxLog.ScrollWidth := MaxWidth;
    finally
      Lines.Free;
    end;
    while lbxLog.Count > 65535 do begin
      lbxLog.Items.Delete(0);
    end;
    if (LogLevel = llError) and (Sender is TScript) then begin
      for i := 0 to lsvScripts.Items.Count - 1 do begin
        if TScript(lsvScripts.Items[i].Data) = TScript(Sender) then begin
          lsvScripts.ItemIndex := i;
          Break;
        end;
      end;
    end;
  finally
    LockWindowUpdate(0);
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.ScriptHostPropertyChanged(Sender: TObject; PropertyName: string; Values: array of const);
begin
  if PropertyName = 'ZBar.SequenceNumber' then begin
    RefreshStatus(FScriptHost.Poller.ZBar);
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.TrayIconDblClick(Sender: TObject);
begin
  actHideShow.Execute;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.actFileOpenAccept(Sender: TObject);
var
  Dialog: TOpenDialog;
  i: Integer;
  FilesAdded: integer;
  SkippedFiles: TStringList;
begin
  SkippedFiles := TStringList.Create;
  try
    Dialog := actFileOpen.Dialog;
    FilesAdded := 0;
    for i := 0 to Dialog.Files.count - 1 do begin
      if ScriptLanguageFromExtension(Dialog.Files[i]) = '' then begin
        SkippedFiles.Add('- ' + ExtractFileName(Dialog.Files[i]));
      end else if not SameFileName(ExtractFilePath(Dialog.Files[i]), FScriptHost.ScriptManager.Path) then begin
        if CopyFile(PChar(Dialog.Files[i]), PChar(ChangeFilePath(Dialog.Files[i], FScriptHost.ScriptManager.Path)), True) then begin
          Inc(FilesAdded);
        end else begin
          SkippedFiles.Add(Format('- %s (%s)', [ExtractFileName(Dialog.Files[i]), SysErrorMessage(GetLastError)]));
        end;
      end;
    end;
    if SkippedFiles.Count > 0 then begin
      MessageBox(Self.Handle,
                 PChar(Format('%d files added.'#13#10#13#10'Could not load the following files:'#13#10
                        + '%s'#13#10
                        + 'Unable to determine the script language.',
                        [FilesAdded, SkippedFiles.Text])),
                 PChar('Open script(s)'), MB_ICONWARNING);
    end else begin
      MessageBox(Self.Handle,
                 PChar(Format('%d files added.', [FilesAdded])),
                 PChar('Open script(s)'), MB_ICONINFORMATION);
    end;
  finally
    SkippedFiles.Free;
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.actFileOpenOpenDialogCanClose(Sender: TObject;
  var CanClose: Boolean);
var
  i: Integer;
begin
  CanClose := False;
  for i := 0 to actFileOpen.Dialog.Files.Count - 1 do begin
    if ScriptLanguageFromExtension(actFileOpen.Dialog.Files[i]) <> '' then begin
      CanClose := True;
      Break;
    end;
  end;
  if CanClose = False then begin
    MessageBox(actFileOpen.Dialog.Handle,
               PChar('No script files have been selected.'),
               nil, MB_ICONWARNING);
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.actFileRefreshExecute(Sender: TObject);
begin
  LockWindowUpdate(lsvScripts.Handle);
  try
    LoadScripts;
  finally
    LockWindowUpdate(0);
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.actHideShowExecute(Sender: TObject);
begin
  Self.Visible := not Self.Visible;
  if Self.Visible then begin
    if (Self.WindowState = wsMinimized) then begin
      Self.WindowState := wsNormal;
    end;
    Self.SetFocus;
    SetForegroundWindow(Self.Handle);
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.actPauseResumeExecute(Sender: TObject);
var
  Action: TAction;
begin
  Action := TAction(Sender);

  if Action.Checked then begin
    FScriptHost.Enabled := False;
    Action.ImageIndex := 7;
    Action.Caption := '&Resume';
    Application.MainForm.Caption := Application.Title + ' (paused)';
    lsvStatus.Color := clBtnFace;
  end else begin
    Action.ImageIndex := 6;
    Action.Caption := '&Pause';
    Application.MainForm.Caption := Application.Title;
    FScriptHost.Enabled := True;
    lsvStatus.Color := clWindow;
  end;
  TrayIcon.Hint := Application.MainForm.Caption;
  Action.Hint := StringReplace(Action.Caption, '&', '', []);
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.actScriptNewExecute(Sender: TObject);
begin
  // TODO
end;

{ ---------------------------------------------------------------------------- }
procedure TfrmMain.actWindowTopmostExecute(Sender: TObject);
begin
  if TAction(Sender).Checked then begin
    Self.FormStyle := fsStayOnTop;
  end else begin
    Self.FormStyle := fsNormal;
  end;
end;

end.

