[Lazarus] PascalScript and Self instance

[silvioprog]

2013/9/16 silvioprog <silvioprog at gmail.com>

> 2013/9/16 Martin <lazarus at mfriebe.de>
>
>>  Ok, found the answer in the lpr.
>>
>> I would not expect that to work, after all you cant do it in normal
>> pascal either?
>>
>> the main begin end is a program does not belong to a class.
>>
>
> Writeln was only by way of illustration, it could be anything else. :)
>
> Problem solved with:
>
> program project1;
>
> {$mode objfpc}{$H+}
>
> uses
>   uPSComponent, myclass, uPSI_myclass;
>
> type
>   TApp = class
>   private
>     Fobj: TMyClass;
>     Fps: TPSScript;
>   public
>     constructor Create;
>     destructor Destroy; override;
>     procedure OnCompile(Sender: TPSScript);
>     procedure OnExecute(Sender: TPSScript);
>     property ps: TPSScript read Fps;
>     property obj: TMyClass read Fobj write Fobj;
>   end;
>
>   constructor TApp.Create;
>   begin
>     Fps := TPSScript.Create(nil);
>     Fps.OnCompile := @OnCompile;
>     Fps.OnExecute := @OnExecute;
>   end;
>
>   destructor TApp.Destroy;
>   begin
>     Fps.Free;
>     inherited Destroy;
>   end;
>
>   procedure TApp.OnCompile(Sender: TPSScript);
>   begin
>     Sender.AddRegisteredVariable('Self', 'TMyClass');
>   end;
>
>   procedure TApp.OnExecute(Sender: TPSScript);
>   begin
>     Sender.SetVarToInstance('SELF', Fobj);
>   end;
>
> var
>   app: TApp;
>   i: integer;
>   obj: TMyClass;
>   pl: TPSImport_myclass;
> begin
>   app := TApp.Create;
>   pl := TPSImport_myclass.Create(nil);
>   obj := TMyClass.Create;
>   try
>     app.obj := obj;
>     TPSPluginItem(app.ps.Plugins.Add).Plugin := pl;
>     app.ps.Script.Text := 'begin Self.WriteLn(''OK''); end.';
>     if app.ps.Compile then
>       app.ps.Execute;
>     WriteLn(obj.Data);
>     WriteLn('--');
>     for i := 0 to Pred(app.ps.Comp.MsgCount) do
>       WriteLn(app.ps.Comp.Msg[I].MessageToString);
>   finally
>     obj.Free;
>     pl.Free;
>     app.ps.Free;
>   end;
>   ReadLn;
> end.
>
> Thank you very much! (y)
>

Or:

program project1;

{$mode objfpc}{$H+}

uses
  uPSCompiler, uPSRuntime, uPSC_std, uPSR_std, myclass, uPSI_myclass;

  function ScriptOnUses(Sender: TPSPascalCompiler; const Name: string):
boolean;
  begin
    if Name = 'SYSTEM' then
    begin
      SIRegister_Std(Sender);
      SIRegister_myclass(Sender);
      AddImportedClassVariable(Sender, 'Self', 'TMyClass');
      Result := True;
    end
    else
      Result := False;
  end;

  procedure ExecuteScript(const Script: string);
  var
    Compiler: TPSPascalCompiler;
    Exec: TPSExec;
    Data: string;
    CI: TPSRuntimeClassImporter;
    obj: TMyClass;
  begin
    Compiler := TPSPascalCompiler.Create;
    Compiler.OnUses := @ScriptOnUses;
    if not Compiler.Compile(Script) then
    begin
      Compiler.Free;
      Exit;
    end;
    Compiler.GetOutput(Data);
    Compiler.Free;
    CI := TPSRuntimeClassImporter.Create;
    RIRegister_Std(CI);
    RIRegister_myclass(CI);
    Exec := TPSExec.Create;
    RegisterClassLibraryRuntime(Exec, CI);
    if not Exec.LoadData(Data) then
    begin
      Exec.Free;
      Exit;
    end;
    obj := TMyClass.Create;
    SetVariantToClass(Exec.GetVarNo(Exec.GetVar('SELF')), obj);
    Exec.RunScript;
    WriteLn(obj.Data);
    Exec.Free;
    obj.Free;
    CI.Free;
  end;

begin
  ExecuteScript('begin Self.WriteLn(''OK'') end.');
  ReadLn;
end.

-- 
Silvio Clécio
My public projects - github.com/silvioprog
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20130916/55b74223/attachment-0003.html>