FastScript

program Project8;

{$APPTYPE CONSOLE}

uses
  SysUtils, Variants, fs_ipascal, fs_iinterpreter;

type
  TScriptTest = class
  protected
    FScript:TfsScript;
  public
    function ScriptCallMethod(Instance: TObject; ClassType: TClass; const MethodName: String;
      Caller: TfsMethodHelper): Variant;
   function TestEvaluate(const sLine: string): Currency;
   procedure TestExec;
   procedure AddConst(const s:string; crVal:Currency);
   constructor Create;
   destructor Destroy; override;


  end;

procedure TScriptTest.AddConst(const s: string; crVal: Currency);
begin
  FScript.AddConst(s, 'Extended', crVal);
end;

constructor TScriptTest.Create;
begin
  fScript := TfsScript.Create(nil);
  fScript.SyntaxType := 'PascalScript';
end;

destructor TScriptTest.Destroy;
begin
  FreeAndNiL(FScript);
  inherited;
end;

function TScriptTest.ScriptCallMethod(Instance: TObject; ClassType: TClass; const MethodName: String;
  Caller: TfsMethodHelper): Variant;
begin
  if MethodName = 'SQR' then
    Result := Sqr(Caller.Params[0])
  else
    Result := NULL;
end;

function TScriptTest.TestEvaluate(const sLine: string): Currency;

var
  v: Variant;
begin
  FScript.Clear;
  fScript.Parent := fsGlobalUnit; // !!
  fScript.AddMethod('function Sqr(e: Extended): Extended', ScriptCallMethod );
  AddConst('ourwidth', 34);
  AddConst('ourheight', 100);
  v := FScript.Evaluate(sLine);
  if VarIsNull(v) then
    Result := 0
  else
    Result := v;
end;

procedure TScriptTest.TestExec;
var
  v: Variant;
begin
  FScript.Clear;
  fScript.Parent := fsGlobalUnit; // !!
  AddConst('ourwidth', 34);
  FScript.Lines.Text := ' function TestCount(i:Integer):Double; ' +
     'begin '+
     ' Result :=  i * ourWidth;'+
     ' ShowMessage(IntToStr(i))'+
     ' end;' +
     ' begin end. ';
  if not FScript.Compile then
  begin
    writeln(FScript.ErrorMsg);
    Exit;
  end;
  v := FScript.CallFunction('TestCount', VarArrayOf([19]));
  writeln(FloatToStr(v));
end;

var
  oTest: TScriptTest;
begin
  try
    oTest :=  TScriptTest.Create;
    try
      writeln(oTest.TestEvaluate('ourheight *10 + sqr(ourwidth)'));
      oTest.TestExec;
    finally
      otest.Free;
    end;
    readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.