Gallery.pas

unit Gallery;

interface

uses
  Windows, Messages, SysUtils, Types, Classes, Graphics, Generics.Defaults,
  Generics.Collections, ASObjects, UITypes, Forms, Controls, ImageViewer,
  ASKernel, ClientDefs, ASTableEditor, MainForm, SndPlayer, TextEditor, ASNum,
  ASExpression, Menus;

type
  TGallery = class
  strict private class var
    FKernel: TASKernel;
    FImgFrame: TImageViewerGUI;
    class procedure CreatePixmapFrame(AObject: TAlgosimPixmap;
      const ATitle: string; ANewWindow: Boolean); static;
    class procedure CreateSoundFrame(AObject: TAlgosimSound;
      const ATitle: string; ANewWindow: Boolean); static;
    class procedure CreateTableFrame(AObject: TAlgosimTable;
      const ATitle: string; ANewWindow: Boolean); static;
    class procedure CreateTextFrame(AObject: TAlgosimObject;
      const ATitle: string; ANewWindow: Boolean); static;
  public
    class property Kernel: TASKernel read FKernel write FKernel;
    class function IsGalleryObject(AObject: TAlgosimObject): Boolean; static;
    // Makes a copy of the object or its content; treats AObject as read-only
    // and stores no reference to it.
    class procedure CreateFrame(AObject: TAlgosimObject;
      const ATitle: string = ''; ANewWindow: Boolean = False); static;
    class procedure ShowControl(AControl: TControl); static;
    class procedure Vacuum; static;
  end;

type
  TASOForm = class(TForm)
  protected
    FKernel: TASKernel;
    procedure DoClose(var Action: TCloseAction); override;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  public
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
  end;

  TSoundPlayerForm = class(TASOForm)
  protected
    procedure DoClose(var Action: TCloseAction); override;
  public
    SoundPlayer: TSoundPlayer;
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
  end;

  TTableForm = class(TASOForm)
  private
    FHasShown: Boolean;
  protected
    procedure DoShow; override;
  public
    TableEditor: TASTableEditor;
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
    destructor Destroy; override;
  end;

  TTextASOForm = class(TASOForm)
  strict private
    FObject: TAlgosimObject;
    FContextMenu: TPopupMenu;
    FViewType: Integer;
    procedure SetObject(AObject: TAlgosimObject);
    procedure UpdateView(AViewType: Integer = 1);
    procedure SetForm(Sender: TObject);
    procedure ContextMenuPopup(Sender: TObject);
  protected
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged);
      message WM_WINDOWPOSCHANGED;
    procedure DoClose(var Action: TCloseAction); override;
  public
    Console: TTextEditor;
    property &Object: TAlgosimObject write SetObject;
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
    destructor Destroy; override;
  end;

  TPixmapForm = class(TASOForm)
  public
    ImageViewerGUI: TImageViewerGUI;
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
  end;

implementation

uses
  Math, ASColors, FormFader, WinMgrForm;

