unit ASConsole;
{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}
interface
uses
Windows, Messages, SysUtils, Types, UITypes, Classes, Controls, StdCtrls, Forms,
Dialogs, Graphics, Menus, TextEditor, RUX, UxPanel, dlgmod, ComCtrls, ListViewEx,
Generics.Defaults, Generics.Collections, ASKernel, ASObjects, ASSounds, SndPlayer,
ExtCtrls, ASTable, ASTableEditor, SProgressIndicator, VisCtl, VisCtl2D, rgl,
ASAttributes, SyncObjs, ASStrFcns, DocSearchWin, ASDoc, ASPropMan;
type
TASEditor = class(TTextEditor, IHelpfulControl)
strict private
FMathInputMode: Boolean;
FMenuItems: TPopupMenu;
protected
FMathInputModeItem: TMenuItem;
procedure MathInputModeItemClick(Sender: TObject);
procedure DoBeforeContextPopup; override;
procedure KeyPress(var Key: Char); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
constructor Create(AOwner: TComponent); override;
function GetIdentAtCaret: string;
function GetTopicAtCaret: string;
function ContextHelp: Boolean;
property MathInputMode: Boolean read FMathInputMode write FMathInputMode;
end;
TKernelAsyncRequestEvent = procedure(Sender: TObject; const AInput: string) of object;
TASConsole = class(TASEditor)
strict private
FMenuItems: TPopupMenu;
FKernelAsyncRequest: TKernelAsyncRequestEvent;
protected
FNewCodeBlock: TMenuItem;
FExecCodeBlock: TMenuItem;
FRemoveCodeBlock: TMenuItem;
FCodeBlockMode: Boolean;
FCodeBlockBegin: Integer;
protected
procedure DoBeforeContextPopup; override;
function SeparatorLineText: string; virtual;
procedure NewCodeBlockClick(Sender: TObject);
procedure RemoveCodeBlockClick(Sender: TObject);
procedure ExecCodeBlockClick(Sender: TObject);
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure DoCliGetPromptClass(var AClassName: string); override;
procedure DoCliInput(var AInput: string; var ANewPrompt: Boolean); override;
procedure DoKernelAsyncRequest(const AInput: string); virtual;
procedure DoSelChange; override;
public
constructor Create(AOwner: TComponent); override;
procedure NewCodeBlock;
procedure RemoveCodeBlock;
procedure ExecCodeBlock;
function ReplaceAll(const FindQuery: TFindQuery; const ReplaceText: string; SelOnly: Boolean = False): Integer; override;
property OnKernelAsyncRequest: TKernelAsyncRequestEvent read FKernelAsyncRequest write FKernelAsyncRequest;
end;
[Panel('Text editor')]
TMathEditorForm = class(TTextEditorForm)
strict private
const
CFR_MATHINPUT = 100001;
private
function GetMathEditor: TASEditor;
protected
function GetEditorSubclass: TTextEditorClass; override;
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible, AEnabled, AChecked: Boolean); override;
procedure SetupToolMenu; override;
procedure LoadSettings; override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
property MathEditor: TASEditor read GetMathEditor;
end;
TConsoleForm = class;
TConsoleProperties = class(TMultiProcPropertyStore)
strict protected
function ID: TAlgosimObject;
function Name: TAlgosimObject;
function History: TAlgosimObject;
strict private
FConsoleForm: TConsoleForm;
function GetConsoleForm: TConsoleForm;
protected
property ConsoleForm: TConsoleForm read GetConsoleForm;
public
constructor Create; overload; override;
constructor Create(AConsoleForm: TConsoleForm); reintroduce; overload;
end;
TConsolesPropStore = class(TSingleProcPropertyStore)
protected
function LocalGetValue(const AKey: string): TAlgosimObject; override;
end;
[Panel('Console')]
TConsoleForm = class(TMathEditorForm)
strict private
class var FInstances: TList<TConsoleForm>;
class var FActiveInstance: TConsoleForm;
class constructor ClassCreate;
class destructor ClassDestroy;
class var FConsoleCounter: UInt32;
class var FConsolePropStores: TConsolesPropStore;
var FConsoleProperties: TConsoleProperties;
class var FConsolePropStoresOwnershipTransferred: Boolean;
class function GetConsolePropStoresOwnership: TConsolesPropStore; static;
const
InapplCmds:
array[0..8] of Integer
=
(
TTextEditorForm.TEF_NEWWIN,
TTextEditorForm.TEF_SORT,
TTextEditorForm.TEF_MAKEUNIQUE,
TTextEditorForm.TEF_TRUNCLINE,
TTextEditorForm.TEF_FILTERLINES,
TTextEditorForm.TEF_TRIMRIGHT,
TTextEditorForm.TEF_FILLCHAR,
TTextEditorForm.TEF_IMPORT,
TTextEditorForm.TEF_DOC
);
private
function GetConsole: TASConsole;
protected
function GetEditorSubclass: TTextEditorClass; override;
function CheckModified: Boolean; override;
procedure ConsoleKernelAsyncRequest(Sender: TObject; const AInput: string); virtual;
procedure DoEnter; override;
procedure BeginActive; override;
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible: Boolean; var AEnabled: Boolean; var AChecked: Boolean); override;
procedure SetupFileNaming; override;
procedure LoadSettings; override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
destructor Destroy; override;
property Console: TASConsole read GetConsole;
procedure KernelOutput(AKernel: TASKernel; AResult: TAlgosimObject);
class property ConsolePropStoresOwnership: TConsolesPropStore read GetConsolePropStoresOwnership;
class property ConsolePropStoresOwnershipTransferred: Boolean read FConsolePropStoresOwnershipTransferred;
class function VerifyInstance(AConsoleForm: TConsoleForm): Boolean;
class function ActiveInstance: TConsoleForm;
class property Instances: TList<TConsoleForm> read FInstances;
end;
[Panel('Identifiers')]
TIdentifierForm = class(TPanelForm, IHelpfulControl)
strict private
const
IFR_SHOWVARS = 1;
IFR_SHOWFCNS = 2;
IFR_SHOWOPS = 3;
IFR_HIDESYS = 4;
var
FListView: TListViewEx;
FIdents: TArray<TASKernel.TIdentInfo>;
FListViewPopup: TPopupMenu;
FmnuOpen,
FmnuInsert,
FmnuDelete,
FmnuRename,
FmnuCopyValue,
FmnuCopyValueMultiline,
FmnuCopyValueSingleLine,
FmnuCopyValueTruncatedSingleLine,
FmnuCopyValueInputForm,
FmnuCopyValueDefault,
FmnuCopyValueUnformatted,
FmnuCopyName,
FmnuSaveAs,
FmnuShowVariables,
FmnuShowKernelFunctions,
FmnuShowOperators,
FmnuHideSystem: TMenuItem;
FSelItemCaption: string;
procedure ListViewData(Sender: TObject; Item: TListItem);
procedure ListViewPopupPopup(Sender: TObject);
procedure OpenClick(Sender: TObject);
procedure InsertClick(Sender: TObject);
procedure DeleteClick(Sender: TObject);
procedure RenameClick(Sender: TObject);
procedure CopyNameClick(Sender: TObject);
procedure SaveAsClick(Sender: TObject);
procedure RefreshClick(Sender: TObject);
procedure CopyValueClick(Sender: TObject);
procedure ListViewDoubleClick(Sender: TObject);
procedure ListViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ListViewKeyPress(Sender: TObject; var Key: Char);
procedure ListViewSelCntChange(Sender: TObject);
procedure UpdateStatusBar;
class var FInstances: TList<TIdentifierForm>;
class constructor ClassCreate;
class destructor ClassDestroy;
class function FKernel: TASKernel; static;
protected
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible, AEnabled, AChecked: Boolean); override;
procedure SetupToolMenu; override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
destructor Destroy; override;
procedure UpdateIdents;
procedure OpenSelectedVariable;
procedure DeleteSelectedVariables;
class procedure RefreshLists;
procedure AfterConstruction; override;
function ContextHelp: Boolean;
class function IsDisposable: Boolean; override;
end;
[Panel('Text-based object viewer')]
TTextViewer = class(TTextEditorForm)
strict private
const
TBV_BASE = 100_000;
TBV_PRETTYFORM = TBV_BASE + 1;
TBV_SINGLELINE = TBV_BASE + 2;
TBV_TRUNCLINE = TBV_BASE + 3;
TBV_INPUTFORM = TBV_BASE + 4;
TBV_UNFORMATTED = TBV_BASE + 5;
TBV_FIRSTFORM = TBV_PRETTYFORM;
TBV_LASTFORM = TBV_UNFORMATTED;
var
FObject: TAlgosimObject;
FFormat: Integer;
FIdentifier: string;
procedure SetObject(const Value: TAlgosimObject);
protected
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible, AEnabled, AChecked: Boolean); override;
procedure PanelShortCut(var Msg: TWMKey; var Handled: Boolean); override;
procedure SetView(AForm: Integer);
procedure UpdateView;
procedure SetupToolMenu; override;
procedure UpdateCaption; override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
destructor Destroy; override;
property &Object: TAlgosimObject read FObject write SetObject;
property Identifier: string read FIdentifier write FIdentifier;
end;
[Panel('Sound player', 'wav')]
TSoundPlayerForm = class(TPanelForm, IHelpfulControl)
strict private
FPlayer: TSoundPlayer;
procedure SetSound(const ASound: TASSound);
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
function ContextHelp: Boolean;
property Player: TSoundPlayer read FPlayer;
property Sound: TASSound write SetSound;
end;
[Panel('Table editor')]
TTableForm = class(TPanelForm)
strict private
const
TBF_SETSIZE = 1;
TBF_SHOWBAR = 2;
TBF_GRIDLINES = 3;
TBF_EVENODDROWS = 4;
TBF_EVENODDCOLS = 5;
TBF_FIRSTROW = 6;
TBF_LASTROW = 7;
TBF_FIRSTCOL = 8;
TBF_LASTCOL = 9;
TBF_LEFT = 10;
TBF_CENTER = 11;
TBF_RIGHT = 12;
TBF_BOLD = 13;
TBF_ITALICS = 14;
TBF_UNDERLINE = 15;
TBF_CELLSTYLE = 16;
TBF_TABLESTYLE = 17;
var
FIdentifier: string;
FEditor: TASTableEditor;
FCellLabel: TLabel;
FCellValue: TTextEditor;
procedure SetTable(const ATable: TASTable);
procedure EditorActiveCellChanged(Sender: TObject);
procedure EditorZoomChange(Sender: TObject);
procedure CellValueKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure SetIdentifier(const Value: string);
procedure UpdateStatusBar;
protected
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible, AEnabled, AChecked: Boolean); override;
procedure SetupToolMenu; override;
procedure PanelShortCut(var Msg: TWMKey; var Handled: Boolean); override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
property Editor: TASTableEditor read FEditor;
property Table: TASTable write SetTable;
property Identifier: string read FIdentifier write SetIdentifier;
end;
[Panel('Task list')]
TTaskListForm = class(TPanelForm, IHelpfulControl)
strict private
const
TLF_PAUSE = 1;
TLF_RESUME = 2;
TLF_REMOVEALL = 3;
TLF_REMOVESEL = 4;
class var
FInstances: TList<TTaskListForm>;
class constructor ClassCreate;
class destructor ClassDestroy;
var
FTasks: TArray<TASKernel.TWorkQueueItem>;
FListView: TListViewEx;
FProgressWheel: TSProgressIndicator;
FHasInitialized: Boolean;
FListViewPopup: TPopupMenu;
mnuPause,
mnuResume,
mnuAbort,
mnuRemove,
mnuRemoveAll: TMenuItem;
procedure UpdateStatusBar;
procedure ListViewSelCntChange(Sender: TObject);
function ProgressWheelDynGetFilled(Sender: TObject;
out AOpacity: Double): Boolean;
procedure ListViewPopupPopup(Sender: TObject);
procedure ListViewMenuClick(Sender: TObject);
procedure ListViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ListViewDblClick(Sender: TObject);
procedure ShowTaskDetails;
protected
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible, AEnabled, AChecked: Boolean); override;
procedure SetupToolMenu; override;
procedure PanelShortCut(var Msg: TWMKey; var Handled: Boolean); override;
procedure Resize; override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
destructor Destroy; override;
class procedure ClassUpdateTasks(const ATasks: TArray<TASKernel.TWorkQueueItem>;
AKernel: TASKernel; AState: TExecStateEx; AError: Boolean);
procedure UpdateTasks(const ATasks: TArray<TASKernel.TWorkQueueItem>;
AKernel: TASKernel; AState: TExecStateEx; AError: Boolean);
function ContextHelp: Boolean;
class function IsDisposable: Boolean; override;
property ListView: TListViewEx read FListView;
end;
[Panel('Text buffer viewer')]
TTextBufferViewer = class(TTextEditorForm)
strict private
class var
FInstances: TDictionary<string, TTextBufferViewer>;
class constructor ClassCreate;
class destructor ClassDestroy;
var
FBufferName: string;
const
InapplCmds:
array[0..22] of Integer
=
(
TTextEditorForm.TEF_NEW,
TTextEditorForm.TEF_OPEN,
TTextEditorForm.TEF_SAVE,
TTextEditorForm.TEF_SAVEAS,
TTextEditorForm.TEF_RELOAD,
TTextEditorForm.TEF_OPENFOLDER,
TTextEditorForm.TEF_COPYFILENAME,
TTextEditorForm.TEF_AUTOREPLACE,
TTextEditorForm.TEF_HISTORY,
TTextEditorForm.TEF_FILLCHAR,
TTextEditorForm.TEF_SORT,
TTextEditorForm.TEF_MAKEUNIQUE,
TTextEditorForm.TEF_TRUNCLINE,
TTextEditorForm.TEF_FILTERLINES,
TTextEditorForm.TEF_TRIMRIGHT,
TTextEditorForm.TEF_REPLACE,
TTextEditorForm.TEF_DATETIME,
TTextEditorForm.TEF_CDATETIME,
TTextEditorForm.TEF_LOREM,
TTextEditorForm.TEF_INSCOLOR,
TTextEditorForm.TEF_IMPORT,
TTextEditorForm.TEF_DOC,
TTextEditorForm.TEF_ARL
);
protected
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible, AEnabled, AChecked: Boolean); override;
public
destructor Destroy; override;
procedure AddLine(const AText: string);
procedure Clear;
procedure LoadBuffer(const ABufferName: string);
class procedure TextBufferAppend(const ABufferName, ABufferText: string);
class procedure TextBufferClear(const ABufferName: string);
end;
TVisWnd = class abstract(TPanelForm)
strict private
FCreatingWith: Boolean;
private
FVisCtl: TVisCtl;
private const
VIW_SIZE = 101;
protected
function GetVisCtlClass: TVisCtlClass; virtual; abstract;
function PreserveControl: Boolean; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure FirstShow; override;
procedure PanelShortCut(var Msg: TWMKey; var Handled: Boolean); override;
procedure CmdExec(AID: Integer); override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
constructor CreateNewWith(AOwner: TComponent; AAdoptee: TControl); override;
destructor Destroy; override;
property VisCtl: TVisCtl read FVisCtl;
end;
[Panel('Diagram')]
TDiagramForm = class(TVisWnd, IHelpfulControl)
strict private
var FStatusCoordText: string;
var FStatusNormText: string;
function GetVisCtl2D: TVisCtl2D;
procedure DiagramHoverCoordChange(Sender: TObject; const X, Y: Double);
procedure DiagramViewChange(Sender: TObject);
procedure UpdateNormality;
protected
function GetVisCtlClass: TVisCtlClass; override;
procedure Resize; override;
procedure UpdateStatusBar;
public
function ContextHelp: Boolean;
procedure AfterConstruction; override;
property VisCtl2D: TVisCtl2D read GetVisCtl2D;
end;
TManagedDiagramForm = class(TDiagramForm)
protected
function GetVisCtlClass: TVisCtlClass; override;
function PreserveControl: Boolean; override;
end;
[Panel('Scene')]
TSceneForm = class(TVisWnd, IHelpfulControl)
strict private
function GetVisCtl3D: TVisCtl3D;
protected
function GetVisCtlClass: TVisCtlClass; override;
public
function ContextHelp: Boolean;
procedure AfterConstruction; override;
property VisCtl3D: TVisCtl3D read GetVisCtl3D;
end;
TManagedSceneForm = class(TSceneForm)
protected
function GetVisCtlClass: TVisCtlClass; override;
function PreserveControl: Boolean; override;
end;
[Panel('Program editor')]
TProgramEditorForm = class(TMathEditorForm, IHelpfulControl)
strict private
const
PEF_SHOWTREE = 200001;
PEF_EXECUTE = 200002;
const
WM_EXPRPARSED = WM_USER + 1;
PARSE_OK = 0;
PARSE_EMPTY = 1;
PARSE_FAILED = 2;
type
TBackgroundParser = class(TThread)
protected
FEditor: TProgramEditorForm;
procedure Execute; override;
public
constructor Create(AEditor: TProgramEditorForm);
end;
var
FReparseTimer: TTimer;
FBackgroundParser: TBackgroundParser;
FReparseEvent: TEvent;
FExpressionStringCS: TCriticalSection;
FExpressionString: string;
FParseResult: Integer;
FAST: string;
FStatusTextBase, FStatusTextPrio: string;
FSplitter: TUxSplitter;
teAST: TTextEditor;
FTreeWidthFraction: Double;
FHasActivated: Boolean;
FOutputConsoleGUID: TGUID;
procedure ReparseNeeded;
procedure ScheduleReparse;
procedure ReparseTimerTimer(Sender: TObject);
procedure WMExprParsed(var Message: TMessage); message WM_EXPRPARSED;
procedure SetAST(const AST: string);
procedure SetStatusText(const AText: string; APrio: Boolean);
procedure SplitterCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
procedure ASTResize(Sender: TObject);
function GetTreeVisible: Boolean;
procedure SetTreeVisible(const Value: Boolean);
class var
FProgramCounter: UInt32;
protected
procedure EditorChanged(Sender: TObject); override;
procedure Resize; override;
procedure Activate; override;
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible: Boolean; var AEnabled: Boolean; var AChecked: Boolean); override;
procedure SetupToolMenu; override;
procedure PanelShortCut(var Msg: TWMKey; var Handled: Boolean); override;
procedure SetupFileNaming; override;
class constructor ClassCreate;
procedure LoadSettings; override;
function GetFilters: TArray<TPair<string, string>>; override;
procedure FirstShow; override;
procedure SetupFileMasks(AItems: TFileTypeItems; var ADefExtSansPeriod: string); override;
function GetClientGUID: TGUID; override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
function OpenFileDialog: Boolean;
destructor Destroy; override;
function ContextHelp: Boolean;
property ShowTree: Boolean read GetTreeVisible write SetTreeVisible;
end;
[Panel('Documentation browser')]
TDocBrowser = class(TTextEditorForm, IHelpfulControl)
public
type
TSidebar = (sbNone, sbIndex, sbSearch);
strict private
class var FInstances: TList<TDocBrowser>;
class var FActiveInstance: TDocBrowser;
class constructor ClassCreate;
class destructor ClassDestroy;
class var FDocFileCounter: UInt32;
const
DOC_BACK = 5001;
DOC_FORWARD = 5002;
DOC_HOME = 5003;
DOC_INDEX = 5004;
DOC_SEARCH = 5005;
DOC_SOURCE = 5006;
DOC_PAGEINFO = 5007;
DOC_NEWWIN = 5008;
InapplCmds:
array[0..23] of Integer
=
(
TTextEditorForm.TEF_NEW,
TTextEditorForm.TEF_NEWWIN,
TTextEditorForm.TEF_OPEN,
TTextEditorForm.TEF_SAVE,
TTextEditorForm.TEF_SAVEAS,
TTextEditorForm.TEF_RELOAD,
TTextEditorForm.TEF_OPENFOLDER,
TTextEditorForm.TEF_COPYFILENAME,
TTextEditorForm.TEF_AUTOREPLACE,
TTextEditorForm.TEF_HISTORY,
TTextEditorForm.TEF_FILLCHAR,
TTextEditorForm.TEF_SORT,
TTextEditorForm.TEF_MAKEUNIQUE,
TTextEditorForm.TEF_TRUNCLINE,
TTextEditorForm.TEF_FILTERLINES,
TTextEditorForm.TEF_TRIMRIGHT,
TTextEditorForm.TEF_REPLACE,
TTextEditorForm.TEF_DATETIME,
TTextEditorForm.TEF_CDATETIME,
TTextEditorForm.TEF_LOREM,
TTextEditorForm.TEF_INSCOLOR,
TTextEditorForm.TEF_IMPORT,
TTextEditorForm.TEF_DOC,
TTextEditorForm.TEF_ARL
);
var
FHistory: TList<string>;
FHistoryIndex: Integer;
FTopic: string;
FTopicInfo: TTopicInfo;
FSearchPhrase: string;
FSearchOptions: TStringSearchOptions;
btnBack,
btnHistory,
btnForward,
btnHome,
btnIndex,
btnSearch,
btnGoto: TUxButton;
eFind: TTextEditor;
pmHistory: TPopupMenu;
FEditorMenu: TPopupMenu;
FSidebar: TSidebar;
pnSidebar: TUxClient;
FSplitter: TUxSplitter;
pnIndex, pnSearch: TUxClient;
teIndexFilter: TTextEditor;
lbIndex: TTextEditor;
FSearchForm: TDocSearchForm;
FPreGotoSidebar: TSidebar;
FGotoPath: Boolean;
FNoSideBarFocus: Boolean;
procedure LoadEditor(const ATopic: string);
procedure teDocViewHyperlinkClick(Sender: TObject;
const ALinkRec: TLinkRec);
procedure teDocViewNavRequest(Sender: TObject; AEditorCommand: Integer);
procedure teDocViewNavRequestGetEnabled(Sender: TObject;
AEditorCommand: Integer; var AEnabled: Boolean);
procedure BackButtonClick(Sender: TObject);
procedure HistoryButtonClick(Sender: TObject);
procedure ForwardButtonClick(Sender: TObject);
procedure HomeButtonClick(Sender: TObject);
procedure IndexButtonClick(Sender: TObject);
procedure SearchButtonClick(Sender: TObject);
procedure GotoButtonClick(Sender: TObject);
procedure pmHistoryPopup(Sender: TObject);
procedure GoHistoryMenu(Sender: TObject);
procedure ShowSource(Sender: TObject); overload;
procedure ShowPageInfo(Sender: TObject); overload;
procedure FindEditChange(Sender: TObject);
procedure FindEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure SetSidebar(const Value: TSidebar);
procedure SetupSidebarPanel;
procedure SetupIndexCtls;
procedure teIndexFilterChange(Sender: TObject);
procedure teIndexFilterKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure lbIndexChange(Sender: TObject);
procedure lbIndexKeyPress(Sender: TObject; var Key: Char);
procedure lbIndexKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure lbSearchMatchesKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure SetupSearchCtls;
procedure SearchTextKeyPress(Sender: TObject; var Key: Char);
procedure SearchTextKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
protected
var
FmnuGo: Integer;
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible, AEnabled, AChecked: Boolean); override;
procedure SetupToolMenu; override;
procedure SetupToolbar; override;
procedure SetupFileNaming; override;
function CheckModified: Boolean; override;
procedure PanelShortCut(var Msg: TWMKey; var Handled: Boolean); override;
procedure WMAppcommand(var Message: TMessage); message WM_APPCOMMAND;
procedure BeginActive; override;
procedure DoEnter; override;
procedure UpdateToolbarStates;
procedure Find(const AText: string = ''); override;
function GetEditorSubclass: TTextEditorClass; override;
procedure FirstShow; override;
function GetClientGUID: TGUID; override;
public
procedure PopulateIndex;
procedure Navigate(const ATopic: string); virtual;
procedure HistoryGo(AIndex: Integer); virtual;
procedure Back; virtual;
procedure Forward; virtual;
procedure Reload; virtual;
procedure ShowSource; overload;
procedure ShowPageInfo; overload;
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
destructor Destroy; override;
function ContextHelp: Boolean;
property NoSidebarFocus: Boolean read FNoSideBarFocus write FNoSideBarFocus;
property Sidebar: TSidebar read FSidebar write SetSidebar;
class procedure ShowDoc(const ATopic: string; ANewWindow: Boolean;
ASidebar: TSidebar = sbNone; AFocusSideBar: Boolean = False);
class procedure ShowDocOrIndex(const ATopic: string; ANewWindow: Boolean);
class function VerifyInstance(ADocBrowser: TDocBrowser): Boolean;
class function ActiveInstance: TDocBrowser;
class function IsDisposable: Boolean; override;
end;
[Panel('Documentation source viewer')]
TDocSourceForm = class(TTextEditorForm, IHelpfulControl)
strict private
class var FDocSrcFileCounter: UInt32;
var FTopic: string;
const
InapplCmds:
array[0..23] of Integer
=
(
TTextEditorForm.TEF_NEW,
TTextEditorForm.TEF_NEWWIN,
TTextEditorForm.TEF_OPEN,
TTextEditorForm.TEF_SAVE,
TTextEditorForm.TEF_SAVEAS,
TTextEditorForm.TEF_RELOAD,
TTextEditorForm.TEF_OPENFOLDER,
TTextEditorForm.TEF_COPYFILENAME,
TTextEditorForm.TEF_AUTOREPLACE,
TTextEditorForm.TEF_HISTORY,
TTextEditorForm.TEF_FILLCHAR,
TTextEditorForm.TEF_SORT,
TTextEditorForm.TEF_MAKEUNIQUE,
TTextEditorForm.TEF_TRUNCLINE,
TTextEditorForm.TEF_FILTERLINES,
TTextEditorForm.TEF_TRIMRIGHT,
TTextEditorForm.TEF_REPLACE,
TTextEditorForm.TEF_DATETIME,
TTextEditorForm.TEF_CDATETIME,
TTextEditorForm.TEF_LOREM,
TTextEditorForm.TEF_INSCOLOR,
TTextEditorForm.TEF_IMPORT,
TTextEditorForm.TEF_DOC,
TTextEditorForm.TEF_ARL
);
protected
procedure CmdExec(AID: Integer); override;
procedure CmdGetState(AID: Integer; var AVisible, AEnabled, AChecked: Boolean); override;
function CheckModified: Boolean; override;
procedure SetupFileNaming; override;
function GetEditorSubclass: TTextEditorClass; override;
procedure SetupFileMasks(AItems: TFileTypeItems; var ADefExtSansPeriod: string); override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
procedure LoadDoc(const ATopic: string);
function ContextHelp: Boolean;
class function IsDisposable: Boolean; override;
end;
[Panel('Pascal source viewer')]
TPascalSourceForm = class(TTextEditorForm, IHelpfulControl)
strict private
class var FPasSrcFileCounter: UInt32;
protected
function CheckModified: Boolean; override;
procedure SetupFileNaming; override;
function GetEditorSubclass: TTextEditorClass; override;
procedure FirstShow; override;
procedure SetupFileMasks(AItems: TFileTypeItems; var ADefExtSansPeriod: string); override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
procedure LoadText(const ACaption, AText: string;
ATopLine: Integer = 0; ABookmark1: Integer = -1; ABookmark2: Integer = -1);
function ContextHelp: Boolean;
class function IsDisposable: Boolean; override;
end;
[Panel('Visual object manager')]
TVisMgrForm = class(TListForm, IHelpfulControl)
strict private
class var FInstances: TList<TVisMgrForm>;
class constructor ClassCreate;
class destructor ClassDestroy;
class procedure VisObjChange(Sender: TObject);
class var FRefreshTimer: TTimer;
class procedure RefreshTimerTimer(Sender: TObject);
class procedure RefreshListDelayed;
strict private
FmiSettings,
FmiMetadata: TMenuItem;
protected
class function GetColumns: TArray<TListForm.TColumnRec>; override;
class function GetData: TArray<TListForm.TDataRow>; override;
procedure DefaultClick(Sender: TObject); override;
procedure DeleteClick(Sender: TObject); override;
procedure PopupMenuPopup(Sender: TObject); override;
procedure SetupToolMenu; override;
function SelectedObject: TVisObj;
function SelectedObjects: TArray<TVisObj>;
procedure mnuSettingsClick(Sender: TObject);
procedure mnuMetadataClick(Sender: TObject);
function RowIdentity: TListForm.TRowIdentity; override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
destructor Destroy; override;
function ContextHelp: Boolean;
end;
[Panel('Settings manager')]
TSettingsForm = class(TListForm, IHelpfulControl)
strict private
class var FInstances: TList<TSettingsForm>;
class constructor ClassCreate;
class destructor ClassDestroy;
class procedure SettingsChanged;
class var FRefreshTimer: TTimer;
class procedure RefreshTimerTimer(Sender: TObject);
class procedure RefreshListDelayed;
protected
class function GetColumns: TArray<TListForm.TColumnRec>; override;
class function GetData: TArray<TListForm.TDataRow>; override;
procedure DefaultClick(Sender: TObject); override;
procedure DeleteClick(Sender: TObject); override;
procedure PopupMenuPopup(Sender: TObject); override;
function RowIdentity: TListForm.TRowIdentity; override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
destructor Destroy; override;
function ContextHelp: Boolean;
end;
function IsGalleryObject(AObject: TAlgosimObject): Boolean;
procedure CreateSourceFrame(AFcnClass: TClass);
procedure CreateFrame(AObject: TAlgosimObject; const AName: string);
implementation
uses
Math, StrUtils, ASKernelDefs, TDMB, MainForm, ASExpression, ASTokenizer,
ASParser, Clipbrd, MultiInput, TableDialog, ASColors, ClientVisuals,
ObjectMetadataForm, UxForm, DoublePoint, IdentSearch, ShellAPI, Character,
FrontEndProps, ASSettings, ClientDefs, ImageSizeForm, ASSource, ASFcnMgr;
var
GInvFS: TFormatSettings;
const
DOT_OPERATOR = #$22c5;
PLUS_SIGN = '+';
HYPHEN_MINUS = '-';
MINUS_SIGN = #$2212;
SPACE = #$0020;
FIGURE_SPACE = #$2007;
RETURN_SYMBOL_DAWTL = #$21B2;
function Blend(AFactor: Double; C1, C2: TColor): TColor;
begin
C1 := ColorToRGB(C1);
C2 := ColorToRGB(C2);
const s = AFactor;
const t = 1 - s;
Result :=
RGB(
Round(s * GetRValue(C1) + t * GetRValue(C2)),
Round(s * GetGValue(C1) + t * GetGValue(C2)),
Round(s * GetBValue(C1) + t * GetBValue(C2))
);
end;
const
SPrettyForm = 'Pretty form';
SPrettyFormHint = 'Copies the value as a multiline string.';
SSingleLine = 'Single line';
SSingleLineHint = 'Copies the value as a single-line string.';
STruncatedSingleLine = 'Truncated single line';
STruncatedSingleLineHint = 'Copies the value as a single-line string with an upper bound on the string''s length.';
SInputForm = 'Input form';
SInputFormHint = 'Copies the value in input form.';
SUnformatted = 'Unformatted';
SUnformattedHint = 'Copies the value to clipboard in a simple form suitable for storage and exchange.';
function IsGalleryObject(AObject: TAlgosimObject): Boolean;
begin
Result := (AObject is TAlgosimPixmap) or (AObject is TAlgosimSound);
end;
procedure CreateSourceFrame(AFcnClass: TClass);
begin
if AFcnClass = nil then
Exit;
if not AFcnClass.InheritsFrom(TASFunction) then
Exit;
var LFrm := TUxForm.CreateNewForm<TPascalSourceForm>;
var LFcnName := '';
var LSource := '';
var LLineIndex := 0;
var LBookmark1 := -1;
var LBookmark2 := -1;
if
TAlgosimSource.TryGetSourceWithContextFor(
TASFunctionClass(AFcnClass),
LFcnName,
LSource,
LLineIndex,
LBookmark1,
LBookmark2
)
then
LFrm.LoadText(LFcnName, LSource, LLineIndex, LBookmark1, LBookmark2);
end;
procedure CreateFrame(AObject: TAlgosimObject; const AName: string);
begin
MainForm.AssertMainThread;
if AObject is TAlgosimPixmap then
begin
var LFrm := TUxForm.CreateNewForm<TImageViewerForm>;
var bm := TAlgosimPixmap(AObject).Value.CreateGDIBitmap;
try
LFrm.Bitmap := bm;
finally
bm.Free;
end;
LFrm.Caption := AName;
end
else if AObject is TAlgosimSound then
begin
var LFrm := TUxForm.CreateNewForm<TSoundPlayerForm>;
LFrm.Sound := TAlgosimSound(AObject).Value;
LFrm.Caption := AName;
LFrm.StatusText := AObject.ToString;
LFrm.RequestClientSize(LFrm.ScaleValue(300), LFrm.Player.PreferredHeight);
with GetParentForm(LFrm) do
Constraints.MinHeight := Height;
end
else if AObject is TAlgosimTable then
begin
var LFrm := TUxForm.CreateNewForm<TTableForm>;
LFrm.Table := TAlgosimTable(AObject).Value;
LFrm.Identifier := AName;
LFrm.RequestClientSize(
EnsureRange(LFrm.Editor.GetTotalHorizontalExtent + 24, LFrm.ScaleValue(200), LFrm.ScaleValue(1600)),
EnsureRange(LFrm.Editor.GetTotalVerticalExtent + 24, LFrm.ScaleValue(200), LFrm.ScaleValue(1000))
);
end
else if (AObject is TKernelFunctionObj) and TAlgosimSource.HasSourceFor(TKernelFunctionObj(AObject).FuncClass) then
begin
CreateSourceFrame(TKernelFunctionObj(AObject).FuncClass);
end
else
begin
var LFrm := TUxForm.CreateNewForm<TTextViewer>;
LFrm.&Object := AObject;
LFrm.Editor.RulerVisible := False;
LFrm.Identifier := AName;
LFrm.UpdateCaption;
end;
end;
class function TConsoleForm.ActiveInstance: TConsoleForm;
begin
if Assigned(FActiveInstance) and VerifyInstance(FActiveInstance) then
Result := FActiveInstance
else if Assigned(FInstances) and (FInstances.Count > 0) then
Result := FInstances.Last
else
Result := nil;
end;
procedure TConsoleForm.BeginActive;
begin
inherited;
FActiveInstance := Self;
end;
function TConsoleForm.CheckModified: Boolean;
begin
if TASSettings.GetSettingBool('Console_QuerySave', True) then
Result := inherited
else
Result := True;
end;
class constructor TConsoleForm.ClassCreate;
begin
FInstances := TList<TConsoleForm>.Create;
FConsoleCounter := 1;
FConsolePropStores := TConsolesPropStore.Create;
end;
class destructor TConsoleForm.ClassDestroy;
begin
if FConsolePropStoresOwnershipTransferred then
FConsolePropStores := nil
else
FreeAndNil(FConsolePropStores);
FreeAndNil(FInstances);
end;
procedure TConsoleForm.CmdExec(AID: Integer);
begin
if IndexInt(AID, InapplCmds) = -1 then
inherited;
end;
procedure TConsoleForm.CmdGetState(AID: Integer; var AVisible, AEnabled,
AChecked: Boolean);
begin
inherited;
if IndexInt(AID, InapplCmds) <> -1 then
AVisible := False;
end;
procedure TConsoleForm.ConsoleKernelAsyncRequest(Sender: TObject;
const AInput: string);
begin
if Assigned(AlgosimMainForm) then
AlgosimMainForm.MakeKernelAsyncRequest(Self, AInput);
end;
constructor TConsoleForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
if Console.FormattingProcessor = nil then
Console.FormattingProcessor := TAlgosim3FormattingProcessor.Create(Self);
Console.OnKernelAsyncRequest := ConsoleKernelAsyncRequest;
if Assigned(FInstances) then
FInstances.Add(Self);
if Assigned(FConsolePropStores) then
begin
FConsoleProperties := TConsoleProperties.Create(Self);
FConsolePropStores.AddSubstore(FConsoleProperties, Self.Caption);
end;
end;
destructor TConsoleForm.Destroy;
begin
if FActiveInstance = Self then
FActiveInstance := nil;
if Assigned(FConsolePropStores) and Assigned(FConsoleProperties) then
FConsolePropStores.DeleteSubstore(FConsoleProperties);
FConsoleProperties := nil;
if Assigned(FInstances) then
FInstances.Remove(Self);
inherited;
end;
procedure TConsoleForm.DoEnter;
begin
inherited;
FActiveInstance := Self;
end;
function TConsoleForm.GetConsole: TASConsole;
begin
Result := Editor as TASConsole;
end;
class function TConsoleForm.GetConsolePropStoresOwnership: TConsolesPropStore;
begin
if FConsolePropStoresOwnershipTransferred then
raise Exception.Create('Consoles global property store ownership already transferred.');
FConsolePropStoresOwnershipTransferred := True;
Result := FConsolePropStores;
end;
function TConsoleForm.GetEditorSubclass: TTextEditorClass;
begin
Result := TASConsole;
end;
procedure TConsoleForm.KernelOutput(AKernel: TASKernel; AResult: TAlgosimObject);
var
CmdLine: string;
X, X2: Integer;
begin
if AKernel = nil then
Exit;
AssertMainThread;
try
if Console.FCodeBlockMode then
begin
Console.FCodeBlockMode := False;
Console.EditMode := emConsole;
end;
CmdLine := Console.LastLine;
if Console.TextFile.AtLastLine then
begin
X := Console.CaretPos.X;
X2 := Console.SelEndPos.X;
end
else
begin
X := -1;
X2 := -1;
end;
Console.LastLine := '';
Console.CliBeginOutput;
try
if IsFailure(AResult) then
begin
Console.CliWriteLn(AResult.GetAsSingleLineText(AKernel.FormatOptions), 'Error');
Console.CliWrite(WordWrap(TAlgosimFailure(AResult).FailureReason), '');
if TAlgosimFailure(AResult).Source.Count > 0 then
Console.CliWrite(WordWrap('Call stack: ' + string.Join(', ', ASExpression.NodeNames(TAlgosimFailure(AResult).Source.ToArray))), '');
end
else
begin
Console.CliWrite(AResult.ExplainedOutput(AKernel.FormatOptions), 'Output');
end;
finally
Console.CliWriteLn;
Console.CliEndOutput;
if not CmdLine.IsEmpty then
begin
Console.LastLine := CmdLine;
if X <> -1 then
begin
Console.CaretPos := Point(X, Console.LineCount - 1);
if X2 <> X then
Console.SelEndPos := Point(X2, Console.LineCount - 1);
end;
end;
end;
finally
end;
end;
procedure TConsoleForm.LoadSettings;
begin
inherited;
Console.RulerVisible := TASSettings.GetSettingBool('Console_ShowRuler', False);
Console.CaretAfterEOL := TASSettings.GetSettingBool('Console_CaretBeyondEOL', False);
Console.MathInputMode := TASSettings.GetSettingBool('Console_MathInputMode', True);
Console.ShowHiddenCharacters := TASSettings.GetSettingBool('Console_ShowHiddenCharacters', False);
Console.LineHighlight := TASSettings.GetSettingBool('Console_LineHighlight', False);
end;
procedure TConsoleForm.SetupFileNaming;
begin
inherited;
Editor.TextFile.SetNamingData('Console %d', @FConsoleCounter);
end;
class function TConsoleForm.VerifyInstance(
AConsoleForm: TConsoleForm): Boolean;
begin
Result := Assigned(FInstances) and FInstances.Contains(AConsoleForm);
end;
constructor TASConsole.Create(AOwner: TComponent);
begin
inherited;
RulerVisible := False;
EditMode := emConsole;
TextFile.UseLineClasses := True;
AddClass(MakeClass('Prompt', Font.Size, [], Font.Color));
AddClass(MakeClass('Output', Font.Size, [], clGray));
AddClass(MakeClass('Error', Font.Size, [], clRed));
AddClass(MakeClass('Separator', Font.Size, [], TUx.ThemeData.InactiveCaptionColor));
FMenuItems := TPopupMenu.Create(Self);
FMenuItems.Items.NewBottomLine;
FNewCodeBlock := TMenuItem.Create(FMenuItems);
FNewCodeBlock.Caption := 'New code block'#9'Shift+Enter';
FNewCodeBlock.Hint := 'Creates a new code block in which a multi-line expression can be entered.';
FNewCodeBlock.OnClick := NewCodeBlockClick;
FMenuItems.Items.Add(FNewCodeBlock);
FExecCodeBlock := TMenuItem.Create(FMenuItems);
FExecCodeBlock.Caption := 'Execute code block'#9'Ctrl+Enter';
FExecCodeBlock.Hint := 'Executes the code block.';
FExecCodeBlock.OnClick := ExecCodeBlockClick;
FMenuItems.Items.Add(FExecCodeBlock);
FRemoveCodeBlock := TMenuItem.Create(FMenuItems);
FRemoveCodeBlock.Caption := 'Remove code block'#9'Shift+Esc';
FRemoveCodeBlock.Hint := 'Removes this code block, discarding its contents, and restores the single-line prompt.';
FRemoveCodeBlock.OnClick := RemoveCodeBlockClick;
FMenuItems.Items.Add(FRemoveCodeBlock);
AddMenuItems(FMenuItems.Items);
CliNewPrompt;
CustomBoxDrawing := True;
CliHistoryDialogFormClass := TUxForm0;
end;
procedure TASConsole.DoBeforeContextPopup;
begin
inherited;
FNewCodeBlock.Visible := not FCodeBlockMode;
FExecCodeBlock.Visible := FCodeBlockMode;
FRemoveCodeBlock.Visible := FCodeBlockMode;
end;
procedure TASConsole.DoCliGetPromptClass(var AClassName: string);
begin
AClassName := 'Prompt';
inherited;
end;
procedure TASConsole.DoCliInput(var AInput: string; var ANewPrompt: Boolean);
begin
if AInput.Trim.IsEmpty then
begin
if CliHistoryCount > 0 then
AInput := CliHistory[CliHistoryCount - 1]
else
begin
ANewPrompt := False;
Exit;
end;
end;
DoKernelAsyncRequest(AInput);
end;
procedure TASConsole.DoKernelAsyncRequest(const AInput: string);
begin
if Assigned(FKernelAsyncRequest) then
FKernelAsyncRequest(Self, AInput);
end;
procedure TASConsole.DoSelChange;
begin
inherited;
if FCodeBlockMode then
if Min(CaretPos.Y, SelEndPos.Y) >= FCodeBlockBegin then
EditMode := emText
else
EditMode := emReadOnly;
end;
procedure TASConsole.ExecCodeBlock;
begin
if not FCodeBlockMode then
Exit;
var S := '';
for var i := FCodeBlockBegin to LineCount - 1 do
S := S + Lines[i] + #13#10;
if S.Trim.IsEmpty then
begin
RemoveCodeBlock;
Exit;
end;
TextFile.GotoEOF;
AddLine(SeparatorLineText, 'Separator');
AddLine;
TextFile.GotoEOF;
FCodeBlockBegin := LineCount;
ClearUndoHistory;
EditMode := emReadOnly;
DoKernelAsyncRequest(S);
end;
procedure TASConsole.ExecCodeBlockClick(Sender: TObject);
begin
ExecCodeBlock;
end;
procedure TASConsole.KeyDown(var Key: Word; Shift: TShiftState);
begin
if FCodeBlockMode then
begin
if (Key = VK_RETURN) and (ssCtrl in Shift) then
begin
ExecCodeBlock;
Key := 0;
end
else if (Key = VK_ESCAPE) and (ssShift in Shift) then
begin
RemoveCodeBlock;
Key := 0;
end
else if (Key = VK_BACK) and (CaretPos.Y = FCodeBlockBegin) and
(CaretPos.X = 0) and not TextFile.HasSelection
then
Key := 0
else if (Key = Ord('A')) and (Shift = [ssCtrl]) then
begin
SelectLines(FCodeBlockBegin, LineCount - 1);
Key := 0;
end;
end
else if (Key = VK_RETURN) and (ssShift in Shift) then
begin
NewCodeBlock;
Key := 0;
end;
inherited;
end;
function IsKeyDown(AKey: Integer): Boolean;
begin
Result := GetKeyState(AKey) < 0;
end;
procedure TASConsole.NewCodeBlock;
begin
if FCodeBlockMode then
Exit;
TextFile.GotoEOF;
var S := '';
if LineCount > 0 then
S := Lines[LineCount - 1];
EditMode := emText;
Lines[LineCount - 1] := SeparatorLineText;
LineClasses[LineCount - 1] := 'Separator';
AddLine(S);
FCodeBlockBegin := CaretPos.Y;
if not S.IsEmpty then
Return;
FCodeBlockMode := True;
ClearUndoHistory;
end;
procedure TASConsole.NewCodeBlockClick(Sender: TObject);
begin
NewCodeBlock;
end;
procedure TASConsole.RemoveCodeBlock;
begin
if not FCodeBlockMode then
Exit;
var S := '';
for var i := FCodeBlockBegin to LineCount - 1 do
S := S + Lines[i] + #13#10;
if not S.Trim.IsEmpty then
begin
if TD('Do you want to discard the code block?').YesNo.Execute <> mrYes then
Exit;
end;
FCodeBlockMode := False;
EditMode := emText;
TruncateFileAt(FCodeBlockBegin - 1, 0);
LineClasses[FCodeBlockBegin - 1] := 'Prompt';
TextFile.GotoEOF;
ClearUndoHistory;
EditMode := emConsole;
end;
procedure TASConsole.RemoveCodeBlockClick(Sender: TObject);
begin
RemoveCodeBlock;
end;
function TASConsole.ReplaceAll(const FindQuery: TFindQuery;
const ReplaceText: string; SelOnly: Boolean): Integer;
begin
if FCodeBlockMode then
begin
TextFile.FirstNonReadOnlyLine := FCodeBlockBegin;
try
Result := inherited;
finally
TextFile.FirstNonReadOnlyLine := 0;
end;
end
else
Result := inherited;
end;
function TASConsole.SeparatorLineText: string;
begin
Result := StringOfChar('─', 80);
end;
function TASEditor.ContextHelp: Boolean;
begin
var LTopic := GetTopicAtCaret;
Result := not LTopic.IsEmpty;
if Result then
TDocBrowser.ShowDocOrIndex(LTopic, False);
end;
constructor TASEditor.Create(AOwner: TComponent);
begin
inherited;
TabSpaces := False;
FMathInputMode := True;
FMenuItems := TPopupMenu.Create(Self);
FMathInputModeItem := TMenuItem.Create(FMenuItems);
FMathInputModeItem.Caption := 'Math input mode';
FMathInputModeItem.Hint := 'If checked, the asterisk (*) and hyphen-minus (-) keyboard keys will primarily and alternatingly insert mathematical operators ⋅ and −.';
FMathInputModeItem.OnClick := MathInputModeItemClick;
FMenuItems.Items.Add(FMathInputModeItem);
AddMenuItems(FMenuItems.Items);
end;
procedure TASEditor.DoBeforeContextPopup;
begin
inherited;
FMathInputModeItem.Visible := not ((EditMode = emReadOnly) and TextFile.StrictReadOnly);
FMathInputModeItem.Checked := MathInputMode;
end;
function TASEditor.GetIdentAtCaret: string;
begin
var S := TextFile.CurrentLine;
var e := CaretPos.X + 1;
while (e <= S.Length) and not (S[e].IsWhiteSpace or S[e].IsInArray(['(', ')', '[', ']'])) do
Inc(e);
var b := Min(CaretPos.X, S.Length);
while (b >= 1) and not (S[b].IsWhiteSpace or S[b].IsInArray(['(', ')', '[', ']'])) do
Dec(b);
Result := Copy(s, b + 1, e - b - 1);
end;
function TASEditor.GetTopicAtCaret: string;
begin
if TextFile.HasSelection then
Result := SelText.Trim
else
Result := GetWord.Trim;
if Result.IsEmpty then
Result := GetIdentAtCaret.Trim;
end;
procedure TASEditor.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (Key = VK_SPACE) and ([ssShift, ssCtrl] <= Shift) then
begin
AddIndent;
Key := 0;
end
else if (Key = VK_BACK) and ([ssShift, ssCtrl] <= Shift) then
begin
RemoveIndent;
Key := 0;
end
else if (Key = VK_TAB) and (Shift = []) and (EditMode <> emReadOnly) then
begin
var L := Lines[CaretPos.Y];
var SP: Integer;
var EP: Integer;
var Filter := '';
if GetWordBoundary(SP, EP) then
Filter := Copy(L, SP + 1, CaretPos.X - SP)
else
begin
Filter := '';
SP := -1;
end;
var Res := ShowIdents(GetParentFormSafe(Self), AlgosimMainForm.Kernel, TASKernel.AllIdentTypes, Filter);
if not Res.IsEmpty then
begin
if SP <> -1 then
begin
L := Copy(L, 1, SP) + Res + Copy(L, EP + 1);
Lines[CaretPos.Y] := L;
var P := CaretPos;
P.X := SP + Res.Length;
CaretPos := P;
end
else
SelText := Res;
end;
Key := 0;
end
else if (Key = VK_TAB) and (Shift = [ssCtrl]) then
InsertText(DupeString(#32, TabLength))
else
inherited;
end;
procedure TASEditor.KeyPress(var Key: Char);
var
DisplayKey: Char;
S: string;
procedure Surround(const ALeft, ARight: string);
begin
SurroundText(ALeft, ARight);
if ALeft.Length > 0 then
DisplayKey := ALeft[ALeft.Length];
Key := #0;
end;
procedure InsertBinOp(const AOp: string);
begin
if (GetCharBeforeCaret = #32) and not TextFile.HasSelection then
SelText := AOp + #32
else
SelText := AOp;
if AOp.Length > 0 then
DisplayKey := AOp[AOp.Length];
Key := #0;
end;
procedure InsertUnOp(const AOp: string);
begin
SelText := AOp;
if AOp.Length > 0 then
DisplayKey := AOp[AOp.Length];
Key := #0;
end;
begin
DisplayKey := #0;
if IsKeyDown(VK_CONTROL) and IsKeyDown(VK_SHIFT) then
begin
case Key of
^S:
begin
Surround('{', '}');
Exit;
end;
^V, ^E:
begin
Surround('❨', '❩');
Exit;
end;
^F:
begin
Surround('⌊', '⌋');
Exit;
end;
^C:
begin
Surround('⌈', '⌉');
Exit;
end;
^L:
begin
Surround('''(', ')');
Exit;
end;
^U:
begin
InsertBinOp('∪');
Exit;
end;
^I:
begin
InsertBinOp('∩');
Exit;
end;
^D:
begin
InsertBinOp('∧');
Exit;
end;
^O:
begin
InsertBinOp('∨');
Exit;
end;
^X:
begin
InsertBinOp('⊻');
Exit;
end;
^N:
begin
InsertUnOp('¬');
Exit;
end;
^T:
begin
InsertBinOp('↦');
Exit;
end;
end;
end;
if FMathInputMode then
begin
case Key of
'*':
if
(SelLength = 0) and
(GetCharBeforeCaret = DOT_OPERATOR) and
(CaretPos.X > 0) and
(CaretPos.X <= TextFile.PhysicalLineWidths[CaretPos.Y])
then
begin
S := Lines[CaretPos.Y];
if S[CaretPos.X] = DOT_OPERATOR then
S[CaretPos.X] := '*';
Lines[CaretPos.Y] := S;
Key := #0;
DisplayKey := '*';
end
else
Key := DOT_OPERATOR;
'-':
if
(SelLength = 0) and
(GetCharBeforeCaret = MINUS_SIGN) and
(CaretPos.X > 0) and
(CaretPos.X <= TextFile.PhysicalLineWidths[CaretPos.Y])
then
begin
S := Lines[CaretPos.Y];
if S[CaretPos.X] = MINUS_SIGN then
S[CaretPos.X] := '-';
Lines[CaretPos.Y] := S;
Key := #0;
DisplayKey := '-';
end
else
Key := MINUS_SIGN;
end;
end;
if DisplayKey = #0 then
begin
if Key = #$A then
DisplayKey := #$9
else
DisplayKey := Key;
end;
inherited;
end;
procedure TASEditor.MathInputModeItemClick(Sender: TObject);
begin
MathInputMode := not MathInputMode;
end;
procedure TMathEditorForm.CmdExec(AID: Integer);
begin
case AID of
CFR_MATHINPUT:
MathEditor.MathInputModeItemClick(Self);
else
inherited;
end;
end;
procedure TMathEditorForm.CmdGetState(AID: Integer; var AVisible, AEnabled,
AChecked: Boolean);
begin
case AID of
CFR_MATHINPUT:
AChecked := MathEditor.MathInputMode
end;
inherited;
end;
constructor TMathEditorForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
MathEditor.MathInputMode := True;
end;
function TMathEditorForm.GetEditorSubclass: TTextEditorClass;
begin
Result := TASEditor;
end;
function TMathEditorForm.GetMathEditor: TASEditor;
begin
Result := Editor as TASEditor;
end;
procedure TMathEditorForm.LoadSettings;
begin
inherited;
var LFontName := TASSettings.GetSettingString('Editor_FontName', '');
if not LFontName.IsEmpty then
Editor.Font.Name := LFontName;
Editor.Zoom := TASSettings.GetSettingInteger('Editor_ZoomLevel', 100);
end;
procedure TMathEditorForm.SetupToolMenu;
begin
inherited;
SimpleMenu.AddCommand(CFR_MATHINPUT, FmnuOptions, MathEditor.FMathInputModeItem.Caption, MathEditor.FMathInputModeItem.Hint);
end;
procedure TIdentifierForm.AfterConstruction;
begin
inherited;
UpdateIdents;
end;
class constructor TIdentifierForm.ClassCreate;
begin
FInstances := TList<TIdentifierForm>.Create;
end;
class destructor TIdentifierForm.ClassDestroy;
begin
FreeAndNil(FInstances);
end;
procedure TIdentifierForm.CmdExec(AID: Integer);
begin
case AID of
IFR_SHOWVARS:
FmnuShowVariables.Click;
IFR_SHOWFCNS:
FmnuShowKernelFunctions.Click;
IFR_SHOWOPS:
FmnuShowOperators.Click;
IFR_HIDESYS:
FmnuHideSystem.Click;
else
inherited;
end;
end;
procedure TIdentifierForm.CmdGetState(AID: Integer; var AVisible, AEnabled,
AChecked: Boolean);
begin
case AID of
IFR_SHOWVARS:
AChecked := FmnuShowVariables.Checked;
IFR_SHOWFCNS:
AChecked := FmnuShowKernelFunctions.Checked;
IFR_SHOWOPS:
AChecked := FmnuShowOperators.Checked;
IFR_HIDESYS:
AChecked := FmnuHideSystem.Checked;
else
inherited;
end;
end;
function TIdentifierForm.ContextHelp: Boolean;
begin
if
Assigned(FListView)
and
(FListView.SelCount = 1)
and
InRange(FListView.ItemIndex, 0, High(FIdents))
and
TASDoc.TopicExists(FIdents[FListView.ItemIndex].Name)
then
TDocBrowser.ShowDoc(FIdents[FListView.ItemIndex].Name, False)
else
TDocBrowser.ShowDocOrIndex('Identifiers panel', False) ;
Result := True;
end;
procedure TIdentifierForm.CopyNameClick(Sender: TObject);
begin
if FListView = nil then
Exit;
if FListView.SelCount <> 1 then
Exit;
if FListView.ItemIndex = -1 then
Exit;
if not InRange(FListView.ItemIndex, 0, High(FIdents)) then
Exit;
Clipboard.AsText := FIdents[FListView.ItemIndex].Name;
end;
procedure TIdentifierForm.CopyValueClick(Sender: TObject);
begin
var LFormat := 0;
if Sender is TMenuItem then
LFormat := TMenuItem(Sender).Tag;
if FListView = nil then
Exit;
if FListView.SelCount <> 1 then
Exit;
if FListView.ItemIndex = -1 then
Exit;
if not InRange(FListView.ItemIndex, 0, High(FIdents)) then
Exit;
const Ident = FIdents[FListView.ItemIndex];
if not (Ident.IdentType in [itVariable, itFcnVariable]) then
Exit;
if FKernel = nil then
Exit;
var LockInfo := Default(TASKernel.TLockInfo);
FKernel.LockObjStore(LockInfo);
try
const Obj = FKernel.GetVariableRef(Ident.Name, I_Will_Not_Modify_The_Object);
if Assigned(Obj) then
case LFormat of
0:
Obj.CopyToClipboard;
1:
Clipboard.AsText := Obj.GetAsMultilineText(FKernel.FormatOptions);
2:
Clipboard.AsText := Obj.GetAsSingleLineText(FKernel.FormatOptions);
3:
Clipboard.AsText := Obj.ToPreviewString;
4:
Clipboard.AsText := Obj.ToInputString;
5:
Clipboard.AsText := Obj.ToString;
end;
finally
FKernel.UnlockObjStore(LockInfo);
end;
end;
constructor TIdentifierForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
FListView := TListViewEx.Create(Self);
FListView.Parent := Self;
FListView.Align := alClient;
FListView.BorderStyle := bsNone;
FListView.ViewStyle := vsReport;
FListView.ShowColumnHeaders := False;
FListView.ReadOnly := True;
FListView.MultiSelect := True;
FListView.OwnerData := True;
FListView.OnData := ListViewData;
FListView.OnDblClick := ListViewDoubleClick;
FListView.OnKeyDown := ListViewKeyDown;
FListView.OnKeyPress := ListViewKeyPress;
FListView.OnSelCntChange := ListViewSelCntChange;
var LCol := FListView.Columns.Add;
LCol.Caption := 'Name';
LCol.Width := ScaleValue(124);
LCol := FListView.Columns.Add;
LCol.Caption := 'Type';
LCol.Width := ScaleValue(124);
LCol := FListView.Columns.Add;
LCol.Caption := 'Value';
LCol.AutoSize := True;
StatusBar := True;
if Assigned(FInstances) then
FInstances.Add(Self);
end;
procedure TIdentifierForm.DeleteClick(Sender: TObject);
begin
DeleteSelectedVariables;
end;
procedure TIdentifierForm.DeleteSelectedVariables;
var
Names,
Values,
CMDs: TArray<string>;
begin
if FListView = nil then
Exit;
if FKernel = nil then
Exit;
var Indices := FListView.GetSelectedIndicesFast;
if Length(Indices) = 0 then
Exit;
SetLength(Names, Length(Indices));
SetLength(Values, Length(Indices));
var c := 0;
var ProtectionCount := 0;
for var i := 0 to High(Indices) do
begin
if not InRange(Indices[i], 0, High(FIdents)) then
Exit;
const Ident = FIdents[Indices[i]];
if not (Ident.IdentType in [itVariable, itFcnVariable]) then
Continue;
if iaProtected in Ident.Attributes then
begin
Inc(ProtectionCount);
Continue;
end;
Names[c] := Ident.Name;
Values[c] := Ident.Preview;
Inc(c);
end;
SetLength(Names, c);
SetLength(Values, c);
if c = 0 then
begin
if ProtectionCount > 0 then
if Length(Indices) = 1 then
TD('The selected variable is protected and cannot be deleted.').Info.Execute(Self)
else
TD('All of the selected variables are protected and cannot be deleted.').Info.Execute(Self);
Exit;
end;
if
TTableDialog.ShowTable(
AlgosimMainForm,
'Algosim',
'Do you want to delete these variables?',
names,
values,
[mrYes, mrNo],
['&Yes', '&No'],
mrYes,
mrNo,
mtConfirmation
) = mrYes
then
begin
SetLength(CMDs, Length(Names));
for var i := 0 to High(Names) do
begin
if not IsValidIdent(Names[i]) then
raise Exception.CreateFmt('"%s" is not a valid identifier.', [Names[i]]);
CMDs[i] := Format('try(delete(%s))', [Names[i]]);
end;
const CMD = string.Join('; ', CMDs);
if CMD.IsEmpty then
Exit;
var Res := FKernel.Evaluate(CMD);
if IsFailure(Res) then
raise Exception.Create(TAlgosimFailure(Res).FailureReason);
TIdentifierForm.RefreshLists;
end;
end;
destructor TIdentifierForm.Destroy;
begin
if Assigned(FInstances) then
FInstances.Remove(Self);
inherited;
end;
class function TIdentifierForm.FKernel: TASKernel;
begin
Result := AlgosimMainForm.Kernel;
end;
procedure TIdentifierForm.InsertClick(Sender: TObject);
begin
if FListView = nil then
Exit;
if FListView.SelCount <> 1 then
Exit;
if FListView.ItemIndex = -1 then
Exit;
if not InRange(FListView.ItemIndex, 0, High(FIdents)) then
Exit;
if AlgosimMainForm = nil then
Exit;
var LActiveConsole := TConsoleForm.ActiveInstance;
if LActiveConsole = nil then
begin
TD('There is no console in which this identifier can be inserted.').Execute(Self);
Exit;
end;
if (LActiveConsole.Console.EditMode = emConsole) and not LActiveConsole.Console.TextFile.AtLastLine then
LActiveConsole.Console.TextFile.GotoEOF;
LActiveConsole.Console.SelText := FIdents[FListView.ItemIndex].Name;
end;
class function TIdentifierForm.IsDisposable: Boolean;
begin
Result := True;
end;
procedure TIdentifierForm.ListViewData(Sender: TObject; Item: TListItem);
function BriefTypeName(const S: string): string;
const
Prefix = 'structure of type "';
Suffix = string('"');
begin
if S.StartsWith(Prefix) and S.EndsWith(Suffix) then
Result := Copy(S, Succ(Prefix.Length), S.Length - Prefix.Length - Suffix.Length)
else
Result := S;
end;
begin
if Item = nil then
Exit;
if not InRange(Item.Index, 0, High(FIdents)) then
Exit;
const Ident = FIdents[Item.Index];
Item.Caption := Ident.Name;
case Ident.IdentType of
itFunction:
begin
Item.SubItems.Add(Ident.IdentType.ToString);
Item.SubItems.Add('');
end;
itOperator:
begin
Item.SubItems.Add(Ident.&Operator.Kind.ToString);
Item.SubItems.Add(Ident.&Operator.&Function.NodeName);
end;
itVariable,
itFcnVariable:
begin
Item.SubItems.Add(BriefTypeName(Ident.TypeName));
Item.SubItems.Add(Ident.Preview)
end;
end;
end;
procedure TIdentifierForm.ListViewDoubleClick(Sender: TObject);
begin
OpenSelectedVariable;
end;
procedure TIdentifierForm.ListViewKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_RETURN:
OpenSelectedVariable;
VK_DELETE:
DeleteSelectedVariables;
VK_F2:
RenameClick(Sender);
VK_F5:
RefreshLists;
end;
end;
procedure TIdentifierForm.ListViewKeyPress(Sender: TObject; var Key: Char);
begin
case Key of
^C:
CopyValueClick(nil);
^S:
SaveAsClick(Sender);
end;
end;
procedure TIdentifierForm.ListViewPopupPopup(Sender: TObject);
begin
if FListView = nil then
Exit;
const HasSel = FListView.SelCount > 0;
const SingleSel = (FListView.SelCount = 1) and (FListView.ItemIndex <> -1) and
InRange(FListView.ItemIndex, 0, High(FIdents));
const IsVar = SingleSel and (FIdents[FListView.ItemIndex].IdentType in [itVariable, itFcnVariable]);
const IsKernelFcn = SingleSel and (FIdents[FListView.ItemIndex].IdentType = itFunction);
FmnuOpen.Enabled := IsVar or IsKernelFcn;
FmnuInsert.Enabled := SingleSel;
FmnuCopyValueMultiline.Enabled := IsVar;
FmnuCopyValueSingleLine.Enabled := IsVar;
FmnuCopyValueTruncatedSingleLine.Enabled := IsVar;
FmnuCopyValueInputForm.Enabled := IsVar;
FmnuCopyValueDefault.Enabled := IsVar;
FmnuCopyValueUnformatted.Enabled := IsVar;
FmnuCopyName.Enabled := SingleSel;
FmnuDelete.Enabled := HasSel and (IsVar or not SingleSel);
FmnuRename.Enabled := IsVar;
FmnuSaveAs.Enabled := IsVar;
end;
procedure TIdentifierForm.ListViewSelCntChange(Sender: TObject);
begin
UpdateStatusBar;
FSelItemCaption := '';
if Assigned(FListView) and (FListView.SelCount = 1) then
begin
var LItem := FListView.Selected;
if Assigned(LItem) then
FSelItemCaption := LItem.Caption;
end;
end;
procedure TIdentifierForm.OpenClick(Sender: TObject);
begin
OpenSelectedVariable;
end;
procedure TIdentifierForm.OpenSelectedVariable;
begin
if FListView.SelCount <> 1 then
Exit;
if not InRange(FListView.ItemIndex, 0, High(FIdents)) then
Exit;
const Ident = FIdents[FListView.ItemIndex];
if not (Ident.IdentType in [itVariable, itFcnVariable, itFunction]) then
Exit;
if FKernel = nil then
Exit;
if Ident.IdentType = itFunction then
begin
var LFcnClass := TASFunctionClass(nil);
if
Assigned(TFunctionMgr.Functions)
and
TFunctionMgr.Functions.TryGetValue(Ident.Name, LFcnClass)
then
CreateSourceFrame(LFcnClass);
Exit;
end;
var LockInfo := Default(TASKernel.TLockInfo);
FKernel.LockObjStore(LockInfo);
try
const Obj = FKernel.GetVariableRef(Ident.Name, I_Will_Not_Modify_The_Object);
if Assigned(Obj) then
CreateFrame(Obj, Ident.Name);
finally
FKernel.UnlockObjStore(LockInfo);
end;
end;
procedure TIdentifierForm.RefreshClick(Sender: TObject);
begin
UpdateIdents;
end;
class procedure TIdentifierForm.RefreshLists;
begin
if Assigned(FInstances) then
for var LInstance in FInstances do
LInstance.UpdateIdents;
end;
procedure TIdentifierForm.RenameClick(Sender: TObject);
begin
if FListView = nil then
Exit;
if FListView.SelCount <> 1 then
Exit;
if FListView.ItemIndex = -1 then
Exit;
if not InRange(FListView.ItemIndex, 0, High(FIdents)) then
Exit;
const Ident = FIdents[FListView.ItemIndex];
if not (Ident.IdentType in [itVariable, itFcnVariable]) then
Exit;
if iaProtected in Ident.Attributes then
begin
TD('The selected variable is protected and cannot be renamed.').Info.Execute(Self);
Exit;
end;
var S := Ident.Name;
if
TMultiInputBox.TextInputBoxEx(
GetParentFormSafe(Self),
'Algosim',
'Please enter the name of the variable:',
S,
UITypes.TEditCharCase.ecNormal,
FKernel.IsValidIdent
)
and
(S <> Ident.Name)
then
begin
if FKernel.VariableExists(S) then
begin
TD.TextFmt('There already exists a variable named "%s".', [S]).Info.Execute;
Exit;
end;
var Res := FKernel.Evaluate(
(
'if(succeeded(%NewName), error("There already exists a variable named ""%NewName"".")); ' +
'%NewName ≔ %OldName; delete(%OldName)'
)
.Replace('%OldName', Ident.Name)
.Replace('%NewName', S)
);
if IsFailure(Res) then
raise Exception.Create(TAlgosimFailure(Res).FailureReason);
TIdentifierForm.RefreshLists;
end;
end;
procedure TIdentifierForm.SaveAsClick(Sender: TObject);
begin
if FListView = nil then
Exit;
if FListView.SelCount <> 1 then
Exit;
if FListView.ItemIndex = -1 then
Exit;
if not InRange(FListView.ItemIndex, 0, High(FIdents)) then
Exit;
const Ident = FIdents[FListView.ItemIndex];
if not (Ident.IdentType in [itVariable, itFcnVariable]) then
Exit;
if FKernel = nil then
Exit;
var LockInfo := Default(TASKernel.TLockInfo);
FKernel.LockObjStore(LockInfo);
try
const Obj = FKernel.GetVariableRef(Ident.Name, I_Will_Not_Modify_The_Object);
if Assigned(Obj) then
Obj.SaveToFile(AlgosimMainForm, Ident.Name);
finally
FKernel.UnlockObjStore(LockInfo);
end
end;
procedure TIdentifierForm.SetupToolMenu;
begin
inherited;
FListViewPopup := TPopupMenu.Create(Self);
FListViewPopup.OnPopup := ListViewPopupPopup;
FMnuOpen := TMenuItem.Create(FListViewPopup);
FMnuOpen.Caption := 'Open';
FMnuOpen.Hint := 'Opens this variable in a new window.';
FMnuOpen.Default := True;
FMnuOpen.OnClick := OpenClick;
FListViewPopup.Items.Add(FMnuOpen);
FMnuInsert := TMenuItem.Create(FListViewPopup);
FMnuInsert.Caption := 'Insert';
FMnuInsert.Hint := 'Inserts the identifier at the console''s caret (replacing any selection).';
FMnuInsert.OnClick := InsertClick;
FListViewPopup.Items.Add(FMnuInsert);
FListViewPopup.Items.NewBottomLine;
FmnuDelete := TMenuItem.Create(FListViewPopup);
FmnuDelete.Caption := 'Delete'#9'Del';
FmnuDelete.Hint := 'Deletes the selected variable(s).';
FmnuDelete.OnClick := DeleteClick;
FListViewPopup.Items.Add(FmnuDelete);
FmnuRename := TMenuItem.Create(FListViewPopup);
FmnuRename.Caption := 'Rename'#9'F2';
FmnuRename.Hint := 'Renames the currently selected variable.';
FmnuRename.OnClick := RenameClick;
FListViewPopup.Items.Add(FmnuRename);
FmnuCopyValue := TMenuItem.Create(FListViewPopup);
FmnuCopyValue.Caption := 'Copy value';
FListViewPopup.Items.Add(FmnuCopyValue);
FmnuCopyValueDefault := TMenuItem.Create(FmnuCopyValue);
FmnuCopyValueDefault.Caption := 'Default form'#9'Ctrl+C';
FmnuCopyValueDefault.Hint := 'Copies the value to clipboard using the default format.';
FmnuCopyValueDefault.Tag := 0;
FmnuCopyValueDefault.OnClick := CopyValueClick;
FmnuCopyValue.Add(FmnuCopyValueDefault);
FmnuCopyValue.NewBottomLine;
FmnuCopyValueMultiline := TMenuItem.Create(FmnuCopyValue);
FmnuCopyValueMultiline.Caption := SPrettyForm;
FmnuCopyValueMultiline.Hint := SPrettyFormHint;
FmnuCopyValueMultiline.Tag := 1;
FmnuCopyValueMultiline.OnClick := CopyValueClick;
FmnuCopyValue.Add(FmnuCopyValueMultiline);
FmnuCopyValueSingleLine := TMenuItem.Create(FmnuCopyValue);
FmnuCopyValueSingleLine.Caption := SSingleLine;
FmnuCopyValueSingleLine.Hint := SSingleLineHint;
FmnuCopyValueSingleLine.Tag := 2;
FmnuCopyValueSingleLine.OnClick := CopyValueClick;
FmnuCopyValue.Add(FmnuCopyValueSingleLine);
FmnuCopyValueTruncatedSingleLine := TMenuItem.Create(FmnuCopyValue);
FmnuCopyValueTruncatedSingleLine.Caption := STruncatedSingleLine;
FmnuCopyValueTruncatedSingleLine.Hint := STruncatedSingleLineHint;
FmnuCopyValueTruncatedSingleLine.Tag := 3;
FmnuCopyValueTruncatedSingleLine.OnClick := CopyValueClick;
FmnuCopyValue.Add(FmnuCopyValueTruncatedSingleLine);
FmnuCopyValueInputForm := TMenuItem.Create(FmnuCopyValue);
FmnuCopyValueInputForm.Caption := SInputForm;
FmnuCopyValueInputForm.Hint := SInputFormHint;
FmnuCopyValueInputForm.Tag := 4;
FmnuCopyValueInputForm.OnClick := CopyValueClick;
FmnuCopyValue.Add(FmnuCopyValueInputForm);
FmnuCopyValue.NewBottomLine;
FmnuCopyValueUnformatted := TMenuItem.Create(FmnuCopyValue);
FmnuCopyValueUnformatted.Caption := SUnformatted;
FmnuCopyValueUnformatted.Hint := SUnformattedHint;
FmnuCopyValueUnformatted.Tag := 5;
FmnuCopyValueUnformatted.OnClick := CopyValueClick;
FmnuCopyValue.Add(FmnuCopyValueUnformatted);
FmnuCopyName := TMenuItem.Create(FListViewPopup);
FmnuCopyName.Caption := 'Copy name';
FmnuCopyName.Hint := 'Copies the name of the identifier to clipboard.';
FmnuCopyName.OnClick := CopyNameClick;
FListViewPopup.Items.Add(FmnuCopyName);
FmnuSaveAs := TMenuItem.Create(FListViewPopup);
FmnuSaveAs.Caption := 'Save as...'#9'Ctrl+S';
FmnuSaveAs.Hint := 'Saves the variable to a file.';
FmnuSaveAs.OnClick := SaveAsClick;
FListViewPopup.Items.Add(FmnuSaveAs);
FListViewPopup.Items.NewBottomLine;
FmnuShowVariables := TMenuItem.Create(FListViewPopup);
FmnuShowVariables.Caption := 'Show variables';
FmnuShowVariables.Hint := 'Displays variables in the list.';
FmnuShowVariables.Checked := True;
FmnuShowVariables.AutoCheck := True;
FmnuShowVariables.OnClick := RefreshClick;
FListViewPopup.Items.Add(FmnuShowVariables);
FmnuShowKernelFunctions := TMenuItem.Create(FListViewPopup);
FmnuShowKernelFunctions.Caption := 'Show functions';
FmnuShowKernelFunctions.Hint := 'Displays kernel functions in the list.';
FmnuShowKernelFunctions.AutoCheck := True;
FmnuShowKernelFunctions.OnClick := RefreshClick;
FListViewPopup.Items.Add(FmnuShowKernelFunctions);
FmnuShowOperators := TMenuItem.Create(FListViewPopup);
FmnuShowOperators.Caption := 'Show operators';
FmnuShowOperators.Hint := 'Displays operators in the list.';
FmnuShowOperators.AutoCheck := True;
FmnuShowOperators.OnClick := RefreshClick;
FListViewPopup.Items.Add(FmnuShowOperators);
FListViewPopup.Items.NewBottomLine;
FmnuHideSystem := TMenuItem.Create(FListViewPopup);
FmnuHideSystem.Caption := 'Hide system symbols';
FmnuHideSystem.Hint := 'Hides fundamental system symbols.';
FmnuHideSystem.Checked := True;
FmnuHideSystem.AutoCheck := True;
FmnuHideSystem.OnClick := RefreshClick;
FListViewPopup.Items.Add(FmnuHideSystem);
FListView.PopupMenu := FListViewPopup;
CreateToolMenu;
SimpleMenu.AddCommand(IFR_SHOWVARS, FmnuShowVariables.Caption, FmnuShowVariables.Hint);
SimpleMenu.AddCommand(IFR_SHOWFCNS, FmnuShowKernelFunctions.Caption, FmnuShowKernelFunctions.Hint);
SimpleMenu.AddCommand(IFR_SHOWOPS, FmnuShowOperators.Caption, FmnuShowOperators.Hint);
SimpleMenu.AddCommand(0, '-', '');
SimpleMenu.AddCommand(IFR_HIDESYS, FmnuHideSystem.Caption, FmnuHideSystem.Hint);
end;
procedure TIdentifierForm.UpdateIdents;
begin
const LSelItemCaption = FSelItemCaption;
if AlgosimMainForm = nil then
Exit;
const LKernel = AlgosimMainForm.Kernel;
if LKernel = nil then
Exit;
var IdentTypes: TASKernel.TIdentTypes := [];
if Assigned(FmnuShowVariables) and FmnuShowVariables.Checked then
begin
Include(IdentTypes, itVariable);
Include(IdentTypes, itFcnVariable);
end;
if Assigned(FmnuShowKernelFunctions) and FmnuShowKernelFunctions.Checked then
Include(IdentTypes, itFunction);
if Assigned(FmnuShowOperators) and FmnuShowOperators.Checked then
Include(IdentTypes, itOperator);
var LIdents := TArray<TASKernel.TIdentInfo>(nil);
try
LIdents := LKernel.GetMatchingIdents(IdentTypes, '',
(FmnuHideSystem = nil) or FmnuHideSystem.Checked);
except
on EObjStoreLocked do
Exit;
end;
var LockInfo := Default(TASKernel.TLockInfo);
if (FKernel <> nil) and FKernel.TryLockObjStore(LockInfo) then
try
for var i := 0 to High(LIdents) do
if LIdents[i].IdentType = itVariable then
begin
try
const Obj = FKernel.GetVariableRef(LIdents[i].Name, I_Will_Not_Modify_The_Object);
if Assigned(Obj) then
LIdents[i].Preview := Obj.ToPreviewString;
except
on EUnknownIdentifier do
LIdents[i].Preview := 'Variable no longer exists.';
end;
end;
finally
FKernel.UnlockObjStore(LockInfo);
end
else
Exit;
FIdents := LIdents;
if Assigned(FListView) then
begin
try
FListView.Items.Count := Length(FIdents);
FListView.Invalidate;
FListView.AdjustColumns;
FListView.ClearSelection;
if not LSelItemCaption.IsEmpty then
begin
for var i := 0 to High(FIdents) do
if FIdents[i].Name = LSelItemCaption then
begin
var LItem := FListView.Items[i];
if Assigned(LItem) then
begin
LItem.Selected := True;
LItem.Focused := True;
LItem.MakeVisible(False);
end;
Break;
end;
end;
except
on E: Exception do
TDbgLogForm.DoLog('TIdentifierForm.UpdateIdents.FListView', E);
end;
end;
UpdateStatusBar;
end;
procedure TIdentifierForm.UpdateStatusBar;
begin
if Assigned(FListView) and FListView.HandleAllocated then
StatusText := PrettyFormat('%d identifier(s) %d selected', [FListView.Items.Count, FListView.SelCount])
else if Assigned(FListView) then
StatusText := PrettyFormat('%d identifier(s)', [FListView.Items.Count]);
end;
procedure TTextViewer.CmdExec(AID: Integer);
begin
case AID of
TBV_FIRSTFORM .. TBV_LASTFORM:
SetView(AID - TBV_BASE);
else
inherited;
end;
end;
procedure TTextViewer.CmdGetState(AID: Integer; var AVisible, AEnabled,
AChecked: Boolean);
begin
inherited;
AChecked := FFormat = AID - TBV_BASE;
end;
constructor TTextViewer.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
FFormat := 1;
end;
destructor TTextViewer.Destroy;
begin
FreeAndNil(FObject);
inherited;
end;
procedure TTextViewer.PanelShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
if (Msg.CharCode in [Ord('R'), Ord('O'), Ord('N')]) then
Handled := False
else
inherited;
end;
procedure TTextViewer.SetObject(const Value: TAlgosimObject);
begin
FreeAndNil(FObject);
FObject := Value.Clone;
UpdateView;
end;
procedure TTextViewer.SetupToolMenu;
begin
CreateToolMenu;
SimpleMenu.AddCommand(TBV_PRETTYFORM, SPrettyForm, '', True);
SimpleMenu.AddCommand(TBV_SINGLELINE, SSingleLine, '', True);
SimpleMenu.AddCommand(TBV_TRUNCLINE, STruncatedSingleLine, '', True);
SimpleMenu.AddCommand(TBV_INPUTFORM, SInputForm, '', True);
SimpleMenu.AddCommand(TBV_UNFORMATTED, SUnformatted, '', True);
Editor.PopupMenu := ToolMenu;
end;
procedure TTextViewer.SetView(AForm: Integer);
begin
FFormat := AForm;
UpdateView;
end;
function ColorText(const AColor: TRGB): string;
begin
const rgb = TRGB(AColor);
const 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);
var name := '';
if TryGetColorName(rgb, name) then
Result := Result + #13#10#13#10 + name;
end;
procedure TTextViewer.UpdateCaption;
begin
Caption := FIdentifier;
end;
procedure TTextViewer.UpdateView;
begin
if FObject = nil then
Exit;
if Editor = nil then
Exit;
if AlgosimMainForm = nil then
Exit;
if AlgosimMainForm.Kernel = nil then
Exit;
var FO := AlgosimMainForm.Kernel.FormatOptions;
var S := '';
if FObject is TCustomFunctionObj then
S := TCustomFunctionObj(FObject).ExprAsStr(False)
else if (FObject is TAlgosimColor) and (FFormat = 1) then
S := ColorText(FObject.ToColor)
else
case FFormat 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;
Editor.PlainText := S;
if (FObject is TAlgosimColor) and (FFormat = 1) then
begin
Editor.TextFile.StrictReadOnly := False;
Editor.EditMode := emText;
Editor.RemoveClass('Color box');
Editor.AddClass(MakeClass('Color box', Editor.Font.Size, [], FObject.ToColor));
Editor.AddLine;
Editor.AddLine('██████████████', 'Color box');
Editor.AddLine('██████████████', 'Color box');
end;
Editor.EditMode := emReadOnly;
Editor.TextFile.StrictReadOnly := True;
Editor.TextFile.GotoSOF;
Editor.TextFile.ClearUndoHistory;
Editor.TextFile.FileModified := False;
UpdateCaption;
RequestClientSize
(
EnsureRange
(
Editor.TotalHorizontalExtent + 3*GetSystemMetricsForWindow(SM_CXVSCROLL, Handle),
ScaleValue(200),
ScaleValue(800)
),
EnsureRange
(
Editor.TotalVerticalExtent + 2*GetSystemMetricsForWindow(SM_CYHSCROLL, Handle),
ScaleValue(100),
ScaleValue(600)
)
);
end;
function TSoundPlayerForm.ContextHelp: Boolean;
begin
TDocBrowser.ShowDocOrIndex('Sound player', False);
Result := True;
end;
constructor TSoundPlayerForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
FPlayer := TSoundPlayer.Create(Self);
FPlayer.Parent := Self;
FPlayer.Align := alClient;
ToolMenu := FPlayer._PrvtCtxMenu;
StatusBar := True;
end;
procedure TSoundPlayerForm.SetSound(const ASound: TASSound);
begin
if Assigned(FPlayer) then
FPlayer.Sound := ASound;
end;
procedure TTableForm.CellValueKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_RETURN:
begin
if Assigned(FEditor) and Assigned(FCellValue) and FEditor.Table.CellExists(FEditor.ActiveCell) then
begin
FEditor.Table[FEditor.ActiveCell] := FCellValue.PlainText;
InvalidateRect(FEditor.Handle, FEditor.CellRect[FEditor.ActiveCell], True);
if FEditor.CanFocus then
FEditor.SetFocus;
end;
Key := 0;
end;
VK_ESCAPE:
begin
if FEditor.CanFocus then
FEditor.SetFocus;
Key := 0;
EditorActiveCellChanged(Self);
end;
end;
end;
procedure TTableForm.CmdExec(AID: Integer);
begin
case AID of
TBF_SETSIZE:
if Assigned(FEditor) then
FEditor.GUISetSize;
TBF_SHOWBAR:
ShowToolBar := not ShowToolBar;
TBF_GRIDLINES:
begin
if FEditor.Table.Style['horizontal-grid-width'] = '0' then
begin
const C = ColorToHex(TUx.ThemeData.InactiveCaptionColor);
FEditor.Table.Style['horizontal-grid-width'] := '1';
FEditor.Table.Style['horizontal-grid-color'] := C;
FEditor.Table.Style['vertical-grid-width'] := '1';
FEditor.Table.Style['vertical-grid-color'] := C;
FEditor.Table.Style['table-border-width'] := '1';
FEditor.Table.Style['table-border-color'] := C;
end
else
begin
FEditor.Table.Style['horizontal-grid-width'] := '0';
FEditor.Table.Style['vertical-grid-width'] := '0';
FEditor.Table.Style['table-border-width'] := '0';
end;
FEditor.UpdateMetricsFromStyle;
FEditor.Invalidate;
end;
TBF_EVENODDROWS:
begin
if FEditor.Table.OddRows['background-color'] = '' then
begin
const C1 = ColorToHex(Blend(0.90, clWhite, TUx.ThemeData.InactiveCaptionColor));
const C2 = ColorToHex(Blend(0.70, clWhite, TUx.ThemeData.InactiveCaptionColor));
FEditor.Table.OddRows['background-color'] := C1;
FEditor.Table.EvenRows['background-color'] := C2;
end
else
begin
FEditor.Table.OddRows.Clear;
FEditor.Table.EvenRows.Clear;
end;
FEditor.UpdateMetricsFromStyle;
FEditor.Invalidate;
end;
TBF_EVENODDCOLS:
begin
if FEditor.Table.OddCols['background-color'] = '' then
begin
const C1 = ColorToHex(Blend(0.90, clWhite, TUx.ThemeData.InactiveCaptionColor));
const C2 = ColorToHex(Blend(0.70, clWhite, TUx.ThemeData.InactiveCaptionColor));
FEditor.Table.OddCols['background-color'] := C1;
FEditor.Table.EvenCols['background-color'] := C2;
end
else
begin
FEditor.Table.OddCols.Clear;
FEditor.Table.EvenCols.Clear;
end;
FEditor.UpdateMetricsFromStyle;
FEditor.Invalidate;
end;
TBF_FIRSTROW:
begin
if FEditor.Table.FirstRow['background-color'] = '' then
begin
const C = ColorToHex(Blend(0.35, clWhite, TUx.ThemeData.InactiveCaptionColor));
FEditor.Table.FirstRow['background-color'] := C;
FEditor.Table.FirstRow['bold'] := 'true';
end
else
begin
FEditor.Table.FirstRow.Clear;
end;
FEditor.UpdateMetricsFromStyle;
FEditor.Invalidate;
end;
TBF_LASTROW:
begin
if FEditor.Table.LastRow['background-color'] = '' then
begin
const C = ColorToHex(Blend(0.35, clWhite, TUx.ThemeData.InactiveCaptionColor));
FEditor.Table.LastRow['background-color'] := C;
FEditor.Table.LastRow['bold'] := 'true';
end
else
begin
FEditor.Table.LastRow.Clear;
end;
FEditor.UpdateMetricsFromStyle;
FEditor.Invalidate;
end;
TBF_FIRSTCOL:
begin
if FEditor.Table.FirstCol['background-color'] = '' then
begin
const C = ColorToHex(Blend(0.35, clWhite, TUx.ThemeData.InactiveCaptionColor));
FEditor.Table.FirstCol['background-color'] := C;
FEditor.Table.FirstCol['bold'] := 'true';
end
else
begin
FEditor.Table.FirstCol.Clear;
end;
FEditor.UpdateMetricsFromStyle;
FEditor.Invalidate;
end;
TBF_LASTCOL:
begin
if FEditor.Table.LastCol['background-color'] = '' then
begin
const C = ColorToHex(Blend(0.35, clWhite, TUx.ThemeData.InactiveCaptionColor));
FEditor.Table.LastCol['background-color'] := C;
FEditor.Table.LastCol['bold'] := 'true';
end
else
begin
FEditor.Table.LastCol.Clear;
end;
FEditor.UpdateMetricsFromStyle;
FEditor.Invalidate;
end;
TBF_LEFT:
FEditor.LeftAlignSelection;
TBF_CENTER:
FEditor.CenterSelection;
TBF_RIGHT:
FEditor.RightAlignSelection;
TBF_BOLD:
FEditor.EmboldenSelection;
TBF_ITALICS:
FEditor.ItaliciseSelection;
TBF_UNDERLINE:
FEditor.UnderlineSelection;
TBF_CELLSTYLE:
FEditor.GUICellStyle;
TBF_TABLESTYLE:
FEditor.GUISetDesign;
else
inherited;
end;
end;
procedure TTableForm.CmdGetState(AID: Integer; var AVisible, AEnabled, AChecked: Boolean);
begin
case AID of
TBF_SHOWBAR:
AChecked := ShowToolBar;
TBF_GRIDLINES:
AChecked := FEditor.Table.Style['horizontal-grid-width'] <> '0';
TBF_EVENODDROWS:
AChecked := FEditor.Table.OddRows['background-color'] <> '';
TBF_EVENODDCOLS:
AChecked := FEditor.Table.OddCols['background-color'] <> '';
TBF_FIRSTROW:
AChecked := FEditor.Table.FirstRow['background-color'] <> '';
TBF_LASTROW:
AChecked := FEditor.Table.LastRow['background-color'] <> '';
TBF_FIRSTCOL:
AChecked := FEditor.Table.FirstCol['background-color'] <> '';
TBF_LASTCOL:
AChecked := FEditor.Table.LastCol['background-color'] <> '';
TBF_LEFT:
AChecked := FEditor.SelectionHasConsistentFormat('text-align', 'left');
TBF_CENTER:
AChecked := FEditor.SelectionHasConsistentFormat('text-align', 'center');
TBF_RIGHT:
AChecked := FEditor.SelectionHasConsistentFormat('text-align', 'right');
TBF_BOLD:
AChecked := FEditor.SelectionHasConsistentFormat('bold', 'true');
TBF_ITALICS:
AChecked := FEditor.SelectionHasConsistentFormat('italic', 'true');
TBF_UNDERLINE:
AChecked := FEditor.SelectionHasConsistentFormat('underline', 'true');
else
inherited;
end;
end;
constructor TTableForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
FEditor := TASTableEditor.Create(Self);
FEditor.Parent := Self;
FEditor.Align := alClient;
FEditor.OnActiveCellChanged := EditorActiveCellChanged;
FEditor.OnZoomChange := EditorZoomChange;
StatusBar := True;
FCellLabel := AddToolbarControl<TLabel>;
FCellLabel.AutoSize := False;
FCellLabel.Alignment := taRightJustify;
FCellLabel.Width := ScaleValue(120);
FCellValue := AddToolbarControl<TTextEditor>;
FCellValue.SingleLine := True;
FCellValue.OnKeyDown := CellValueKeyDown;
end;
procedure TTableForm.EditorActiveCellChanged(Sender: TObject);
begin
UpdateStatusBar;
end;
procedure TTableForm.EditorZoomChange(Sender: TObject);
begin
UpdateStatusBar;
end;
procedure TTableForm.PanelShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
if IsKeyDown(VK_CONTROL) and not IsKeyDown(VK_MENU) and not IsKeyDown(VK_SHIFT) and not FEditor.EditorVisible and not FCellValue.Focused then
begin
case Msg.CharCode of
Ord('L'):
begin
FEditor.LeftAlignSelection;
Handled := True;
end;
Ord('E'):
begin
FEditor.CenterSelection;
Handled := True;
end;
Ord('R'):
begin
FEditor.RightAlignSelection;
Handled := True;
end;
Ord('B'):
begin
FEditor.EmboldenSelection;
Handled := True;
end;
Ord('I'):
begin
FEditor.ItaliciseSelection;
Handled := True;
end;
Ord('U'):
begin
FEditor.UnderlineSelection;
Handled := True;
end
end;
end;
if not Handled then
inherited;
end;
procedure TTableForm.SetIdentifier(const Value: string);
begin
if FIdentifier <> Value then
begin
FIdentifier := Value;
Caption := FIdentifier;
if Assigned(FCellLabel) then
EditorActiveCellChanged(Self);
end;
end;
procedure TTableForm.SetTable(const ATable: TASTable);
begin
if Assigned(FEditor) then
FEditor.Table := ATable;
end;
procedure TTableForm.SetupToolMenu;
begin
inherited;
CreateToolMenu;
SimpleMenu.AddCommand(TBF_SETSIZE, 'Set table size...', 'Let''s you set the size of the table.');
SimpleMenu.AddCommand(0, '-', '');
SimpleMenu.AddCommand(TBF_SHOWBAR, 'Show toolbar', 'Shows or hides the toolbar.');
SimpleMenu.AddCommand(0, '-', '');
const LTableStyle = SimpleMenu.AddSubmenu('Table design', 'Contains commands to format the table.');
SimpleMenu.AddCommand(TBF_GRIDLINES, LTableStyle, 'Show gridlines', 'Shows or hides gridlines separating rows and columns.');
SimpleMenu.AddCommand(TBF_EVENODDROWS, LTableStyle, 'Even and odd rows', 'Highlight even and odd rows.');
SimpleMenu.AddCommand(TBF_EVENODDCOLS, LTableStyle, 'Even and odd columns', 'Highlight even and odd columns.');
SimpleMenu.AddCommand(0, LTableStyle, '-', '');
SimpleMenu.AddCommand(TBF_FIRSTROW, LTableStyle, 'First row', 'Highlight the first row.');
SimpleMenu.AddCommand(TBF_LASTROW, LTableStyle, 'Last row', 'Highlight the last row.');
SimpleMenu.AddCommand(TBF_FIRSTCOL, LTableStyle, 'First column', 'Highlight the first column.');
SimpleMenu.AddCommand(TBF_LASTCOL, LTableStyle, 'Last column', 'Highlight the last column.');
SimpleMenu.AddCommand(0, LTableStyle, '-', '');
SimpleMenu.AddCommand(TBF_TABLESTYLE, LTableStyle, 'More options...', 'Opens the Table Style dialog box.');
const LCellStyles = SimpleMenu.AddSubmenu('Cell styles', 'Contains commands to format individual cells.');
SimpleMenu.AddCommand(TBF_LEFT, LCellStyles, 'Left'#9'Ctrl+L', 'Aligns the contents to the left in each of the selected cells.', True);
SimpleMenu.AddCommand(TBF_CENTER, LCellStyles, 'Centre'#9'Ctrl+E', 'Centres the contents horizontally in each of the selected cells.', True);
SimpleMenu.AddCommand(TBF_RIGHT, LCellStyles, 'Right'#9'Ctrl+R', 'Aligns the contents to the right in each of the selected cells.', True);
SimpleMenu.AddCommand(0, LCellStyles, '-', '');
SimpleMenu.AddCommand(TBF_BOLD, LCellStyles, 'Bold'#9'Ctrl+B', 'Applies boldface font to the selected cells.');
SimpleMenu.AddCommand(TBF_ITALICS, LCellStyles, 'Italic'#9'Ctrl+I', 'Applies italic font to the selected cells.');
SimpleMenu.AddCommand(TBF_UNDERLINE, LCellStyles, 'Underline'#9'Ctrl+U', 'Underlines the text in the selected cells.');
SimpleMenu.AddCommand(0, LCellStyles, '-', '');
SimpleMenu.AddCommand(TBF_CELLSTYLE, LCellStyles, 'More options...', 'Opens the Cell Style dialog box.');
end;
procedure TTableForm.UpdateStatusBar;
begin
var R := FEditor.Selection;
if (R.Top = R.Bottom) and (R.Left = R.Right) then
StatusText :=
PrettyFormat(
'Size: %d×%d Row: %d Col: %d'#9'%d%%',
[
FEditor.Table.Height,
FEditor.Table.Width,
FEditor.ActiveCell.Y + 1,
FEditor.ActiveCell.X + 1,
FEditor.ZoomLevel
]
)
else if (R.Top = R.Bottom) and (R.Left < R.Right) then
StatusText :=
PrettyFormat(
'Size: %d×%d Row: %d Cols: %d–%d'#9'%d%%',
[
FEditor.Table.Height,
FEditor.Table.Width,
FEditor.ActiveCell.Y + 1,
R.Left + 1,
R.Right + 1,
FEditor.ZoomLevel
]
)
else if (R.Top < R.Bottom) and (R.Left = R.Right) then
StatusText :=
PrettyFormat(
'Size: %d×%d Rows: %d–%d Col: %d'#9'%d%%',
[
FEditor.Table.Height,
FEditor.Table.Width,
R.Top + 1,
R.Bottom + 1,
FEditor.ActiveCell.X + 1,
FEditor.ZoomLevel
]
)
else
StatusText :=
PrettyFormat(
'Size: %d×%d Rows: %d–%d Cols: %d–%d'#9'%d%%',
[
FEditor.Table.Height,
FEditor.Table.Width,
R.Top + 1,
R.Bottom + 1,
R.Left + 1,
R.Right + 1,
FEditor.ZoomLevel
]
);
if Assigned(FEditor) and Assigned(FCellLabel) and Assigned(FCellValue) then
begin
FCellLabel.Caption :=
Format(
'%s[%d, %d] = ',
[
Self.Caption,
FEditor.ActiveCell.Y + 1,
FEditor.ActiveCell.X + 1,
FEditor.ZoomLevel
]
);
FCellValue.PlainText := FEditor.CurrentCellText;
end;
end;
class constructor TTaskListForm.ClassCreate;
begin
FInstances := TList<TTaskListForm>.Create;
end;
class destructor TTaskListForm.ClassDestroy;
begin
FreeAndNil(FInstances);
end;
class procedure TTaskListForm.ClassUpdateTasks(
const ATasks: TArray<TASKernel.TWorkQueueItem>; AKernel: TASKernel;
AState: TExecStateEx; AError: Boolean);
begin
if Assigned(FInstances) then
for var LInstance in FInstances do
LInstance.UpdateTasks(ATasks, AKernel, AState, AError);
end;
procedure TTaskListForm.CmdExec(AID: Integer);
begin
case AID of
TLF_PAUSE:
if Length(FTasks) > 0 then
FTasks[0].Kernel.Pause;
TLF_RESUME:
if Length(FTasks) > 0 then
FTasks[0].Kernel.Resume;
TLF_REMOVEALL:
if Length(FTasks) > 0 then
FTasks[0].Kernel.AbortAll;
TLF_REMOVESEL:
if InRange(FListView.ItemIndex, Low(FTasks), High(FTasks)) then
FTasks[FListView.ItemIndex].Kernel.AbortJob(
FTasks[FListView.ItemIndex].UID
);
end;
end;
procedure TTaskListForm.CmdGetState(AID: Integer; var AVisible, AEnabled,
AChecked: Boolean);
begin
case AID of
TLF_PAUSE:
AEnabled := (Length(FTasks) > 0) and (FTasks[0].Kernel.State = esRunning);
TLF_RESUME:
AEnabled := (Length(FTasks) > 0) and (FTasks[0].Kernel.State = esPaused);
TLF_REMOVEALL:
AEnabled := Length(FTasks) >= 1;
else
inherited;
end;
end;
function TTaskListForm.ContextHelp: Boolean;
begin
TDocBrowser.ShowDoc('Tasks panel', False);
Result := True;
end;
constructor TTaskListForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
Color := clWindow;
FListView := TListViewEx.Create(Self);
FListView.Parent := Self;
FListView.Align := alClient;
FListView.ViewStyle := vsReport;
FListView.ReadOnly := True;
FListView.ColumnClick := False;
FListView.ShowColumnHeaders := False;
FListView.EmptyText := 'No running or queued tasks';
FListView.MultiSelect := False;
FListView.RowSelect := True;
FListView.BorderStyle := bsNone;
FListView.OnSelCntChange := ListViewSelCntChange;
FListView.OnKeyDown := ListViewKeyDown;
FListView.OnDblClick := ListViewDblClick;
var LColumn := FListView.Columns.Add;
LColumn.Caption := 'State';
LColumn.Width := ScaleValue(50);
LColumn.Alignment := taCenter;
LColumn := FListView.Columns.Add;
LColumn.Caption := 'Task';
LColumn.AutoSize := True;
FProgressWheel := TSProgressIndicator.Create(Self);
FProgressWheel.Parent := Self;
FProgressWheel.Align := alLeft;
FProgressWheel.OnDynGetFilled := ProgressWheelDynGetFilled;
TUx.RegisterCallback(
FProgressWheel,
procedure
begin
FProgressWheel.AccentColor := TUx.ThemeData.ActiveCaptionColor;
end
);
StatusBar := True;
if Assigned(FInstances) then
FInstances.Add(Self);
FListViewPopup := TPopupMenu.Create(Self);
FListViewPopup.OnPopup := ListViewPopupPopup;
FListView.PopupMenu := FListViewPopup;
mnuPause := TMenuItem.Create(FListViewPopup);
mnuPause.Caption := 'Pause';
mnuPause.Hint := 'Pauses all computations.';
mnuPause.Tag := TLF_PAUSE;
mnuPause.OnClick := ListViewMenuClick;
FListViewPopup.Items.Add(mnuPause);
mnuResume := TMenuItem.Create(FListViewPopup);
mnuResume.Caption := 'Resume';
mnuResume.Hint := 'Resumes computation.';
mnuResume.Tag := TLF_RESUME;
mnuResume.OnClick := ListViewMenuClick;
FListViewPopup.Items.Add(mnuResume);
FListViewPopup.Items.NewBottomLine;
mnuAbort := TMenuItem.Create(FListViewPopup);
mnuAbort.Caption := 'Abort'#9'Del';
mnuAbort.Hint := 'Aborts this computation.';
mnuAbort.Tag := TLF_REMOVESEL;
mnuAbort.OnClick := ListViewMenuClick;
FListViewPopup.Items.Add(mnuAbort);
mnuRemove := TMenuItem.Create(FListViewPopup);
mnuRemove.Caption := 'Remove'#9'Del';
mnuRemove.Hint := 'Removes this job from the queue.';
mnuRemove.Tag := TLF_REMOVESEL;
mnuRemove.OnClick := ListViewMenuClick;
FListViewPopup.Items.Add(mnuRemove);
mnuRemoveAll := TMenuItem.Create(FListViewPopup);
mnuRemoveAll.Caption := 'Remove all';
mnuRemoveAll.Hint := 'Aborts the current computation and removes all queued jobs.';
mnuRemoveAll.Tag := TLF_REMOVEALL;
mnuRemoveAll.OnClick := ListViewMenuClick;
FListViewPopup.Items.Add(mnuRemoveAll);
UpdateTasks(AlgosimMainForm.Kernel.WorkQueue, AlgosimMainForm.Kernel, -1, False);
end;
destructor TTaskListForm.Destroy;
begin
if Assigned(FInstances) then
FInstances.Remove(Self);
inherited;
end;
class function TTaskListForm.IsDisposable: Boolean;
begin
Result := True;
end;
procedure TTaskListForm.ListViewDblClick(Sender: TObject);
begin
ShowTaskDetails;
end;
procedure TTaskListForm.ListViewKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_RETURN:
ShowTaskDetails;
VK_DELETE:
CmdExec(TLF_REMOVESEL);
end;
end;
procedure TTaskListForm.ListViewMenuClick(Sender: TObject);
begin
if Sender is TMenuItem then
CmdExec(TMenuItem(Sender).Tag);
end;
procedure TTaskListForm.ListViewPopupPopup(Sender: TObject);
begin
mnuPause.Visible := (Length(FTasks) > 0) and (FTasks[0].Kernel.State = esRunning);
mnuResume.Visible := (Length(FTasks) > 0) and (FTasks[0].Kernel.State = esPaused);
mnuAbort.Visible := (Length(FTasks) > 0) and Assigned(FListView) and (FListView.ItemIndex = 0);
mnuRemove.Visible := (Length(FTasks) > 0) and Assigned(FListView) and (FListView.ItemIndex > 0);
mnuRemoveAll.Visible := Length(FTasks) > 1;
end;
procedure TTaskListForm.ListViewSelCntChange(Sender: TObject);
begin
UpdateStatusBar;
end;
procedure TTaskListForm.PanelShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
inherited;
end;
function TTaskListForm.ProgressWheelDynGetFilled(Sender: TObject;
out AOpacity: Double): Boolean;
begin
const LNow = GetTickCount64;
const LThen = TASKernel.SendMessageTimestamp;
if LNow > LThen then
begin
const LDiff = LNow - LThen;
Result := LDiff < 200;
if Result then
AOpacity := 1.0 - LDiff / 200;
end
else
Result := False;
end;
procedure TTaskListForm.Resize;
begin
inherited;
FProgressWheel.Width := Min(Min(FProgressWheel.Height, ScaleValue(250)), ClientWidth div 2);
end;
procedure TTaskListForm.SetupToolMenu;
begin
inherited;
CreateToolMenu;
if Assigned(mnuPause) then
SimpleMenu.AddCommand(TLF_PAUSE, mnuPause.Caption, mnuPause.Hint);
if Assigned(mnuResume) then
begin
SimpleMenu.AddCommand(TLF_RESUME, mnuResume.Caption, mnuResume.Hint);
SimpleMenu.AddCommand(0, '-', '');
end;
if Assigned(mnuRemoveAll) then
SimpleMenu.AddCommand(TLF_REMOVEALL, mnuRemoveAll.Caption, mnuRemoveAll.Hint);
end;
procedure TTaskListForm.ShowTaskDetails;
begin
if Assigned(FListView) and InRange(FListView.ItemIndex, 0, High(FTasks)) then
TTableDialog.ShowTable(GetParentFormSafe(Self), 'Task details', FTasks[FListView.ItemIndex].ToTable, mtCustom);
end;
procedure TTaskListForm.UpdateStatusBar;
begin
if Assigned(FListView) and FListView.HandleAllocated then
StatusText := PrettyFormat('%d task(s) %d selected', [FListView.Items.Count, FListView.SelCount])
else if Assigned(FListView) then
StatusText := PrettyFormat('%d task(s)', [FListView.Items.Count]);
end;
procedure TTaskListForm.UpdateTasks(
const ATasks: TArray<TASKernel.TWorkQueueItem>; AKernel: TASKernel;
AState: TExecStateEx; AError: Boolean);
const
UNICODE_PLAY = #$23F5;
UNICODE_PAUSE = #$23F8;
UNICODE_STOP = #$23F9;
begin
var LState: TExecState;
if InRange(Ord(AState), Ord(Low(TExecState)), Ord(High(TExecState))) then
LState := TExecState(Ord(AState))
else if Assigned(AKernel) then
LState := AKernel.State
else
Exit;
FTasks := Copy(ATasks);
if Assigned(FListView) and HandleAllocated then
begin
FListView.Items.BeginUpdate;
try
FListView.Clear;
for var i := 0 to High(FTasks) do
begin
var LItem := FListView.Items.Add;
if FTasks[i].Dequeued <> 0.0 then
case LState of
esReady: ;
esRunning:
LItem.Caption := UNICODE_PLAY;
esPausing:
LItem.Caption := UNICODE_PAUSE + '*';
esPaused:
LItem.Caption := UNICODE_PAUSE;
esAborting:
LItem.Caption := UNICODE_STOP + '*';
end;
LItem.SubItems.Add(FTasks[i].Cmd + IfThen(i = 0, #32 + LState.ToString));
end;
finally
FListView.Items.EndUpdate;
end;
end;
UpdateStatusBar;
if not FHasInitialized or (Ord(AState) = Ord(LState)) then
begin
case LState of
esReady:
if AError then
FProgressWheel.State := sFailureStopped
else if FProgressWheel.State <> sFailureStopped then
FProgressWheel.State := sStopped;
esRunning:
FProgressWheel.State := sRunning;
esPausing:
FProgressWheel.State := sPausing;
esPaused:
FProgressWheel.State := sPaused;
esAborting:
FProgressWheel.State := sStopping;
end;
end;
FHasInitialized := True;
end;
procedure TTextBufferViewer.AddLine(const AText: string);
begin
Editor.TextFile.StrictReadOnly := False;
Editor.EditMode := emText;
try
Editor.AddLine(AText);
finally
Editor.EditMode := emReadOnly;
Editor.TextFile.StrictReadOnly := True;
Editor.TextFile.FileModified := False;
end;
end;
class constructor TTextBufferViewer.ClassCreate;
begin
FInstances := TDictionary<string, TTextBufferViewer>.Create;
end;
class destructor TTextBufferViewer.ClassDestroy;
begin
FreeAndNil(FInstances);
end;
procedure TTextBufferViewer.Clear;
begin
Editor.TextFile.StrictReadOnly := False;
Editor.EditMode := emText;
try
Editor.Clear;
finally
Editor.EditMode := emReadOnly;
Editor.TextFile.StrictReadOnly := True;
Editor.TextFile.FileModified := False;
end;
end;
procedure TTextBufferViewer.CmdExec(AID: Integer);
begin
if IndexInt(AID, InapplCmds) = -1 then
inherited;
end;
procedure TTextBufferViewer.CmdGetState(AID: Integer; var AVisible, AEnabled,
AChecked: Boolean);
begin
inherited;
if IndexInt(AID, InapplCmds) <> -1 then
AVisible := False;
end;
destructor TTextBufferViewer.Destroy;
begin
if not FBufferName.IsEmpty and Assigned(FInstances) then
FInstances.Remove(FBufferName);
inherited;
end;
procedure TTextBufferViewer.LoadBuffer(const ABufferName: string);
begin
FBufferName := ABufferName;
Editor.PlainText := AlgosimMainForm.Kernel.GetBufferText(ABufferName).TrimRight;
Editor.TextFile.FileName := ABufferName;
Editor.TextFile.GotoEOF;
Editor.EditMode := emReadOnly;
Editor.TextFile.StrictReadOnly := True;
Editor.MakeUndoRoot;
Editor.TextFile.FileModified := False;
Caption := ABufferName;
if Assigned(FInstances) then
FInstances.AddOrSetValue(ABufferName, Self);
end;
class procedure TTextBufferViewer.TextBufferAppend(const ABufferName,
ABufferText: string);
begin
AssertMainThread;
if FInstances = nil then
Exit;
var LViewer := TTextBufferViewer(nil);
if FInstances.TryGetValue(ABufferName, LViewer) then
LViewer.AddLine(ABufferText)
else
begin
LViewer := TUxForm.CreateNewForm<TTextBufferViewer>;
LViewer.LoadBuffer(ABufferName);
end;
end;
class procedure TTextBufferViewer.TextBufferClear(const ABufferName: string);
begin
AssertMainThread;
if FInstances = nil then
Exit;
var LViewer := TTextBufferViewer(nil);
if FInstances.TryGetValue(ABufferName, LViewer) then
LViewer.Clear;
end;
procedure TDiagramForm.AfterConstruction;
begin
inherited;
if Assigned(VisCtl2D) then
begin
VisCtl2D.OnHoverCoordChange := DiagramHoverCoordChange;
VisCtl2D.OnViewChange := DiagramViewChange;
ToolMenu := VisCtl2D._ContextMenu;
end;
end;
function TDiagramForm.ContextHelp: Boolean;
begin
TDocBrowser.ShowDocOrIndex('Diagram viewer', False);
Result := True;
end;
procedure TDiagramForm.DiagramHoverCoordChange(Sender: TObject; const X,
Y: Double);
function FormatCoord(const X, DX: Double): string;
begin
if DX = 0.0 then
Exit(X.ToString);
const Log = Round(Math.Log10(DX));
if InRange(Log, -5, 3) then
Result := FloatToStrF(X, ffFixed, 8, Max(0, -Log), GInvFS)
else
Result := FloatToStrF(X, ffExponent, 3, 0, GInvFS);
Result := Result.Replace(HYPHEN_MINUS, MINUS_SIGN, [rfReplaceAll]);
end;
begin
if Assigned(VisCtl2D) then
begin
if IsNan(X) or IsNan(Y) then
begin
FStatusCoordText := '';
UpdateStatusBar;
Exit;
end;
const P = TPointD.Create(X, Y);
const SX = FormatCoord(P.X, VisCtl2D.PixelDeltaX);
const SY = FormatCoord(P.Y, VisCtl2D.PixelDeltaY);
FStatusCoordText := SX + ', ' + SY;
UpdateStatusBar;
end;
end;
procedure TDiagramForm.DiagramViewChange(Sender: TObject);
begin
UpdateNormality;
end;
function TDiagramForm.GetVisCtl2D: TVisCtl2D;
begin
Result := FVisCtl as TVisCtl2D;
end;
function TDiagramForm.GetVisCtlClass: TVisCtlClass;
begin
Result := TVisCtl2D;
end;
procedure TDiagramForm.Resize;
begin
inherited;
UpdateNormality;
end;
procedure TDiagramForm.UpdateNormality;
begin
if Assigned(VisCtl2D) then
if VisCtl2D.View.AspectDeviation < 0.0015 then
FStatusNormText := 'Normalized view'
else
FStatusNormText := 'Non-normalized view';
UpdateStatusBar;
end;
procedure TDiagramForm.UpdateStatusBar;
begin
StatusText := FStatusCoordText + #9 + FStatusNormText;
end;
procedure TSceneForm.AfterConstruction;
begin
inherited;
if Assigned(VisCtl3D) then
ToolMenu := VisCtl3D._ContextMenu;
end;
function TSceneForm.ContextHelp: Boolean;
begin
TDocBrowser.ShowDocOrIndex('Scene viewer', False);
Result := True;
end;
function TSceneForm.GetVisCtl3D: TVisCtl3D;
begin
Result := FVisCtl as TVisCtl3D;
end;
function TSceneForm.GetVisCtlClass: TVisCtlClass;
begin
Result := TVisCtl3D;
end;
procedure TVisWnd.CmdExec(AID: Integer);
begin
case AID of
VIW_SIZE:
begin
var W := ClientWidth;
var H := ClientHeight;
var Aspect: Double := 0.0;
if ImageSizeDialog(Self, W, H, Aspect) then
begin
if WindowState <> TWindowState.wsNormal then
WindowState := wsNormal;
RequestClientSize(W, H);
end;
end;
end;
end;
constructor TVisWnd.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
Color := clWindow;
StatusBar := True;
if not FCreatingWith then
begin
var LOwner := TComponent(nil);
if not PreserveControl then
LOwner := Self;
FVisCtl := GetVisCtlClass.Create(LOwner);
FVisCtl.Parent := Self;
FVisCtl.Align := alClient;
FVisCtl.FreeNotification(Self);
end;
end;
constructor TVisWnd.CreateNewWith(AOwner: TComponent; AAdoptee: TControl);
begin
FCreatingWith := True;
inherited;
if AAdoptee is GetVisCtlClass then
begin
FVisCtl := AAdoptee as TVisCtl;
FVisCtl.FreeNotification(Self);
end;
end;
destructor TVisWnd.Destroy;
begin
if PreserveControl and Assigned(FVisCtl) then
FVisCtl.Parent := nil;
inherited;
end;
procedure TVisWnd.FirstShow;
begin
RequestClientSize(800, 600);
end;
procedure TVisWnd.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (AComponent = FVisCtl) and (Operation = opRemove) then
begin
FVisCtl := nil;
if Panel <> nil then
Panel.Close;
end;
end;
procedure TVisWnd.PanelShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
if (Msg.CharCode = Ord('S')) and not IsKeyDown(VK_CONTROL) and not IsKeyDown(VK_MENU) then
begin
CmdExec(VIW_SIZE);
Handled := True;
end
else
inherited;
end;
function TVisWnd.PreserveControl: Boolean;
begin
Result := False;
end;
function TManagedDiagramForm.GetVisCtlClass: TVisCtlClass;
begin
Result := TManagedVisCtl2D;
end;
function TManagedDiagramForm.PreserveControl: Boolean;
begin
Result := True;
end;
function TManagedSceneForm.GetVisCtlClass: TVisCtlClass;
begin
Result := TManagedVisCtl3D;
end;
function TManagedSceneForm.PreserveControl: Boolean;
begin
Result := True;
end;
procedure TProgramEditorForm.Activate;
begin
inherited;
if not FHasActivated then
begin
FHasActivated := True;
if Assigned(teAST) and HandleAllocated and Assigned(Parent) and InRange(FTreeWidthFraction, 0.1, 0.9) then
teAST.Width := Round(FTreeWidthFraction * ClientWidth);
end;
end;
procedure TProgramEditorForm.ASTResize(Sender: TObject);
begin
if FParseResult = PARSE_FAILED then
SetAST(FAST);
end;
class constructor TProgramEditorForm.ClassCreate;
begin
FProgramCounter := 1;
end;
procedure TProgramEditorForm.CmdExec(AID: Integer);
begin
case AID of
PEF_SHOWTREE:
begin
ShowTree := not ShowTree;
end;
PEF_EXECUTE:
begin
if
Assigned(AlgosimMainForm)
and
Assigned(AlgosimMainForm.Kernel)
and
Assigned(Editor)
then
AlgosimMainForm.MakeKernelAsyncRequest(FOutputConsoleGUID, Editor.PlainText);
end
else
inherited;
end;
end;
procedure TProgramEditorForm.CmdGetState(AID: Integer; var AVisible, AEnabled,
AChecked: Boolean);
begin
case AID of
PEF_SHOWTREE:
AChecked := ShowTree;
PEF_EXECUTE:
AEnabled := FParseResult = PARSE_OK;
else
inherited;
end;
end;
function TProgramEditorForm.ContextHelp: Boolean;
begin
TDocBrowser.ShowDocOrIndex('Program editor', False);
Result := True;
end;
constructor TProgramEditorForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
FParseResult := PARSE_EMPTY;
if Editor.FormattingProcessor = nil then
Editor.FormattingProcessor := TAlgosim3FormattingProcessor.Create(Self);
FTreeWidthFraction := 1/3;
teAST := TTextEditor.Create(Self);
teAST.Parent := Self;
teAST.BorderType := btNone;
teAST.Align := alRight;
teAST.RulerVisible := False;
teAST.ErrorMessageOnReadOnlyError := False;
if HandleAllocated and Assigned(Parent) then
teAST.Width := Round(FTreeWidthFraction * ClientWidth)
else
teAST.Width := ScaleValue(250);
teAST.OnResize := ASTResize;
teAST.OnZoomChange := ASTResize;
teAST.FormattingProcessor := TAlgosim3FormattingProcessor.Create(Self);
FSplitter := TUxSplitter.Create(Self);
FSplitter.Parent := Self;
FSplitter.Align := alRight;
FSplitter.AutoSnap := False;
FSplitter.OnCanResize := SplitterCanResize;
FSplitter.MinSize := ScaleValue(100);
FSplitter.ResizeStyle := rsUpdate;
FExpressionStringCS := TCriticalSection.Create;
FReparseEvent := TEvent.Create(nil, False, False, '');
FBackgroundParser := TBackgroundParser.Create(Self);
FReparseTimer := TTimer.Create(Self);
FReparseTimer.Interval := 500;
FReparseTimer.Enabled := False;
FReparseTimer.OnTimer := ReparseTimerTimer;
end;
destructor TProgramEditorForm.Destroy;
begin
FreeAndNil(FReparseTimer);
if Assigned(FBackgroundParser) then
FBackgroundParser.Terminate;
if Assigned(FReparseEvent) then
FReparseEvent.SetEvent;
FreeAndNil(FBackgroundParser);
FreeAndNil(FReparseEvent);
FreeAndNil(FExpressionStringCS);
inherited;
end;
procedure TProgramEditorForm.EditorChanged(Sender: TObject);
begin
inherited;
ReparseNeeded;
end;
procedure TProgramEditorForm.FirstShow;
begin
RequestClientSize(1200, 800);
end;
function TProgramEditorForm.GetClientGUID: TGUID;
const
LGUID: TGUID = '{FF411095-5C1E-49F8-BFB7-7814DE68B197}';
begin
Result := LGUID;
end;
function TProgramEditorForm.GetFilters: TArray<TPair<string, string>>;
begin
Result := [TPair<string, string>.Create('Program files', '*.prg')] + inherited;
end;
function TProgramEditorForm.GetTreeVisible: Boolean;
begin
Result := Assigned(teAST) and teAST.Visible;
end;
procedure TProgramEditorForm.LoadSettings;
begin
inherited;
MathEditor.RulerVisible := TASSettings.GetSettingBool('ProgEd_ShowRuler', True);
MathEditor.CaretAfterEOL := TASSettings.GetSettingBool('ProgEd_CaretBeyondEOL', True);
MathEditor.MathInputMode := TASSettings.GetSettingBool('ProgEd_MathInputMode', True);
MathEditor.ShowHiddenCharacters := TASSettings.GetSettingBool('ProgEd_ShowHiddenCharacters', False);
MathEditor.LineHighlight := TASSettings.GetSettingBool('ProgEd_LineHighlight', True);
ShowTree := TASSettings.GetSettingBool('ProgEd_ShowTree', True);
end;
function TProgramEditorForm.OpenFileDialog: Boolean;
begin
CmdExec(TEF_OPEN);
Result := True;
end;
procedure TProgramEditorForm.PanelShortCut(var Msg: TWMKey;
var Handled: Boolean);
begin
if (Msg.CharCode = VK_RETURN) and IsKeyDown(VK_CONTROL) then
begin
CmdExec(PEF_EXECUTE);
Handled := True;
end
else
inherited;
end;
procedure TProgramEditorForm.ReparseNeeded;
begin
RestartTimer(FReparseTimer);
end;
procedure TProgramEditorForm.ReparseTimerTimer(Sender: TObject);
begin
if Assigned(FReparseTimer) then
FReparseTimer.Enabled := False;
ScheduleReparse;
end;
procedure TProgramEditorForm.Resize;
begin
inherited;
if Assigned(teAST) and teAST.Visible then
if ClientWidth >= ScaleValue(300) then
begin
var LWidth := teAST.Width;
if InRange(FTreeWidthFraction, 0.01, 0.99) then
LWidth := Round(ClientWidth * FTreeWidthFraction);
LWidth := EnsureRange(LWidth, ScaleValue(100), ClientWidth - ScaleValue(200));
teAST.Width := LWidth;
end
else
teAST.Width := ClientWidth div 3;
end;
procedure TProgramEditorForm.ScheduleReparse;
begin
if Editor = nil then
Exit;
if FExpressionStringCS = nil then
Exit;
if FReparseEvent = nil then
Exit;
FExpressionStringCS.Enter;
try
FExpressionString := Editor.PlainText;
finally
FExpressionStringCS.Leave;
end;
FReparseEvent.SetEvent;
end;
procedure TProgramEditorForm.SetAST(const AST: string);
begin
FAST := AST;
if teAST = nil then
Exit;
teAST.BeginVisualUpdate;
try
teAST.EditMode := emText;
if FParseResult = PARSE_FAILED then
teAST.PlainText := WordWrap(FAST, teAST.WidthInCharacters)
else
teAST.PlainText := FAST;
teAST.EditMode := emReadOnly;
teAST.TextFile.GotoSOF;
teAST.TextFile.StrictReadOnly := True;
teAST.MarginLeft := ScaleValue(12);
finally
teAST.EndVisualUpdate;
end;
end;
procedure TProgramEditorForm.SetStatusText(const AText: string; APrio: Boolean);
begin
if APrio then
FStatusTextPrio := AText
else
FStatusTextBase := AText;
if not FStatusTextPrio.IsEmpty then
StatusText := FStatusTextPrio
else
StatusText := FStatusTextBase;
end;
procedure TProgramEditorForm.SetTreeVisible(const Value: Boolean);
begin
if teAST = nil then
Exit;
if teAST.Visible <> Value then
begin
teAST.Visible := Value;
if Assigned(FSplitter) then
begin
FSplitter.Visible := teAST.Visible;
teAST.Left := FSplitter.BoundsRect.Right + 10;
end;
Resize;
end;
end;
procedure TProgramEditorForm.SetupFileMasks(AItems: TFileTypeItems;
var ADefExtSansPeriod: string);
begin
var LItem := AItems.Add;
LItem.DisplayName := 'Algosim programs';
LItem.FileMask := '*.prg';
inherited;
ADefExtSansPeriod := 'prg';
end;
procedure TProgramEditorForm.SetupFileNaming;
begin
inherited;
Editor.TextFile.SetNamingData('Program %d', @FProgramCounter);
end;
procedure TProgramEditorForm.SetupToolMenu;
const
SELCON = 72495;
begin
inherited;
SimpleMenu.AddCommand(0, '-', '');
SimpleMenu.AddCommand(PEF_SHOWTREE, 'Show tree', 'Shows or hides the program''s abstract syntax tree.');
SimpleMenu.AddCommand(PEF_EXECUTE, 'Execute'#9'Ctrl+Enter', 'Executes this program.');
SimpleMenu.AddCustomSubmenu('Output', 'Let''s you choose which consol to use for program output.',
function: TArray<TMenuItemRec>
begin
SetLength(Result, TConsoleForm.Instances.Count + 2);
Result[0].Caption := 'Default';
Result[0].Hint := 'Uses the most recently activated console for program output (this program only).';
Result[0].RadioItem := True;
Result[0].Enabled := True;
Result[0].Checked := FOutputConsoleGUID.IsEmpty;
Result[1].Caption := '-';
Result[1].Enabled := True;
var LFoundConsole := False;
for var i := 0 to TConsoleForm.Instances.Count - 1 do
begin
Result[2 + i].Caption := TConsoleForm.Instances[i].Caption;
Result[2 + i].Hint := 'Selects this console for program output (this program only).';
Result[2 + i].CmdID := SELCON;
Result[2 + i].ObjRef := NativeInt(TConsoleForm.Instances[i]);
Result[2 + i].GUID := TConsoleForm.Instances[i].GUID;
Result[2 + i].Enabled := True;
Result[2 + i].Checked := FOutputConsoleGUID = Result[2 + i].GUID;
Result[2 + i].RadioItem := True;
if Result[2 + i].Checked then
LFoundConsole := True;
end;
if not LFoundConsole then
Result[0].Checked := True
end,
procedure(Sender: TCustomSubmenu; CmdID: Integer;
AObj: NativeInt; const AGUID: TGUID)
begin
FOutputConsoleGUID := AGUID;
end
);
end;
procedure TProgramEditorForm.SplitterCanResize(Sender: TObject;
var NewSize: Integer; var Accept: Boolean);
begin
if Assigned(teAST) and teAST.Visible then
begin
if ClientWidth >= ScaleValue(300) then
begin
NewSize := EnsureRange(NewSize, ScaleValue(100), ClientWidth - ScaleValue(200));
FTreeWidthFraction := EnsureRange(teAST.Width / ClientWidth, 0.01, 0.99);
end
else
NewSize := ClientWidth div 3;
end;
end;
procedure TProgramEditorForm.WMExprParsed(var Message: TMessage);
begin
FParseResult := Message.WParam;
case Message.WParam of
PARSE_EMPTY:
begin
SetStatusText('', False);
SetAST('');
end;
PARSE_OK:
begin
SetStatusText('Syntax OK'#9'Press Ctrl+Enter to run.', False);
SetAST(PChar(Message.LParam));
end;
PARSE_FAILED:
begin
SetStatusText('Syntax error: ' + PChar(Message.LParam), False);
SetAST('Syntax error:'#13#10 + PChar(Message.LParam));
end;
end;
end;
constructor TProgramEditorForm.TBackgroundParser.Create(
AEditor: TProgramEditorForm);
begin
if AEditor = nil then
raise Exception.Create('Background parser: No program editor.');
inherited Create(False);
FEditor := AEditor;
end;
procedure TProgramEditorForm.TBackgroundParser.Execute;
begin
inherited;
if FEditor = nil then
Exit;
while not Terminated do
begin
try
FEditor.FExpressionStringCS.Enter;
var Tokens: TObjectList<TToken>;
try
Tokens := TTokenizer.Tokenize(FEditor.FExpressionString);
finally
FEditor.FExpressionStringCS.Leave;
end;
try
if Tokens.Count > 0 then
begin
var Expr := TParser.Parse(Tokens);
try
var LExprStr := Expr.ToString;
SendMessage(FEditor.Handle, WM_EXPRPARSED, PARSE_OK, NativeInt(PChar(LExprStr)));
finally
Expr.Free;
end;
end
else
SendMessage(FEditor.Handle, WM_EXPRPARSED, PARSE_EMPTY, 0);
finally
Tokens.Free;
end;
except
on E: Exception do
SendMessage(FEditor.Handle, WM_EXPRPARSED, PARSE_FAILED, NativeInt(PChar(E.Message)));
end;
if FEditor.FReparseEvent.WaitFor(INFINITE) = wrSignaled then
Continue
else
Break;
end;
end;
class function TDocBrowser.ActiveInstance: TDocBrowser;
begin
if Assigned(FActiveInstance) and VerifyInstance(FActiveInstance) then
Result := FActiveInstance
else if Assigned(FInstances) and (FInstances.Count > 0) then
Result := FInstances.Last
else
Result := nil;
end;
procedure TDocBrowser.Back;
begin
if FHistory = nil then
Exit;
if FHistoryIndex < 1 then
Exit;
Dec(FHistoryIndex);
if not InRange(FHistoryIndex, 0, FHistory.Count - 1) then
Exit;
LoadEditor(FHistory[FHistoryIndex]);
end;
procedure TDocBrowser.BackButtonClick(Sender: TObject);
begin
Back;
if Visible and Assigned(Editor) and Editor.CanFocus then
Editor.SetFocus;
end;
procedure TDocBrowser.BeginActive;
begin
inherited;
FActiveInstance := Self;
end;
function TDocBrowser.CheckModified: Boolean;
begin
Result := True;
end;
class constructor TDocBrowser.ClassCreate;
begin
FInstances := TList<TDocBrowser>.Create;
end;
class destructor TDocBrowser.ClassDestroy;
begin
FreeAndNil(FInstances);
end;
procedure TDocBrowser.CmdExec(AID: Integer);
begin
case AID of
DOC_BACK:
Back;
DOC_FORWARD:
Forward;
DOC_HOME:
Navigate('Algosim');
DOC_SOURCE:
ShowSource;
DOC_PAGEINFO:
ShowPageInfo;
DOC_NEWWIN:
TUxForm.CreateNewForm<TDocBrowser>;
else
if IndexInt(AID, InapplCmds) = -1 then
inherited;
end;
end;
procedure TDocBrowser.CmdGetState(AID: Integer; var AVisible, AEnabled,
AChecked: Boolean);
begin
case AID of
DOC_BACK:
AEnabled := Assigned(FHistory) and InRange(FHistoryIndex, 1, FHistory.Count - 1);
DOC_FORWARD:
AEnabled := Assigned(FHistory) and InRange(FHistoryIndex, 0, FHistory.Count - 2);
DOC_HOME:
AEnabled := not SameText(FTopic, 'Algosim');
DOC_SOURCE, DOC_PAGEINFO:
AEnabled := not FTopic.IsEmpty;
else
inherited;
if IndexInt(AID, InapplCmds) <> -1 then
AVisible := False;
end;
end;
function TDocBrowser.ContextHelp: Boolean;
begin
TDocBrowser.ShowDocOrIndex('Documentation browser', True);
Result := True;
end;
constructor TDocBrowser.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
FHistory := TList<string>.Create;
FHistoryIndex := -1;
TASDoc.PrepareViewer(Editor);
Navigate('Algosim');
Editor.AlwaysControlAware := True;
Editor.BrowserContextMenu := True;
Editor.OnHyperlinkClick := teDocViewHyperlinkClick;
Editor.OnNavRequest := teDocViewNavRequest;
Editor.OnNavRequestGetEnabled := teDocViewNavRequestGetEnabled;
pmHistory := TPopupMenu.Create(Self);
pmHistory.OnPopup := pmHistoryPopup;
ShowToolbar := True;
FEditorMenu := TPopupMenu.Create(Self);
FEditorMenu.Items.NewBottomLine;
var mi := TMenuItem.Create(FEditorMenu);
mi.Caption := 'Show page info'#9'Ctrl+I';
mi.Hint := 'Displays information about this page.';
mi.OnClick := ShowPageInfo;
FEditorMenu.Items.Add(mi);
mi := TMenuItem.Create(FEditorMenu);
mi.Caption := 'Show source'#9'Ctrl+U';
mi.Hint := 'Displays the source code of this page.';
mi.OnClick := ShowSource;
FEditorMenu.Items.Add(mi);
Editor.AddMenuItems(FEditorMenu.Items);
Editor.LetterSpacing := 0;
if Assigned(FInstances) then
FInstances.Add(Self);
end;
destructor TDocBrowser.Destroy;
begin
if FActiveInstance = Self then
FActiveInstance := nil;
if Assigned(FInstances) then
FInstances.Remove(Self);
FreeAndNil(FHistory);
FHistoryIndex := -1;
inherited;
end;
procedure TDocBrowser.DoEnter;
begin
inherited;
FActiveInstance := Self;
end;
procedure TDocBrowser.Find(const AText: string);
begin
if eFind = nil then
Exit;
if Editor = nil then
Exit;
ShowToolbar := True;
if AText.IsEmpty and eFind.CanFocus then
begin
eFind.SetFocus;
eFind.SelectAll;
end;
if not AText.IsEmpty then
eFind.PlainText := AText;
end;
procedure TDocBrowser.FindEditChange(Sender: TObject);
begin
if eFind = nil then
Exit;
if Editor = nil then
Exit;
var FQ := MakeFindQuery(eFind.PlainText, False, False, False);
Editor.Find(FQ);
end;
procedure TDocBrowser.FindEditKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_RETURN:
begin
FindEditChange(Sender);
if ssShift in Shift then
FindPrev
else
FindNext;
Key := 0;
end;
VK_ESCAPE:
begin
Key := 0;
if Assigned(Editor) and Editor.CanFocus then
Editor.SetFocus;
end;
end;
end;
procedure TDocBrowser.FirstShow;
begin
RequestClientSize(1200, 800);
end;
procedure TDocBrowser.Forward;
begin
if FHistory = nil then
Exit;
if FHistoryIndex >= FHistory.Count - 1 then
Exit;
Inc(FHistoryIndex);
if not InRange(FHistoryIndex, 0, FHistory.Count - 1) then
Exit;
LoadEditor(FHistory[FHistoryIndex]);
end;
procedure TDocBrowser.ForwardButtonClick(Sender: TObject);
begin
Forward;
if Visible and Assigned(Editor) and Editor.CanFocus then
Editor.SetFocus;
end;
function TDocBrowser.GetClientGUID: TGUID;
const
LGUID: TGUID = '{1C7E44BA-2990-4C28-865D-FFCA409FA403}';
begin
Result := LGUID;
end;
function TDocBrowser.GetEditorSubclass: TTextEditorClass;
begin
Result := TASEditor;
end;
procedure TDocBrowser.GoHistoryMenu(Sender: TObject);
begin
if (Sender is TMenuItem) and Assigned(FHistory) and InRange(TMenuItem(Sender).Tag, 0, FHistory.Count - 1) then
begin
HistoryGo(TMenuItem(Sender).Tag);
if Visible and Assigned(Editor) and Editor.CanFocus then
Editor.SetFocus;
end;
end;
var
GFirstGoto: Boolean = True;
procedure TDocBrowser.GotoButtonClick(Sender: TObject);
begin
FPreGotoSidebar := Sidebar;
Sidebar := sbIndex;
if Visible and teIndexFilter.CanFocus then
teIndexFilter.SetFocus;
FGotoPath := FPreGotoSidebar <> sbIndex;
if GFirstGoto then
begin
if teIndexFilter.Focused then
begin
teIndexFilter.ShowBalloon(
'Enter a topic',
'Type the name of the topic you wish'#13#10 +
'to open and press Return to display it.'#13#10 +
#13#10 +
'You may also use the Up and Down'#13#10 +
'arrows to make a selection.',
bikInfo,
bpCaretPos,
Point(teIndexFilter.PlainText.Length, 0)
);
end;
end;
end;
procedure TDocBrowser.HistoryButtonClick(Sender: TObject);
begin
if Assigned(btnHistory) and Assigned(pmHistory) then
begin
btnHistory.Down := True;
try
with btnHistory.ClientToScreen(Point(0, btnHistory.Height)) do
pmHistory.Popup(X, Y);
finally
if Assigned(Self) and Assigned(btnHistory) then
btnHistory.Down := False;
end;
end;
end;
procedure TDocBrowser.HistoryGo(AIndex: Integer);
begin
if FHistory = nil then
Exit;
if AIndex = FHistoryIndex then
Exit;
if not InRange(AIndex, 0, FHistory.Count - 1) then
Exit;
FHistoryIndex := AIndex;
LoadEditor(FHistory[FHistoryIndex]);
end;
procedure TDocBrowser.HomeButtonClick(Sender: TObject);
begin
Navigate('Algosim');
if Visible and Assigned(Editor) and Editor.CanFocus then
Editor.SetFocus;
end;
procedure TDocBrowser.IndexButtonClick(Sender: TObject);
begin
if Sidebar = sbIndex then
Sidebar := sbNone
else
Sidebar := sbIndex;
end;
class function TDocBrowser.IsDisposable: Boolean;
begin
Result := True;
end;
procedure TDocBrowser.lbIndexChange(Sender: TObject);
var
SenderEditor: TTextEditor absolute Sender;
begin
if (Sender is TTextEditor) and SenderEditor.ListBoxMode then
if SenderEditor.ListBoxItemIndex <> -1 then
begin
Navigate(SenderEditor.Lines[SenderEditor.ListBoxItemIndex]);
if Assigned(FSearchForm) and (Sender = FSearchForm.lbSearchMatches) then
Editor.Find(
MakeFindQuery(
FSearchPhrase,
not (ssoIgnoreCase in FSearchOptions),
ssoWholeWords in FSearchOptions,
False
)
)
end;
end;
procedure TDocBrowser.lbIndexKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if teIndexFilter = nil then
Exit;
if Editor = nil then
Exit;
if Key = VK_BACK then
begin
if Visible and teIndexFilter.CanFocus then
teIndexFilter.SetFocus;
teIndexFilter.TextFile.GotoEOF;
teIndexFilter.Backspace;
Key := 0;
Exit;
end;
if Key = VK_TAB then
begin
if Assigned(Editor) and Editor.CanFocus then
Editor.SetFocus;
Key := 0;
Exit;
end;
if Key = VK_RETURN then
begin
if Visible and Editor.CanFocus then
Editor.SetFocus;
if FGotoPath then
begin
NoSidebarFocus := True;
try
Sidebar := FPreGotoSidebar;
finally
NoSidebarFocus := False;
end;
FGotoPath := False;
end;
end;
end;
procedure TDocBrowser.lbIndexKeyPress(Sender: TObject; var Key: Char);
begin
if teIndexFilter = nil then
Exit;
if not Key.IsControl and not Key.IsWhiteSpace then
begin
if Visible and teIndexFilter.CanFocus then
teIndexFilter.SetFocus;
teIndexFilter.PlainText := Key;
teIndexFilter.TextFile.GotoEOF;
Key := #0;
end;
end;
procedure TDocBrowser.lbSearchMatchesKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_TAB then
begin
if Assigned(Editor) and Editor.CanFocus then
Editor.SetFocus;
Key := 0;
end;
end;
procedure TDocBrowser.Navigate(const ATopic: string);
begin
if ATopic.Trim.IsEmpty then
Exit;
if ATopic.Trim = FTopic.Trim then
Exit;
Editor.TextFile.ClearFindData;
if Assigned(FHistory) then
begin
if FHistoryIndex <> FHistory.Count - 1 then
FHistory.DeleteRange(FHistoryIndex + 1, FHistory.Count - FHistoryIndex - 1);
FHistory.Add(ATopic);
FHistoryIndex := FHistory.Count - 1;
end;
LoadEditor(ATopic);
end;
procedure TDocBrowser.PanelShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
if (Msg.CharCode in [VK_LEFT, VK_RIGHT, VK_HOME]) and IsKeyDown(VK_MENU) then
begin
case Msg.CharCode of
VK_LEFT:
Back;
VK_RIGHT:
Forward;
VK_HOME:
Navigate('Algosim');
end;
Handled := True;
end
else if (Msg.CharCode = Ord('U')) and IsKeyDown(VK_CONTROL) and not IsKeyDown(VK_MENU) then
begin
ShowSource;
Handled := True;
end
else if (Msg.CharCode = Ord('I')) and IsKeyDown(VK_CONTROL) and not IsKeyDown(VK_MENU) then
begin
ShowPageInfo;
Handled := True;
end
else
inherited;
end;
procedure TDocBrowser.pmHistoryPopup(Sender: TObject);
begin
if pmHistory = nil then
Exit;
pmHistory.Items.Clear;
if Assigned(FHistory) then
for var i := FHistory.Count - 1 downto 0 do
begin
var mi := TMenuItem.Create(pmHistory);
mi.Caption := FHistory[i];
mi.OnClick := GoHistoryMenu;
mi.Tag := i;
mi.Checked := FHistoryIndex = i;
mi.RadioItem := True;
pmHistory.Items.Add(mi);
end;
end;
procedure TDocBrowser.PopulateIndex;
begin
if lbIndex = nil then
Exit;
const Filter = teIndexFilter.PlainText.Trim.ToLower;
lbIndex.EditMode := emText;
lbIndex.BeginVisualUpdate;
try
lbIndex.BeginAddLine;
try
lbIndex.Clear;
for var Topic in TASDoc.GetTopics do
if Filter.IsEmpty or Topic.ToLower.Contains(Filter) then
lbIndex.AddLine(Topic);
finally
lbIndex.EndAddLine;
end;
finally
lbIndex.EndVisualUpdate(True);
lbIndex.EditMode := emReadOnly;
lbIndex.RulerVisible := False;
lbIndex.MarginLeft := ScaleValue(10);
lbIndex.TextFile.GotoSOF;
end;
end;
procedure TDocBrowser.Reload;
begin
if FHistory = nil then
Exit;
if not InRange(FHistoryIndex, 0, FHistory.Count - 1) then
Exit;
LoadEditor(FHistory[FHistoryIndex]);
end;
procedure TDocBrowser.SearchButtonClick(Sender: TObject);
begin
if Sidebar = sbSearch then
Sidebar := sbNone
else
Sidebar := sbSearch;
end;
procedure TDocBrowser.SearchTextKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_RETURN then
Key := 0;
end;
procedure TDocBrowser.SearchTextKeyPress(Sender: TObject; var Key: Char);
var
L: TArray<string>;
begin
if Key = Chr(VK_RETURN) then
begin
FSearchPhrase := FSearchForm.eSearchText.PlainText;
FSearchOptions := [];
if not FSearchForm.cbMatchCase.Checked then
Include(FSearchOptions, ssoIgnoreCase);
if FSearchForm.cbWholeWords.Checked then
Include(FSearchOptions, ssoWholeWords);
BeginBusyWork;
try
L := TASDoc.Search(FSearchPhrase, FSearchOptions);
finally
EndBusyWork;
end;
FSearchForm.lbSearchMatches.EditMode := emText;
FSearchForm.lbSearchMatches.BeginVisualUpdate;
try
FSearchForm.lbSearchMatches.BeginAddLine;
try
FSearchForm.lbSearchMatches.Clear;
for var s in L do
FSearchForm.lbSearchMatches.AddLine(s);
finally
FSearchForm.lbSearchMatches.EndAddLine;
end;
finally
FSearchForm.lbSearchMatches.EndVisualUpdate(True);
FSearchForm.lbSearchMatches.EditMode := emReadOnly;
FSearchForm.lbSearchMatches.RulerVisible := False;
FSearchForm.lbSearchMatches.MarginLeft := 0;
FSearchForm.lbSearchMatches.TextFile.GotoSOF;
end;
Key := #0;
end;
end;
procedure TDocBrowser.SetSidebar(const Value: TSidebar);
begin
if FSidebar <> Value then
begin
FSidebar := Value;
case FSidebar of
sbNone:
begin
if Assigned(pnSidebar) then
pnSidebar.Hide;
if Assigned(FSplitter) then
FSplitter.Hide;
end;
sbIndex, sbSearch:
begin
if FSidebar = sbIndex then SetupIndexCtls;
if FSidebar = sbSearch then SetupSearchCtls;
if Assigned(pnSidebar) and Assigned(FSplitter) then
begin
pnSidebar.Show;
FSplitter.Show;
pnSidebar.Left := FSplitter.Left - 10;
end;
for var i := 0 to pnSidebar.ControlCount - 1 do
pnSidebar.Controls[i].Visible := pnSidebar.Controls[i].Tag = Ord(FSidebar);
end;
end;
if not FNoSideBarFocus then
case FSidebar of
sbNone:
if Visible and Assigned(Editor) and Editor.CanFocus then
Editor.SetFocus;
sbIndex:
if Visible and Assigned(lbIndex) and lbIndex.CanFocus then
lbIndex.SetFocus;
sbSearch:
if Visible and Assigned(FSearchForm) and Assigned(FSearchForm.eSearchText) and FSearchForm.eSearchText.CanFocus then
FSearchForm.eSearchText.SetFocus;
end;
end;
var LButtons := TArray<TUxButton>.Create(btnIndex, btnSearch);
for var LButton in LButtons do
if Assigned(LButton) then
LButton.Down := LButton.Tag = Ord(FSidebar);
end;
procedure TDocBrowser.SetupFileNaming;
begin
Editor.TextFile.SetNamingData('Documentation file %d', @FDocFileCounter);
end;
procedure TDocBrowser.SetupIndexCtls;
begin
SetupSidebarPanel;
if pnIndex = nil then
begin
pnIndex := TUxClient.Create(pnSidebar);
pnIndex.Parent := pnSidebar;
pnIndex.Align := alClient;
pnIndex.Tag := Ord(sbIndex);
end;
if teIndexFilter = nil then
begin
teIndexFilter := TTextEditor.Create(pnIndex);
teIndexFilter.Parent := pnIndex;
teIndexFilter.Align := alTop;
teIndexFilter.Hint := 'Filters the index.';
teIndexFilter.TextHint := 'Filter index';
teIndexFilter.AlignWithMargins := True;
teIndexFilter.Margins.SetBounds(2, 2, 2, 2);
teIndexFilter.BorderType := btNone;
teIndexFilter.UseRuxThemes := True;
teIndexFilter.RuxAccent := True;
teIndexFilter.LetterSpacing := 0;
teIndexFilter.AutoReplace := True;
teIndexFilter.SingleLine := True;
teIndexFilter.OnChange := teIndexFilterChange;
teIndexFilter.OnKeyDown := teIndexFilterKeyDown;
teIndexFilter.TabOrder := 1;
end;
if lbIndex = nil then
begin
lbIndex := TTextEditor.Create(pnIndex);
lbIndex.Parent := pnIndex;
lbIndex.Align := alClient;
lbIndex.BorderType := btNone;
lbIndex.TabOrder := 0;
lbIndex.LetterSpacing := 0;
lbIndex.ErrorMessageOnReadOnlyError := False;
lbIndex.EditMode := emReadOnly;
lbIndex.LineHighlight := True;
lbIndex.MatchBrackets := False;
lbIndex.ListBoxMode := True;
lbIndex.ListBoxSelection := False;
lbIndex.ListBoxHideSelection := False;
lbIndex.OnKeyDown := lbIndexKeyDown;
lbIndex.OnKeyPress := lbIndexKeyPress;
lbIndex.OnListBoxChange := lbIndexChange;
PopulateIndex;
lbIndex.ListBoxItemIndex := lbIndex.TextFile.IndexOf(FTopic);
end;
end;
procedure TDocBrowser.SetupSearchCtls;
begin
SetupSidebarPanel;
if pnSearch = nil then
begin
pnSearch := TUxClient.Create(pnSidebar);
pnSearch.Parent := pnSidebar;
pnSearch.Align := alClient;
pnSearch.Tag := Ord(sbSearch);
end;
if FSearchForm = nil then
begin
FSearchForm := TDocSearchForm.Create(pnSearch);
FSearchForm.Parent := pnSearch;
FSearchForm.Align := alClient;
FSearchForm.Visible := True;
FSearchForm.eSearchText.OnKeyPress := SearchTextKeyPress;
FSearchForm.eSearchText.OnKeyDown := SearchTextKeyDown;
FSearchForm.lbSearchMatches.OnListBoxChange := lbIndexChange;
FSearchForm.lbSearchMatches.OnKeyDown := lbSearchMatchesKeyDown;
end;
end;
procedure TDocBrowser.SetupSidebarPanel;
begin
if pnSidebar = nil then
begin
pnSidebar := TUxClient.Create(Self);
pnSidebar.Parent := Self;
pnSidebar.Align := alLeft;
pnSidebar.Width := ScaleValue(250);
end;
if FSplitter = nil then
begin
FSplitter := TUxSplitter.Create(Self);
FSplitter.Parent := Self;
FSplitter.Align := alLeft;
FSplitter.AutoSnap := False;
FSplitter.MinSize := ScaleValue(200);
FSplitter.ResizeStyle := rsUpdate;
pnSidebar.Left := FSplitter.Left - 10;
end;
end;
procedure TDocBrowser.SetupToolbar;
begin
btnBack := AddToolbarControl<TUxButton>;
btnBack.Caption := '◀';
btnBack.Hint := 'Goes back one page in history.';
btnBack.OnClick := BackButtonClick;
btnHistory := AddToolbarControl<TUxButton>;
btnHistory.Caption := '&History';
btnHistory.Hint := 'Shows the history of this help browser window.';
btnHistory.OnClick := HistoryButtonClick;
btnHistory.ShorterCaptions := ['&Hist.', '&H'];
btnForward := AddToolbarControl<TUxButton>;
btnForward.Caption := '▶';
btnForward.Hint := 'Goes forward one page in history.';
btnForward.OnClick := ForwardButtonClick;
btnHome := AddToolbarControl<TUxButton>;
btnHome.Caption := 'H&ome';
btnHome.Hint := 'Navigates to the help system’s start page.';
btnHome.OnClick := HomeButtonClick;
btnHome.ShorterCaptions := ['⌂'];
btnIndex := AddToolbarControl<TUxButton>;
btnIndex.Caption := '&Index';
btnIndex.Hint := 'Opens the help index panel.';
btnIndex.OnClick := IndexButtonClick;
btnIndex.Tag := Ord(sbIndex);
btnIndex.ShorterCaptions := ['&Idx', '📖'];
btnSearch := AddToolbarControl<TUxButton>;
btnSearch.Caption := '&Search';
btnSearch.Hint := 'Opens the help topic search panel.';
btnSearch.OnClick := SearchButtonClick;
btnSearch.Tag := Ord(sbSearch);
btnSearch.ShorterCaptions := ['&Srch', '🔍'];
btnGoto := AddToolbarControl<TUxButton>;
btnGoto.Caption := '&Go to...';
btnGoto.Hint := 'Lets you open a page by typing its name.';
btnGoto.OnClick := GotoButtonClick;
btnGoto.ShorterCaptions := ['&Go…', '&G…'];
eFind := AddToolbarControl<TASEditor>;
eFind.Anchors := [TAnchorKind.akTop, TAnchorKind.akRight];
eFind.SingleLine := True;
eFind.UseRuxThemes := True;
eFind.RuxAccent := True;
eFind.TextHint := 'Find on page (Ctrl+F)';
eFind.OnChange := FindEditChange;
eFind.OnKeyDown := FindEditKeyDown;
UpdateToolbarStates;
end;
procedure TDocBrowser.SetupToolMenu;
begin
CreateToolMenu;
const FmnuGo = SimpleMenu.AddSubmenu('Go', 'Contains browser commands.');
SimpleMenu.AddCommand(DOC_BACK, FmnuGo, 'Back'#9'Alt+Left', 'Goes back one page in history.');
SimpleMenu.AddCommand(DOC_FORWARD, FmnuGo, 'Forward'#9'Alt+Right', 'Goes forward one page in history.');
SimpleMenu.AddCommand(DOC_HOME, FmnuGo, 'Home'#9'Alt+Home', 'Navigates to the help system’s start page.');
SimpleMenu.AddCommand(0, FmnuGo, '-', '');
SimpleMenu.AddCommand(DOC_NEWWIN, FmnuGo, 'New documentation window', 'Creates a new documentation browser window.');
inherited;
SimpleMenu.AddCommand(PAN_SHOWTOOLBAR, FmnuView, 'Show toolbar', 'Shows or hide the toolbar.');
SimpleMenu.AddCommand(DOC_PAGEINFO, FmnuTools, 'Show page info'#9'Ctrl+I', 'Displays information about this page.');
SimpleMenu.AddCommand(DOC_SOURCE, FmnuTools, 'Show source'#9'Ctrl+U', 'Displays the source code of this page.');
end;
class procedure TDocBrowser.ShowDoc(const ATopic: string; ANewWindow: Boolean;
ASidebar: TSidebar; AFocusSideBar: Boolean);
begin
if not ATopic.Trim.IsEmpty then
begin
var LActiveInstance := ActiveInstance;
if ANewWindow or (LActiveInstance = nil) then
begin
var LNewForm := TUxForm.CreateNewForm<TDocBrowser>;
LNewForm.Navigate(ATopic);
LNewForm.NoSidebarFocus := not AFocusSidebar;
try
LNewForm.Sidebar := ASidebar;
finally
LNewForm.NoSidebarFocus := False;
end;
end
else
begin
LActiveInstance.Navigate(ATopic);
LActiveInstance.BringToFront;
if ASidebar <> sbNone then
begin
LActiveInstance.NoSidebarFocus := not AFocusSidebar;
try
LActiveInstance.Sidebar := ASidebar;
finally
LActiveInstance.NoSidebarFocus := False;
end;
end;
end;
end;
end;
class procedure TDocBrowser.ShowDocOrIndex(const ATopic: string;
ANewWindow: Boolean);
begin
if TASDoc.TopicExists(ATopic) then
ShowDoc(ATopic, ANewWindow)
else
ShowDoc('Algosim', True, sbIndex, True);
end;
procedure TDocBrowser.ShowPageInfo;
var
Lines, Names, Values: TArray<string>;
begin
if not FTopicInfo.Name.IsEmpty then
begin
Lines := FTopicInfo.Metadata.Split([sLineBreak]);
SetLength(Names, Length(Lines));
SetLength(Values, Length(Lines));
for var i := 0 to High(Lines) do
begin
const p = Pos(':', Lines[i]);
if p > 0 then
begin
Names[i] := Copy(Lines[i], 1, Pred(p)).Trim;
Values[i] := Copy(Lines[i], Succ(p)).Trim;
end
else
begin
TD(FTopicInfo.Name).Text(FTopicInfo.Metadata).Info.OK.Execute;
Exit;
end;
end;
Names := ['Title', 'File name'] + Names;
Values := [FTopicInfo.Name, TASDoc.GetDocFileName(FTopicInfo.Name, True)] + Values;
TTableDialog.ShowTable(GetParentFormSafe(Self), 'Page Information', '', Names, Values, mtCustom);
end;
end;
procedure TDocBrowser.ShowPageInfo(Sender: TObject);
begin
ShowPageInfo;
end;
procedure TDocBrowser.ShowSource;
begin
if FTopic.Trim.IsEmpty then
Exit;
var LNewForm := TUxForm.CreateNewForm<TDocSourceForm>;
LNewForm.LoadDoc(FTopic);
end;
procedure TDocBrowser.ShowSource(Sender: TObject);
begin
ShowSource;
end;
procedure TDocBrowser.teDocViewHyperlinkClick(Sender: TObject;
const ALinkRec: TLinkRec);
begin
if IsURL(ALinkRec.URL) then
ShellExecute(0, nil, PChar(ALinkRec.URL), nil, nil, SW_SHOWNORMAL)
else
if GetKeyState(VK_SHIFT) < 0 then
ShowDoc(ALinkRec.URL, True)
else
Navigate(ALinkRec.URL);
end;
procedure TDocBrowser.teDocViewNavRequest(Sender: TObject;
AEditorCommand: Integer);
begin
case AEditorCommand of
EDITOR_COMMAND_BACK:
Back;
EDITOR_COMMAND_FORWARD:
Forward;
EDITOR_COMMAND_REFRESH:
Refresh;
end;
end;
procedure TDocBrowser.teDocViewNavRequestGetEnabled(Sender: TObject;
AEditorCommand: Integer; var AEnabled: Boolean);
begin
case AEditorCommand of
EDITOR_COMMAND_BACK:
AEnabled := Assigned(FHistory) and InRange(FHistoryIndex, 1, FHistory.Count - 1);
EDITOR_COMMAND_FORWARD:
AEnabled := Assigned(FHistory) and InRange(FHistoryIndex, 0, FHistory.Count - 2);
EDITOR_COMMAND_REFRESH:
AEnabled := True;
end;
end;
procedure TDocBrowser.teIndexFilterChange(Sender: TObject);
begin
PopulateIndex;
end;
procedure TDocBrowser.teIndexFilterKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if lbIndex = nil then
Exit;
if teIndexFilter = nil then
Exit;
case Key of
VK_UP, VK_DOWN:
begin
if Visible and lbIndex.CanFocus then
lbIndex.SetFocus;
if lbIndex.LineCount > 0 then
lbIndex.ListBoxItemIndex := IfThen(Key = VK_UP, lbIndex.LineCount - 1, 0);
Key := 0;
end;
VK_RETURN:
begin
var Idx := lbIndex.TextFile.IndexOfText2(teIndexFilter.PlainText);
if Idx <> -1 then
begin
lbIndex.ListBoxItemIndex := Idx;
lbIndexChange(lbIndex);
if FGotoPath then
begin
Sidebar := FPreGotoSidebar;
FGotoPath := False;
end;
if Visible and Assigned(Editor) and Editor.CanFocus then
Editor.SetFocus;
end;
Key := 0;
end;
end;
end;
procedure TDocBrowser.UpdateToolbarStates;
begin
if Assigned(btnBack) then
btnBack.Enabled := Assigned(FHistory) and InRange(FHistoryIndex, 1, FHistory.Count - 1);
if Assigned(btnForward) then
btnForward.Enabled := Assigned(FHistory) and InRange(FHistoryIndex, 0, FHistory.Count - 2);
if Assigned(btnHome) then
btnHome.Enabled := not SameText(FTopic, 'Algosim');
end;
class function TDocBrowser.VerifyInstance(ADocBrowser: TDocBrowser): Boolean;
begin
Result := Assigned(FInstances) and FInstances.Contains(ADocBrowser);
end;
procedure TDocBrowser.WMAppcommand(var Message: TMessage);
begin
Message.Result := 0;
if Message.wParam = Editor.Handle then
begin
case GET_APPCOMMAND_LPARAM(Message.lParam) of
APPCOMMAND_BROWSER_BACKWARD:
begin
Back;
Message.Result := 1;
end;
APPCOMMAND_BROWSER_FORWARD:
begin
Forward;
Message.Result := 1;
end;
APPCOMMAND_BROWSER_REFRESH:
begin
Reload;
Message.Result := 1;
end;
APPCOMMAND_BROWSER_HOME:
begin
Navigate('Algosim');
Message.Result := 1;
end;
APPCOMMAND_CLOSE:
begin
Close;
Message.Result := 1;
end;
end;
end;
if Message.Result = 0 then
inherited;
end;
procedure TDocBrowser.LoadEditor(const ATopic: string);
begin
if Editor = nil then
Exit;
TASDoc.LoadFromFile(Editor, TASDoc.GetDocFileName(ATopic, True),
FTopicInfo, dmView);
FTopic := ATopic;
Caption := ATopic;
UpdateToolbarStates;
if Assigned(lbIndex) then
lbIndex.ListBoxItemIndex := lbIndex.TextFile.IndexOf(FHistory[FHistoryIndex]);
end;
function TDocSourceForm.CheckModified: Boolean;
begin
Result := True;
end;
procedure TDocSourceForm.CmdExec(AID: Integer);
begin
if IndexInt(AID, InapplCmds) = -1 then
inherited;
end;
procedure TDocSourceForm.CmdGetState(AID: Integer; var AVisible, AEnabled,
AChecked: Boolean);
begin
inherited;
if IndexInt(AID, InapplCmds) <> -1 then
AVisible := False;
end;
function TDocSourceForm.ContextHelp: Boolean;
begin
TDocBrowser.ShowDocOrIndex('Documentation source code', True);
Result := True;
end;
constructor TDocSourceForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
Editor.EditMode := emReadOnly;
Editor.TextFile.StrictReadOnly := True;
Editor.FormattingProcessor := TASRefFormattingProcessor.Create(Self);
end;
function TDocSourceForm.GetEditorSubclass: TTextEditorClass;
begin
Result := TASEditor;
end;
class function TDocSourceForm.IsDisposable: Boolean;
begin
Result := True;
end;
procedure TDocSourceForm.LoadDoc(const ATopic: string);
var
LTopicInfo: TTopicInfo;
begin
if ATopic.Trim.IsEmpty then
Exit;
if Editor = nil then
Exit;
TASDoc.LoadFromFile(Editor, TASDoc.GetDocFileName(ATopic, True), LTopicInfo,
dmEdit);
FTopic := ATopic;
Editor.EditMode := emReadOnly;
Editor.TextFile.StrictReadOnly := True;
Editor.TextFile.GotoSOF;
Caption := 'Source of ' + FTopic;
end;
procedure TDocSourceForm.SetupFileMasks(AItems: TFileTypeItems;
var ADefExtSansPeriod: string);
begin
var LItem := AItems.Add;
LItem.DisplayName := 'Algosim Markup Langauge files';
LItem.FileMask := '*.asml';
inherited;
ADefExtSansPeriod := 'asml';
end;
procedure TDocSourceForm.SetupFileNaming;
begin
Editor.TextFile.SetNamingData('Documentation source file %d', @FDocSrcFileCounter);
end;
constructor TConsoleProperties.Create;
begin
inherited;
FName := 'Console';
end;
constructor TConsoleProperties.Create(AConsoleForm: TConsoleForm);
begin
Create;
FConsoleForm := AConsoleForm;
AddValue('name', Name);
AddValue('ID', ID);
AddValue('history', History);
AddSubstore(TTextEditorProperties.Create(FConsoleForm.Console), 'editor');
end;
function TConsoleProperties.GetConsoleForm: TConsoleForm;
resourcestring
SNoConsoleForm = 'No valid console form assigned.';
begin
if Assigned(FConsoleForm) and TConsoleForm.VerifyInstance(FConsoleForm) then
Result := FConsoleForm
else
raise Exception.Create(SNoConsoleForm);
end;
function TConsoleProperties.History: TAlgosimObject;
begin
var LList := TArray<string>(nil);
SetLength(LList, ConsoleForm.Editor.CliHistoryCount);
for var i := 0 to High(LList) do
LList[i] := ConsoleForm.Editor.CliHistory[i];
Result := TAlgosimArray.CreateWithValue(LList);
end;
function TConsoleProperties.ID: TAlgosimObject;
begin
Result := ASO(ConsoleForm.GUID.ToString);
end;
function TConsoleProperties.Name: TAlgosimOBject;
begin
Result := ASO(ConsoleForm.Caption);
end;
function TConsolesPropStore.LocalGetValue(const AKey: string): TAlgosimObject;
begin
Result := inherited;
if (AKey = 'list') and Assigned(FSubstores) then
Result := TAlgosimArray.CreateWithValue(FSubstores.Keys.ToArray);
end;
class constructor TVisMgrForm.ClassCreate;
begin
FInstances := TList<TVisMgrForm>.Create;
VisObjListChanged := VisObjChange;
FRefreshTimer := TTimer.Create(nil);
FRefreshTimer.Enabled := False;
FRefreshTimer.Interval := 500;
FRefreshTimer.OnTimer := RefreshTimerTimer;
end;
class destructor TVisMgrForm.ClassDestroy;
begin
FreeAndNil(FRefreshTimer);
FreeAndNil(FInstances);
end;
function TVisMgrForm.ContextHelp: Boolean;
begin
TDocBrowser.ShowDocOrIndex('Visual object manager', False);
Result := True;
end;
constructor TVisMgrForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
if Assigned(FInstances) then
FInstances.Add(Self);
if Assigned(ListView) then
ListView.EmptyText := 'No visual objects';
end;
procedure TVisMgrForm.DefaultClick(Sender: TObject);
begin
var LObj := SelectedObject;
if Assigned(LObj) then
TVisualization.ShowVisCtl(LObj.GUID);
end;
procedure TVisMgrForm.DeleteClick(Sender: TObject);
begin
BeginBusyWork;
try
var LObjs := SelectedObjects;
for var Obj in LObjs do
begin
if Obj is TDrawable then
TDrawable(Obj).Control.RemoveObject(TDrawable(Obj))
else if Obj is TDrawable3D then
try
TDrawable3D(Obj).Control.RemoveObject(TDrawable3D(Obj));
except
on ERglError do Continue;
end;
end;
finally
EndBusyWork;
end;
end;
destructor TVisMgrForm.Destroy;
begin
if Assigned(FInstances) then
FInstances.Remove(Self);
inherited;
end;
class function TVisMgrForm.GetColumns: TArray<TListForm.TColumnRec>;
begin
Result :=
[
CR('Name', 200, csmText),
CR('Type', 275, csmText),
CR('Title', 200, csmText),
CR('Description', 200, csmText),
CR('Paint time/s', 100, csmFloat),
CR('ID', 400, csmText)
];
end;
class function TVisMgrForm.GetData: TArray<TListForm.TDataRow>;
procedure AddObject(AList: TList<TListForm.TDataRow>; AVisObj: TVisObj);
function BaseType(AVisObj: TVisObj): string;
begin
if AVisObj is TDrawable then
Result := '2D object'
else if AVisObj is TDrawable3D then
Result := '3D object'
else
Result := 'object';
end;
function Declassify(const S: string): string;
begin
if (S <> '') and (S[1] = 'T') then
Result := Copy(S, 2)
else
Result := S;
end;
begin
AList.Add(
DataRow(
[
AVisObj.Name,
BaseType(AVisObj) + ' > ' + Declassify(AVisObj.ClassName),
AVisObj.Title,
AVisObj.Description,
AVisObj.LastDrawTime / 1000.0,
AVisObj.GUID.ToString
],
NativeUInt(AVisObj)
)
);
end;
begin
var L := TList<TListForm.TDataRow>.Create;
try
for var P in TDrawable.Instances do
AddObject(L, P.Value);
for var P in TDrawable3D.Instances do
AddObject(L, P.Value);
Result := L.ToArray;
finally
L.Free;
end;
end;
procedure TVisMgrForm.mnuMetadataClick(Sender: TObject);
begin
var LObj := SelectedObject;
if Assigned(LObj) then
ObjectMetadataForm.SetMetadata(Self, LObj);
end;
procedure TVisMgrForm.mnuSettingsClick(Sender: TObject);
begin
var LObj := SelectedObject;
if Assigned(LObj) then
LObj.ShowOptionsForm(Self);
end;
procedure TVisMgrForm.PopupMenuPopup(Sender: TObject);
begin
inherited;
if Assigned(FmiSettings) then
FmiSettings.Enabled := Assigned(ListView) and (ListView.SelCount = 1);
if Assigned(FmiMetadata) then
FmiMetadata.Enabled := Assigned(ListView) and (ListView.SelCount = 1);
end;
class procedure TVisMgrForm.RefreshListDelayed;
begin
RestartTimer(FRefreshTimer);
end;
class procedure TVisMgrForm.RefreshTimerTimer(Sender: TObject);
begin
FRefreshTimer.Enabled := False;
if Assigned(FInstances) then
for var LInstance in FInstances do
LInstance.Refresh;
end;
function TVisMgrForm.RowIdentity: TListForm.TRowIdentity;
begin
Result := riData;
end;
function TVisMgrForm.SelectedObject: TVisObj;
begin
if ListView = nil then
Exit(nil);
if ListView.SelCount <> 1 then
Exit(nil);
if ListView.Selected = nil then
Exit(nil);
if ListView.Selected.SubItems.Count < 5 then
Exit(nil);
var IDstr := ListView.Selected.SubItems[4];
if IDstr.IsEmpty then
Exit(nil);
var ID := TGUID.Create(IDstr);
if ID.IsEmpty then
Exit(nil);
var D2D := TDrawable(nil);
if TDrawable.TryGetDrawableByGUID(ID, D2D) then
Exit(D2D);
var D3D := TDrawable3D(nil);
if TDrawable3D.TryGetDrawableByGUID(ID, D3D) then
Exit(D3D);
Result := nil;
end;
function TVisMgrForm.SelectedObjects: TArray<TVisObj>;
begin
if ListView = nil then
Exit(nil);
var L := TList<TVisObj>.Create;
try
var Idxs := ListView.GetSelectedIndicesFast;
for var Idx in Idxs do
begin
var LItem := ListView.Items[Idx];
if Assigned(LItem) and (LItem.SubItems.Count >= 5) then
begin
var IDstr := LItem.SubItems[4];
if not IDstr.IsEmpty then
begin
var ID := TGUID.Create(IDstr);
if not ID.IsEmpty then
begin
var D2D := TDrawable(nil);
if TDrawable.TryGetDrawableByGUID(ID, D2D) then
L.Add(D2D);
var D3D := TDrawable3D(nil);
if TDrawable3D.TryGetDrawableByGUID(ID, D3D) then
L.Add(D3D);
end;
end;
end;
end;
Result := L.ToArray;
finally
L.Free;
end;
end;
procedure TVisMgrForm.SetupToolMenu;
begin
inherited;
FmiSettings := TMenuItem.Create(Self);
FmiSettings.Caption := 'Settings';
FmiSettings.Hint := 'Lets you change the object’s settings.';
FmiSettings.OnClick := mnuSettingsClick;
PopupMenu.Items.Insert(2, FmiSettings);
FmiMetadata := TMenuItem.Create(Self);
FmiMetadata.Caption := 'Set metadata...';
FmiMetadata.Hint := 'Lets you change the object’s metadata.';
FmiMetadata.OnClick := mnuMetadataClick;
PopupMenu.Items.Insert(3, FmiMetadata);
PopupMenu.Items.InsertNewLineBefore(FmiSettings);
end;
class procedure TVisMgrForm.VisObjChange(Sender: TObject);
begin
RefreshListDelayed;
end;
class constructor TSettingsForm.ClassCreate;
begin
FInstances := TList<TSettingsForm>.Create;
TASSettings.RegisterCallback(SettingsChanged);
FRefreshTimer := TTimer.Create(nil);
FRefreshTimer.Enabled := False;
FRefreshTimer.Interval := 500;
FRefreshTimer.OnTimer := RefreshTimerTimer;
end;
class destructor TSettingsForm.ClassDestroy;
begin
FreeAndNil(FRefreshTimer);
FreeAndNil(FInstances);
end;
function TSettingsForm.ContextHelp: Boolean;
begin
TDocBrowser.ShowDocOrIndex('Settings manager', False);
Result := True;
end;
constructor TSettingsForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
if Assigned(FInstances) then
FInstances.Add(Self);
if Assigned(ListView) then
begin
ListView.Sort(0);
ListView.EmptyText := 'No settings';
end;
end;
procedure TSettingsForm.DefaultClick(Sender: TObject);
begin
if ListView = nil then
Exit;
if ListView.SelCount <> 1 then
Exit;
var LSel := ListView.Selected;
if LSel = nil then
Exit;
if not InRange(NativeUInt(LSel.Data), Ord(Low(TSettingDataType)), Ord(High(TSettingDataType))) then
Exit;
const LDataType = TSettingDataType(NativeUInt(LSel.Data));
case LDataType of
sdtBoolean:
begin
var S := TASSettings.GetSettingBool(LSel.Caption).ToString(TUseBoolStrs.True);
if
TMultiInputBox.TextInputBoxEx(
GetParentFormSafe(Self),
LSel.Caption,
'Please enter the new value of this setting:',
S,
TEditCharCase.ecNormal,
function(const Text: string): Boolean
begin
var dummy: Boolean;
Result := TryStrToBool(Text, dummy);
end
)
then
TASSettings.SetSetting(LSel.Caption, StrToBool(S));
end;
sdtInteger:
begin
var i := TASSettings.GetSettingInteger(LSel.Caption);
if
TMultiInputBox.NumInputBox(
GetParentFormSafe(Self),
LSel.Caption,
'Please enter the new value of this setting:',
i
)
then
TASSettings.SetSetting(LSel.Caption, i);
end;
sdtColor:
begin
var S := ASColors.ColorToHex(TASSettings.GetSettingColor(LSel.Caption));
if
TMultiInputBox.TextInputBoxEx(
GetParentFormSafe(Self),
LSel.Caption,
'Please enter the new value of this setting:',
S,
TEditCharCase.ecNormal,
function(const Text: string): Boolean
begin
var dummy: TColor;
Result := ASColors.TryStrToColor(Text, dummy);
end
)
then
TASSettings.SetSetting(LSel.Caption, ASColors.StrToColor(S));
end;
sdtDouble:
begin
var x: Real := TASSettings.GetSettingDouble(LSel.Caption);
if
TMultiInputBox.FloatInputBox(
GetParentFormSafe(Self),
LSel.Caption,
'Please enter the new value of this setting:',
x,
Double.MinValue,
Double.MaxValue
)
then
TASSettings.SetSetting(LSel.Caption, Double(x));
end;
sdtString:
begin
var S := TASSettings.GetSettingString(LSel.Caption);
if
TMultiInputBox.TextInputBox(
GetParentFormSafe(Self),
LSel.Caption,
'Please enter the new value of this setting:',
S
)
then
TASSettings.SetSetting(LSel.Caption, S);
end;
sdtDateTime:
begin
var S := DateTimeToStdStr(TASSettings.GetSettingDateTime(LSel.Caption));
if
TMultiInputBox.TextInputBoxEx(
GetParentFormSafe(Self),
LSel.Caption,
'Please enter the new value of this setting:',
S,
TEditCharCase.ecNormal,
function(const Text: string): Boolean
begin
var dummy: TDateTime;
Result := TryStrToDateTime(Text, dummy, GInvFS);
end
)
then
TASSettings.SetSetting(LSel.Caption, StrToDateTime(S, GInvFS));
end;
end;
end;
procedure TSettingsForm.DeleteClick(Sender: TObject);
begin
inherited;
if ListView = nil then
Exit;
const LSettings = ListView.GetSelectedCaptions;
for var LSetting in LSettings do
TASSettings.RestoreKnownSetting(LSetting);
end;
destructor TSettingsForm.Destroy;
begin
if Assigned(FInstances) then
FInstances.Remove(Self);
inherited;
end;
class function TSettingsForm.GetColumns: TArray<TListForm.TColumnRec>;
begin
Result :=
[
CR('Name', 200, csmText),
CR('Type', 200, csmText),
CR('Value', 150, csmText),
CR('Default value', 150, csmText),
CR('Description', 800, csmText)
];
end;
class function TSettingsForm.GetData: TArray<TListForm.TDataRow>;
begin
var L := TList<TListForm.TDataRow>.Create;
try
var LKnownSettings := TASSettings.KnownSettings;
for var LSetting in LKnownSettings do
begin
L.Add(
DataRow(
[
LSetting.Name,
LSetting.&Type.ToLocalizedString,
LSetting.ValueAsText,
LSetting.DefaultValueAsText,
LSetting.Description
],
Ord(LSetting.&Type)
)
)
end;
Result := L.ToArray;
finally
L.Free;
end;
end;
procedure TSettingsForm.PopupMenuPopup(Sender: TObject);
begin
inherited;
FmiDefault.Caption := 'Change...';
FmiDefault.Hint := 'Lets you change this setting.';
FmiDelete.Caption := 'Revert'#9'Del';
FmiDelete.Hint := 'Restores the selected settings to their default values.';
end;
class procedure TSettingsForm.RefreshListDelayed;
begin
RestartTimer(FRefreshTimer);
end;
class procedure TSettingsForm.RefreshTimerTimer(Sender: TObject);
begin
FRefreshTimer.Enabled := False;
if Assigned(FInstances) then
for var LInstance in FInstances do
LInstance.Refresh;
end;
function TSettingsForm.RowIdentity: TListForm.TRowIdentity;
begin
Result := riCaption;
end;
class procedure TSettingsForm.SettingsChanged;
begin
RefreshListDelayed;
end;
function TPascalSourceForm.CheckModified: Boolean;
begin
Result := True;
end;
function TPascalSourceForm.ContextHelp: Boolean;
begin
TDocBrowser.ShowDocOrIndex('Pascal source code', True);
Result := True;
end;
constructor TPascalSourceForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
Editor.EditMode := emReadOnly;
Editor.TextFile.StrictReadOnly := True;
Editor.FormattingProcessor := TPascalFormattingProcessor.Create(Self);
Editor.CaretAfterEOL := True;
end;
procedure TPascalSourceForm.FirstShow;
begin
RequestClientSize(1200, 800);
end;
function TPascalSourceForm.GetEditorSubclass: TTextEditorClass;
begin
Result := TASEditor;
end;
class function TPascalSourceForm.IsDisposable: Boolean;
begin
Result := True;
end;
procedure TPascalSourceForm.LoadText(const ACaption, AText: string;
ATopLine: Integer = 0; ABookmark1: Integer = -1; ABookmark2: Integer = -1);
begin
if Editor = nil then
Exit;
Editor.TextFile.StrictReadOnly := False;
Editor.EditMode := emText;
Editor.PlainText := AText.Trim;
Editor.EditMode := emReadOnly;
if ABookmark1 <> -1 then
Editor.AddBookmark(1, Point(0, ABookmark1));
if ABookmark2 <> -1 then
Editor.AddBookmark(2, Point(0, ABookmark2));
Editor.TextFile.StrictReadOnly := True;
Editor.CaretPos := Point(0, ATopLine);
Caption := 'Source of ' + ACaption;
end;
procedure TPascalSourceForm.SetupFileMasks(AItems: TFileTypeItems;
var ADefExtSansPeriod: string);
begin
var LItem := AItems.Add;
LItem.DisplayName := 'Pascal files';
LItem.FileMask := '*.pas';
inherited;
ADefExtSansPeriod := 'pas';
end;
procedure TPascalSourceForm.SetupFileNaming;
begin
Editor.TextFile.SetNamingData('Pascal source file %d', @FPasSrcFileCounter);
end;
initialization
GInvFS := TFormatSettings.Invariant;
TDMB_ManualOwnerPos := True;
RegisterPanelClass(TMathEditorForm);
RegisterPanelClass(TConsoleForm);
RegisterPanelClass(TIdentifierForm);
RegisterPanelClass(TTaskListForm);
RegisterPanelClass(TTextViewer);
RegisterPanelClass(TSoundPlayerForm);
RegisterPanelClass(TProgramEditorForm);
RegisterPanelClass(TDocBrowser);
RegisterPanelClass(TVisMgrForm);
RegisterPanelClass(TSettingsForm);
end.