ASExecutionContext.pas

unit ASExecutionContext;

{ **************************************************************************** }
{ Rejbrand AlgoSim Execution Context                                           }
{ Copyright © 2018-2019 Andreas Rejbrand                                       }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}

interface

uses
  SysUtils, Classes, ASNum, ASObjects, ASObjStore, ASPropMan, ASKernelDefs,
  ASKernel, SyncObjs;

const
  CLIENT_COMMAND_CLS = 1;
  CLIENT_COMMAND_EXIT = 2;
  CLIENT_COMMAND_SYSTEM = 3;
  CLIENT_COMMAND_MSGBOX = 9;
  CLIENT_COMMAND_INPUTBOX = 10;
  CLIENT_COMMAND_PRINT = 11;
  CLIENT_COMMAND_REMOVEBUFFER = 12;
  CLIENT_COMMAND_SELFTEST = 13;
  CLIENT_COMMAND_DISPLAY = 14;
  CLIENT_COMMAND_WINDOW = 15;
  CLIENT_COMMAND_COLORDIALOG = 16;
  CLIENT_COMMAND_FONTDIALOG = 17;
  CLIENT_COMMAND_FILEDIALOG = 18;
  CLIENT_COMMAND_SAVEOBJECT = 19;
  CLIENT_COMMAND_FRONTENDEXCEPTION = 20;
  CLIENT_COMMAND_GETFPCW = 21;
  CLIENT_COMMAND_SETFPCW = 22;
  CLIENT_COMMAND_GRPHTEST = 23;

  CLIENT_COMMAND_MIDI_SETINSTRUMENT = 101;
  CLIENT_COMMAND_MIDI_GETINSTRUMENT = 102;
  CLIENT_COMMAND_MIDI_SETVOLUME = 103;
  CLIENT_COMMAND_MIDI_GETVOLUME = 104;
  CLIENT_COMMAND_MIDI_NOTEON = 105;
  CLIENT_COMMAND_MIDI_NOTEOFF = 106;
  CLIENT_COMMAND_MIDI_PNOTEON = 107;
  CLIENT_COMMAND_MIDI_PNOTEOFF = 108;
  CLIENT_COMMAND_MIDI_SILENCE = 109;
  CLIENT_COMMAND_MIDI_FORCEDSILENCE = 110;
  CLIENT_COMMAND_MIDI_RESET = 111;
  CLIENT_COMMAND_MIDI_MESSAGE = 112;

  CLIENT_COMMAND_PLAYSOUND = 201;
  CLIENT_COMMAND_PAUSESOUND = 202;
  CLIENT_COMMAND_RESUMESOUND = 203;
  CLIENT_COMMAND_STOPSOUND = 204;

  CLIENT_COMMAND_SETDIAGRAM = 301;
  CLIENT_COMMAND_ADDVISUAL = 302;
  CLIENT_COMMAND_REMOVEVISUAL = 303;
  CLIENT_COMMAND_CONFIGVISUAL = 304;
  CLIENT_COMMAND_EXPORTVISUAL = 305;
  CLIENT_COMMAND_SETSCENE = 306;
  CLIENT_COMMAND_CLEARSCENE = 307;
  CLIENT_COMMAND_CLEARDIAGRAM = 308;
  CLIENT_COMMAND_QUERYVISOBJ = 309;
  CLIENT_COMMAND_ENUMVISOBJ = 310;

type
  TMsgBoxInfo = class
    Text: string;
    Icon: string;
    Buttons: TArray<string>;
    DefButton,
    CancelButton,
    Result: Integer;
    function DisplayCaption(Index: Integer): string;
    function DisplayCaptions: TArray<string>;
  end;

  TInputBoxInfo = class
    Caption: string;
    DefVal: string;
    OutText: string;
    Canceled: Boolean;
  end;

  TFileDialogKind = (fdkOpen, fdkSave);

  TFileDialogInfo = class
    DialogKind: TFileDialogKind;
    FileName: string;
    Filters: TArray<string>;
    Files: TArray<string>;
    MultiSel: Boolean;
    DefaultExt: string;
    Canceled: Boolean;
  end;