function _scale(X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;

{ TASOForm }

procedure TASOForm.CMTextChanged(var Message: TMessage);
begin
  inherited;
  TWndMgr.CaptionChanged(Self);
end;

constructor TASOForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
  inherited;
  BorderStyle := bsSizeToolWin;
  TFormFader.Create(Self);
  TWindowWatcher.Create(Self);
end;

procedure TASOForm.DoClose(var Action: TCloseAction);
begin
  inherited;
  Action := caFree;
end;

{ TSoundPlayerForm }

constructor TSoundPlayerForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
  inherited;
  Caption := 'Audio Player';
  ClientHeight := TSoundPlayer.PreferredHeight;
  ClientWidth := 10 * TSoundPlayer.PreferredHeight;
  SoundPlayer := TSoundPlayer.Create(Self);
  SoundPlayer.Parent := Self;
  SoundPlayer.Align := alClient;
end;

procedure TSoundPlayerForm.DoClose(var Action: TCloseAction);
begin
  inherited;
  if Assigned(SoundPlayer) then
    SoundPlayer.Stop;
end;

{ TTextASOForm }

procedure TTextASOForm.ContextMenuPopup(Sender: TObject);
var
  i: Integer;
begin

  for i := 0 to FContextMenu.Items.Count - 1 do
    FContextMenu.Items[i].Checked := FContextMenu.Items[i].Tag = FViewType;
  
end;

constructor TTextASOForm.CreateNew(AOwner: TComponent; Dummy: Integer);
var
  mi: TMenuItem;
begin

  inherited;

  Caption := 'Object';
  Console := TTextEditor.Create(Self);
  Console.Parent := Self;
  Console.Align := alClient;
  Console.BorderType := btNone;
  Console.UseRuxThemes := True;
  Console.RulerVisible := False;
  Console.LineSpacing := 0;
  Console.ErrorMessageOnReadOnlyError := False;
  
  if Assigned(AlgosimMainForm) and Assigned(AlgosimMainForm.teConsole) then
  begin
    Console.Font.Assign(AlgosimMainForm.teConsole.Font);
    Console.BackgroundColor := AlgosimMainForm.teConsole.BackgroundColor;
    Console.ForegroundColor := AlgosimMainForm.teConsole.ForegroundColor;
  end;
  
  FContextMenu := TPopupMenu.Create(Self);
  FContextMenu.OnPopup := ContextMenuPopup;
  
  mi := TMenuItem.Create(FContextMenu);
  mi.Caption := 'Pretty form';
  mi.RadioItem := True;  
  mi.Tag := 1;
  mi.OnClick := SetForm;
  FContextMenu.Items.Add(mi);
  
  mi := TMenuItem.Create(FContextMenu);  
  mi.Caption := 'Single line';
  mi.RadioItem := True;  
  mi.Tag := 2;
  mi.OnClick := SetForm;  
  FContextMenu.Items.Add(mi);
  
  mi := TMenuItem.Create(FContextMenu);  
  mi.Caption := 'Truncated single line';
  mi.RadioItem := True;  
  mi.Tag := 3;
  mi.OnClick := SetForm;  
  FContextMenu.Items.Add(mi);
  
  mi := TMenuItem.Create(FContextMenu);  
  mi.Caption := 'Input form';
  mi.RadioItem := True;  
  mi.Tag := 4;
  mi.OnClick := SetForm;
  FContextMenu.Items.Add(mi);

  mi := TMenuItem.Create(FContextMenu);
  mi.Caption := 'Unformatted';
  mi.RadioItem := True;
  mi.Tag := 5;
  mi.OnClick := SetForm;
  FContextMenu.Items.Add(mi);

  Console.PopupMenu := FContextMenu;
  
end;

destructor TTextASOForm.Destroy;
begin
  FreeAndNil(FObject);
  inherited;
end;

procedure TTextASOForm.DoClose(var Action: TCloseAction);
begin
  inherited;
  if Assigned(Console) and Console.BalloonVisible then
  begin
    Console.HideBalloon; // dirty fix
    Action := caNone;
  end
end;

procedure TTextASOForm.SetForm(Sender: TObject);
begin
  if Sender is TMenuItem then
    UpdateView(TMenuItem(Sender).Tag);
end;

procedure TTextASOForm.SetObject(AObject: TAlgosimObject);
begin
  FreeAndNil(FObject);
  FObject := AObject.Clone;
  UpdateView;
end;

function ColorText(const AColor: TRGB): string;
var
  rgb: TRGB;
  hsv: THSV;
  name: string;
begin

  rgb := TRGB(AColor);
  hsv := THSV(AColor);

  Result := Format(
    'RGB      HSV'#13#10 +
    '%.3f    %d°'#13#10 +
    '%.3f    %.3f'#13#10 +
    '%.3f    %.3f'#13#10 +
    ''#13#10 +
    '%s',
    [
      rgb.Red, Round(hsv.Hue),
      rgb.Green, hsv.Saturation,
      rgb.Blue, hsv.Value,
      ColorToHex(rgb)
    ],
    TFormatSettings.Invariant);

  if TryGetColorName(rgb, name) then
    Result := Result + #13#10#13#10 + name;

end;

procedure TTextASOForm.UpdateView(AViewType: Integer);
var
  S: string;
  FO: TFormatOptions;
begin

  if FObject = nil then
    Exit;

  if Console = nil then
    Exit;

  if Assigned(FKernel) then
    FO := FKernel.FormatOptions
  else
    FO := DefaultFormatOptions;
    
  if FObject is TCustomFunctionObj then
    S := TCustomFunctionObj(FObject).ExprAsStr(False)
  else if (FObject is TAlgosimColor) and (AViewType = 1) then
    S := ColorText(FObject.ToColor)
  else
    case AViewType of
      1:
        S := FObject.GetAsMultilineText(FO);
      2:
        S := FObject.GetAsSingleLineText(FO);
      3:
        S := FObject.ToPreviewString;
      4:
        S := FObject.ToInputString;
      5:
        S := FObject.ToString;    
    else
      S := '';
    end;

  Console.PlainText := S;

  if  (FObject is TAlgosimColor) and (AViewType = 1) then
  begin
    Console.EditMode := emText;
    Console.RemoveClass('Color box');
    Console.AddClass(MakeClass('Color box', Console.Font.Size, [], FObject.ToColor));
    Console.AddLine;
    Console.AddLine('██████████████', 'Color box');
    Console.AddLine('██████████████', 'Color box');
  end;
    
  Console.EditMode := emReadOnly;
  Console.TextFile.GotoSOF;

  ClientHeight := EnsureRange
    (
      Console.TotalVerticalExtent + 2*GetSystemMetricsForWindow(SM_CYHSCROLL, Handle),
      100,
      600
    );
  ClientWidth := EnsureRange
    (
      Console.TotalHorizontalExtent + 3*GetSystemMetricsForWindow(SM_CXVSCROLL, Handle),
      200,
      800
    );

  FViewType := AViewType;
  
end;

procedure TTextASOForm.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  inherited;
  if Assigned(Console) then
    Console.MoveBalloonPostScroll;
end;

{ TPixmapForm }

constructor TPixmapForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin

  inherited;

  BorderStyle := bsSizeable;
  Caption := 'Pixmap';
  Color := clWhite;
  Width := _scale(800);
  Height := _scale(600);
  ImageViewerGUI := TImageViewerGUI.Create(Self);
  ImageViewerGUI.Parent := Self;
  ImageViewerGUI.Align := alClient;
  ScaleForPPI(Screen.PixelsPerInch);

end;

{ TTableForm }

constructor TTableForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
  inherited;
  Caption := 'Table';
  TableEditor := TASTableEditor.Create(Self);
  TableEditor.Parent := Self;
  TableEditor.Align := alClient;
  TableEditor.Color := clWindow;
end;

destructor TTableForm.Destroy;
begin
  FreeAndNil(TableEditor);
  inherited;
end;

procedure TTableForm.DoShow;
begin
  inherited;
  if not FHasShown and Assigned(TableEditor.Table) then
  begin
    ClientWidth := Math.Min(TableEditor.GetTotalHorizontalExtent + 100, Screen.WorkAreaWidth);
    ClientHeight := Math.Min(TableEditor.GetTotalVerticalExtent + 100, Screen.WorkAreaHeight);
    ClientWidth := Math.Min(TableEditor.GetTotalHorizontalExtent, Screen.WorkAreaWidth);   {ugly!}
    ClientHeight := Math.Min(TableEditor.GetTotalVerticalExtent, Screen.WorkAreaHeight);
    if Width > Screen.WorkAreaWidth then
      Width := Screen.WorkAreaWidth;
    if Height > Screen.WorkAreaHeight then
      Height := Screen.WorkAreaHeight;
    FHasShown := True;
  end;
end;

{ TGallery }

class procedure TGallery.CreateFrame(AObject: TAlgosimObject;
  const ATitle: string; ANewWindow: Boolean);
begin

  AssertMainThread;

  if AObject is TAlgosimPixmap then
    CreatePixmapFrame(TAlgosimPixmap(AObject), ATitle, ANewWindow)

  else if AObject is TAlgosimSound then
    CreateSoundFrame(TAlgosimSound(AObject), ATitle, ANewWindow)

  else if AObject is TAlgosimTable then
    CreateTableFrame(TAlgosimTable(AObject), ATitle, ANewWindow)

  else
    CreateTextFrame(AObject, ATitle, ANewWindow);

end;

class procedure TGallery.CreatePixmapFrame(AObject: TAlgosimPixmap;
  const ATitle: string; ANewWindow: Boolean);
var
  bm: TBitmap;
  Frm: TPixmapForm;
begin
  bm := AObject.Value.CreateGDIBitmap;
  try
    if ANewWindow then
    begin
      Frm := TPixmapForm.CreateNew(AlgosimMainForm);
      if not ATitle.IsEmpty then
        Frm.Caption := ATitle;
      Frm.ImageViewerGUI.ImageViewer.Bitmap := bm;
      Frm.ImageViewerGUI.ImageViewer.Caption := ATitle;
      Frm.Show;
    end
    else
    begin
      if AlgosimMainForm.GUIMode = guiConsole then
        AlgosimMainForm.GUIMode := guiMixed;
      if FImgFrame = nil then
      begin
        FImgFrame := TImageViewerGUI.Create(AlgosimMainForm);
        FImgFrame.Parent := AlgosimMainForm.GalleryPanel;
        FImgFrame.Align := alClient
      end;
      ShowControl(FImgFrame);
      FImgFrame.ImageViewer.Bitmap := bm;
    end;
  finally
    bm.Free;
  end;
end;

class procedure TGallery.CreateSoundFrame(AObject: TAlgosimSound;
  const ATitle: string; ANewWindow: Boolean);
var
  Frm: TSoundPlayerForm;
begin
  Frm := TSoundPlayerForm.CreateNew(AlgosimMainForm);
  if not ATitle.IsEmpty then
    Frm.Caption := ATitle;
  Frm.SoundPlayer.Sound := AObject.Value;
  Frm.Show;
end;

class procedure TGallery.CreateTableFrame(AObject: TAlgosimTable;
  const ATitle: string; ANewWindow: Boolean);
var
  Frm: TTableForm;
begin
  Frm := TTableForm.CreateNew(AlgosimMainForm);
  if not ATitle.IsEmpty then
    Frm.Caption := ATitle;
  Frm.TableEditor.Table := AObject.Value;
  Frm.Show;
end;

class procedure TGallery.CreateTextFrame(AObject: TAlgosimObject;
  const ATitle: string; ANewWindow: Boolean);
var
  Frm: TTextASOForm;
begin
  if AObject = nil then
    Exit;
  Frm := TTextASOForm.CreateNew(AlgosimMainForm);
  if not ATitle.IsEmpty then
    Frm.Caption := ATitle;
  Frm.&Object := AObject;
  Frm.Show;
end;

class function TGallery.IsGalleryObject(AObject: TAlgosimObject): Boolean;
begin
  Result := (AObject is TAlgosimPixmap) or (AObject is TAlgosimSound);
end;

class procedure TGallery.ShowControl(AControl: TControl);
begin
  for var i := 0 to AlgosimMainForm.GalleryPanel.ControlCount - 1 do
    AlgosimMainForm.GalleryPanel.Controls[i].Visible :=
      AlgosimMainForm.GalleryPanel.Controls[i] = AControl;
end;

class procedure TGallery.Vacuum;
begin
  for var i := AlgosimMainForm.GalleryPanel.ControlCount - 1 downto 0 do
    if AlgosimMainForm.GalleryPanel.Controls[i].ClassName.ToLower.Contains('temporary') then
      AlgosimMainForm.GalleryPanel.Controls[i].Free;
end;

end.