type
  TExecutionContextRef = record
  strict private
    FContext: TExecutionContext;
    function GetFormatOptions: TFormatOptions;
    procedure SetFormatOptions(const AOptions: TFormatOptions);
  public

    constructor Create(AContext: TExecutionContext);

    property FormatOptions: TFormatOptions read GetFormatOptions write SetFormatOptions;

    function TryGetVariable(const AName: string;
      out AVariable: TAlgosimVariable): Boolean; inline;

    procedure GetValue(const AName: string;
      out AValue: TAlgosimObject); overload; inline;
    procedure GetValue(const ALValueData: TLValueData;
      out AValue: TAlgosimObject); overload; inline;

    procedure GetObjRef(const AName: string;
      out AValue: TAlgosimObject); overload; inline;
    function GetObjRef(const ALValueData: TLValueData;
      out AValue: TAlgosimObject): TStoreStackRes; overload; inline;

    procedure SaveVariable(const AName: string;
      AValue: TAlgosimObject); overload; inline;
    procedure SaveVariable(const ALValueData: TLValueData;
      AValue: TAlgosimObject); overload; inline;

    function TryRemoveVariable(const AName: string): Boolean; inline;

    procedure LoadDefVars; inline;

    function Perform(ACommand: Cardinal;
      AParam1: NativeInt = 0;
      AParam2: NativeInt = 0;
      AParam3: NativeInt = 0;
      AParam4: NativeInt = 0): Boolean; inline;

    function GetLastError: TAlgosimObject;

    function GetPropVal(const AKey: string): TAlgosimObject;

    function GetVariableList: TArray<string>; inline;
    function GetFunctionList: TArray<string>; inline;
    function GetOperatorList: TAlgosimArray;

    function StartTime: TDateTime; inline;
    function SessionID: TGUID; inline;

    procedure BufferAppend(const ABufferName, AText: string); inline;
    procedure ClearBuffer(const ABufferName: string); inline;
    procedure RemoveBuffer(const ABufferName: string); inline;
    function GetBufferText(const ABufferName: string): string; inline;
    function GetBuffers: TArray<string>; inline;
    procedure ClearAllBuffers; inline;

    function HistLength: Integer; inline;
    function HistItem(AIndex: Integer): TASKernel.TCmdHistoryItem; // caller gains ownership of returned object
    function HistItemNoObj(AIndex: Integer): TASKernel.TCmdHistoryItem;
    procedure ClearHistory;
    procedure ClearHistoryRes(AIndex: Integer);
    procedure SaveHistory(AState: Boolean);

    function AbortCurrent: Boolean; inline;
    function AbortCurrentEvent: TEvent;

    function EnterPause: Boolean; inline;
    function EnterPauseEvent: TEvent; inline;
    function ResumeEvent: TEvent;

    procedure NotifyPause; inline;
    procedure NotifyResume; inline;

    procedure Validate; inline;

    procedure EnterFcn; inline;
    procedure LeaveFcn; inline;
    function RecursionDepth: Integer;

  end;

  TExecutionContextRefObject = class
    Context: TExecutionContextRef;
    constructor Create(ARef: TExecutionContextRef);
  end;

implementation

uses
  Windows, ASPropStores, ASFcnMgr, ASStructs, ASTokenizer, Math;

{ TExecutionContextRef }

function TExecutionContextRef.AbortCurrent: Boolean;
begin
  Result := FContext.AbortCurrent;
end;

function TExecutionContextRef.AbortCurrentEvent: TEvent;
begin
  Result := FContext.AbortCurrentEvent;
  if Result = nil then
    raise ERuntimeException.Create('No termination event object.');
end;

procedure TExecutionContextRef.BufferAppend(const ABufferName, AText: string);
begin
  FContext.Kernel.BufferAppend(ABufferName, AText);
end;

procedure TExecutionContextRef.ClearAllBuffers;
begin
  FContext.Kernel.ClearAllBuffers;
end;

procedure TExecutionContextRef.ClearBuffer(const ABufferName: string);
begin
  FContext.Kernel.ClearBuffer(ABufferName);
end;

procedure TExecutionContextRef.ClearHistory;
begin
  FContext.Kernel.ClearCommandHistory;
end;

procedure TExecutionContextRef.ClearHistoryRes(AIndex: Integer);
begin

  if not InRange(Abs(AIndex), 1, HistLength) then
    raise EKernelException.CreateFmt(SIndexOutOfBounds, [AIndex]);

  if AIndex < 0 then
    AIndex := HistLength + AIndex + 1;

  FreeAndNil(FContext.Kernel.CommandHistory[AIndex - 1].Result);

end;

constructor TExecutionContextRef.Create(AContext: TExecutionContext);
begin
  FContext := AContext;
end;

procedure TExecutionContextRef.EnterFcn;
begin
  FContext.EnterFcn;
end;

function TExecutionContextRef.EnterPause: Boolean;
begin
  Result := FContext.EnterPause;
end;

function TExecutionContextRef.EnterPauseEvent: TEvent;
begin
  Result := FContext.EnterPauseEvent;
end;

function TExecutionContextRef.GetBuffers: TArray<string>;
begin
  Result := FContext.Kernel.GetBuffers;
end;

function TExecutionContextRef.GetBufferText(const ABufferName: string): string;
begin
  Result := FContext.Kernel.GetBufferText(ABufferName);
end;

function TExecutionContextRef.GetFormatOptions: TFormatOptions;
begin
  Result := FContext.FormatOptions;
end;

function TExecutionContextRef.GetFunctionList: TArray<string>;
begin
  Result := TFunctionMgr.FcnNames;
end;

function TExecutionContextRef.GetLastError: TAlgosimObject;
begin
  Result := FContext._LastError;
  if Result = nil then
    Result := ASO(null);
end;

function TExecutionContextRef.GetPropVal(const AKey: string): TAlgosimObject;
begin

  if TThread.Current.ThreadID <> MainThreadID then
    Exit(TAlgosimObject(SendMessage(FContext.Kernel.CallbackWindow, TASKernel.WM_EXECPROP,
      WPARAM(FContext.Kernel), LPARAM(PChar(AKey)))));

  Result := FContext.PropertyStore.GetValue(AKey);

end;

function TExecutionContextRef.Perform(ACommand: Cardinal; AParam1, AParam2,
  AParam3, AParam4: NativeInt): Boolean;
begin
  Result := FContext.Kernel.Perform(ACommand, AParam1, AParam2, AParam3, AParam4)
end;

function TExecutionContextRef.RecursionDepth: Integer;
begin
  Result := FContext.RecursionDepth;
end;

procedure TExecutionContextRef.RemoveBuffer(const ABufferName: string);
begin
  FContext.Kernel.RemoveBuffer(ABufferName);
end;

function TExecutionContextRef.ResumeEvent: TEvent;
begin
  Result := FContext.ResumeEvent;
  if Result = nil then
    raise ERuntimeException.Create('No resume from pause event object.');
end;

function TExecutionContextRef.TryRemoveVariable(const AName: string): Boolean;
begin
  Result := Assigned(FContext.StoreStack.TryRemoveVariable(AName));
end;

procedure TExecutionContextRef.Validate;
begin
  if FContext = nil then
    raise EExpressionException.Create('No context defined.');
end;

procedure TExecutionContextRef.SaveVariable(const AName: string;
  AValue: TAlgosimObject);
begin
  FContext.StoreStack.SetVariable(AName, AValue);
end;

procedure TExecutionContextRef.SaveHistory(AState: Boolean);
begin
  FContext.Kernel.SaveHistResults := AState;
end;

procedure TExecutionContextRef.SaveVariable(const ALValueData: TLValueData;
  AValue: TAlgosimObject);
begin
  FContext.StoreStack.SetVariable(ALValueData, AValue);
end;

function TExecutionContextRef.SessionID: TGUID;
begin
  Result := FContext.Kernel.SessionID;
end;

procedure TExecutionContextRef.SetFormatOptions(const AOptions: TFormatOptions);
begin
  FContext.FormatOptions := AOptions;
end;

function TExecutionContextRef.StartTime: TDateTime;
begin
  Result := FContext.Kernel.StartTime;
end;

procedure TExecutionContextRef.GetObjRef(const AName: string;
  out AValue: TAlgosimObject);
begin
  FContext.StoreStack.GetObjRef(AName, AValue);
end;

procedure TExecutionContextRef.GetValue(const AName: string;
  out AValue: TAlgosimObject);
begin
  FContext.StoreStack.GetValue(AName, AValue);
end;

function TExecutionContextRef.GetObjRef(const ALValueData: TLValueData;
  out AValue: TAlgosimObject): TStoreStackRes;
begin
  Result := FContext.StoreStack.GetObjRef(ALValueData, AValue);
end;

function TExecutionContextRef.GetOperatorList: TAlgosimArray;
var
  op: TOperator;
begin
  Result := TAlgosimArray.Create;
  try
    Result.Capacity := Ord(High(TOperator)) - Ord(Low(TOperator)) + 1;
    for op := Low(TOperator) to High(TOperator) do
      try
        Result.Add(
          ASOOpData(
            Op.Symbol,
            Op.Kind.ToString,
            Op.Precedence.Precedence,
            Op.Precedence.Associativity.ToString,
            Op.&Function,
            Op.ListLeft,
            Op.ListRight,
            Op.Collapse
          )
        );
      except
        on ESyntaxException do
          Continue // Can be removed when all operators are completely defined
      end;
  except
    Result.Free;
    raise;
  end;
end;

procedure TExecutionContextRef.GetValue(const ALValueData: TLValueData;
  out AValue: TAlgosimObject);
begin
  FContext.StoreStack.GetValue(ALValueData, AValue);
end;

function TExecutionContextRef.GetVariableList: TArray<string>;
begin
  Result := FContext.StoreStack.GetVariableList;
end;

function TExecutionContextRef.HistItem(
  AIndex: Integer): TASKernel.TCmdHistoryItem;
var
  item: TASKernel.TCmdHistoryItem;
begin
  if not InRange(Abs(AIndex), 1, HistLength) then
    raise EKernelException.CreateFmt(SIndexOutOfBounds, [AIndex]);
  if AIndex < 0 then
    AIndex := HistLength + AIndex + 1;
  Dec(AIndex);
  item := FContext.Kernel.CommandHistory[AIndex];
  Result := TASKernel.TCmdHistoryItem.Create(item.StartTime, item.Cmd);
  try
    Result.EvalTime := item.EvalTime;
    if Assigned(item.Result) then
      Result.Result := item.Result.Clone;
  except
    Result.Free;
    raise;
  end;
end;

function TExecutionContextRef.HistItemNoObj(
  AIndex: Integer): TASKernel.TCmdHistoryItem;
var
  item: TASKernel.TCmdHistoryItem;
begin
  if not InRange(Abs(AIndex), 1, HistLength) then
    raise EKernelException.CreateFmt(SIndexOutOfBounds, [AIndex]);
  if AIndex < 0 then
    AIndex := HistLength + AIndex + 1;
  Dec(AIndex);
  item := FContext.Kernel.CommandHistory[AIndex];
  Result := TASKernel.TCmdHistoryItem.Create(item.StartTime, item.Cmd);
  try
    Result.EvalTime := item.EvalTime;
  except
    Result.Free;
    raise;
  end;
end;

function TExecutionContextRef.HistLength: Integer;
begin
  Result := FContext.Kernel.CommandHistoryLength;
end;

procedure TExecutionContextRef.LeaveFcn;
begin
  FContext.LeaveFcn;
end;

procedure TExecutionContextRef.LoadDefVars;
begin
  FContext.Kernel.LoadDefVars;
end;

procedure TExecutionContextRef.NotifyPause;
begin
  FContext.NotifyPause;
end;

procedure TExecutionContextRef.NotifyResume;
begin
  FContext.NotifyResume;
end;

function TExecutionContextRef.TryGetVariable(const AName: string;
  out AVariable: TAlgosimVariable): Boolean;
begin
  Result := Assigned(FContext.StoreStack.TryGetVariable(AName, AVariable));
end;

{ TMsgBoxInfo }

function TMsgBoxInfo.DisplayCaption(Index: Integer): string;
var
  i: Integer;
begin
  if not InRange(Index, 0, High(Buttons)) then
    Exit('');
  Result := Buttons[Index];
  i := Result.Length;
  while i >= 1 do
  begin
    if Result[i] = '&' then
    begin
      Delete(Result, i, 1);
      if (i > 1) and (Result[i - 1] = '&') then
        Dec(i);
    end;
    Dec(i);
  end;
end;

function TMsgBoxInfo.DisplayCaptions: TArray<string>;
var
  i: Integer;
begin
  SetLength(Result, Length(Buttons));
  for i := 0 to High(Buttons) do
    Result[i] := DisplayCaption(i);
end;

{ TExecutionContextRefObject }

constructor TExecutionContextRefObject.Create(ARef: TExecutionContextRef);
begin
  Context := ARef;
end;

end.