How to setup a callback function?

[m35]

Code Select Expand


type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1  : TEdit;
    Button3: TButton;
    Edit2: TEdit;
    Button4: TButton;
    Edit3: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    // This is the procedure that I call from newLisp.
    procedure xRefresh1(param1 : PChar); stdcall;
    procedure xRefresh2(param1,param2 : PChar); stdcall;
    procedure xRefresh3(param1,param2,param3 : PChar); stdcall;
  end;


Maybe I'm reading your code wrong, but are you saying that newLISP is calling class instance method (TForm1.xRefresh1)?

[HPW]

You are correct. We pass the address-pointer to newlisp and newlisp call it and the params are set.

The only unclear thing is, why we need the first nil to offset the parameters by 1. Anyway, it works! ;-)

[m35]

When you call a C++ instance method, it secretly passes the pointer to the class instance as the first argument.

Code Select Expand

class cls {
@public:
   // like declaring static void callme(cls *this, int i);
   void callme(int i);
};

int main()
{
   cls c;
   c.callme(10); // actually becomes callme(&c, 10);
}

I may have some of the details wrong, but that's basically what happens.

I can only assume Pascal does the same.

[ale870]

@m35 that's a very good explanation!

Do you think that if we create a procedure and not a "method" the parameter "null" could be eliminated?

[HPW]

Added example using a function-call with a return-string.

Code Select Expand


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button2: TButton;
    Edit1  : TEdit;
    Button3: TButton;
    Edit2: TEdit;
    Button4: TButton;
    Edit3: TEdit;
    Button5: TButton;
    Edit4: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    // This is the procedure that I call from newLisp.
    procedure xRefresh1(param1 : PChar); stdcall;
    procedure xRefresh2(param1,param2 : PChar); stdcall;
    procedure xRefresh3(param1,param2,param3 : PChar); stdcall;
    function  xRefresh4( param1 : PChar; retValue : PChar ): BOOLEAN; stdcall;
  end;

var
  Form1: TForm1;
  DllNewLisp      : THandle;
  newLispEvalStr  : function(argExpression: pchar): pchar; stdcall;

implementation

{$R *.DFM}

procedure openNewLispLibrary;
begin
  DllNewLisp := LoadLibrary('newlisp.dll');
  if (DllNewLisp < HINSTANCE_ERROR) then
    raise Exception.Create('newlisp.dll' + ' library can not be loaded or not found. ' + SysErrorMessage(GetLastError));
  try
    { load an address of required procedure}
    @newLispEvalStr := GetProcAddress(DllNewLisp, 'newlispEvalStr');
  finally
    {unload a library}
  end;
end;

procedure TForm1.xRefresh1(param1 : PChar); stdcall;
begin
  showmessage(param1);
  showmessage(IntToStr(Strlen(param1)));
end;

procedure TForm1.xRefresh2(param1, param2 : PChar); stdcall;
begin
  showmessage(param1+' / '+param2);
  showmessage(IntToStr(Strlen(param1))+' / '+IntToStr(Strlen(param2)));
end;

procedure TForm1.xRefresh3(param1, param2, param3 : PChar); stdcall;
begin
  showmessage(param1+' / '+param2+' / '+param3);
  showmessage(IntToStr(Strlen(param1))+' / '+IntToStr(Strlen(param2))+' / '+IntToStr(Strlen(param3)));
end;

FUNCTION TForm1.xRefresh4( param1 : PChar; retValue : PChar ): BOOLEAN; stdcall;
VAR      Varstr     : PChar;
begin
    showmessage(param1);
    Varstr := 'TestReturnString';
    StrCopy ( retValue, Varstr);
    Result := True;
end;

procedure registerAndCall1(txtparam : String);
var
  newlispstr: string;
begin
  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //
  newlispstr := '(set ''foo print)' +
                '(cpymem (pack "ld" 265) (first (dump foo)) 4)' +
                '(cpymem (pack "ld" ' +
                IntToStr(integer(@TForm1.xRefresh1)) + ') (+ (first (dump foo)) 12) 4)' +
                '(cpymem (pack "ld" "foo") (+ (first (dump foo)) 8)  4)';
  newLispEvalStr(pchar(newlispstr));

  // I do not know why this work for me.
  newlispstr := '(foo nil "'+ txtparam + ' is the String from the edit-field")';
  newLispEvalStr(pchar(newlispstr));
end;

procedure registerAndCall2(txtparam1, txtparam2 : String);
var
  newlispstr: string;
begin
  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //
  newlispstr := '(set ''foo1 print)' +
                '(cpymem (pack "ld" 265) (first (dump foo1)) 4)' +
                '(cpymem (pack "ld" ' +
                IntToStr(integer(@TForm1.xRefresh2)) + ') (+ (first (dump foo1)) 12) 4)' +
                '(cpymem (pack "ld" "foo1") (+ (first (dump foo1)) 8)  4)';
  newLispEvalStr(pchar(newlispstr));

  // I do not know why this work for me.
  newlispstr := '(foo1 nil "'+ txtparam1 + ' is the String from the edit-field" "Test2:'+ txtparam2 + '")';
  newLispEvalStr(pchar(newlispstr));
end;

procedure registerAndCall3(txtparam1, txtparam2, txtparam3 : String);
var
  newlispstr: string;
begin
  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //
  newlispstr := '(set ''foo2 print)' +
                '(cpymem (pack "ld" 265) (first (dump foo2)) 4)' +
                '(cpymem (pack "ld" ' +
                IntToStr(integer(@TForm1.xRefresh3)) + ') (+ (first (dump foo2)) 12) 4)' +
                '(cpymem (pack "ld" "foo2") (+ (first (dump foo2)) 8)  4)';
  newLispEvalStr(pchar(newlispstr));

  // I do not know why this work for me.
  newlispstr := '(foo2 nil "'+ txtparam1 + ' is the String from the edit-field" "Param2 :'+ txtparam2 + '" "Param3: '+ txtparam3 + '")';
  newLispEvalStr(pchar(newlispstr));
end;

procedure registerAndCall4(txtparam : String);
var
  newlispstr: string;
  retstr: string;
begin
  //
  // I'm using Lutz code to link FreePascal function to be used in newLisp.
  //
  newlispstr := '(set ''foo4 print)' +
                '(cpymem (pack "ld" 265) (first (dump foo4)) 4)' +
                '(cpymem (pack "ld" ' +
                IntToStr(integer(@TForm1.xRefresh4)) + ') (+ (first (dump foo4)) 12) 4)' +
                '(cpymem (pack "ld" "foo4") (+ (first (dump foo4)) 8)  4)';
  newLispEvalStr(pchar(newlispstr));

  // 16 is the length of the string which gets set in the callbackfunction. newLISP allocates the memory first.
  newlispstr := '(setq retvalue(dup " " (+ 16 1)))(foo4 nil "'+ txtparam + '" retvalue)';
  newLispEvalStr(pchar(newlispstr));
  newlispstr := '(get-string retvalue)';
  retstr := newLispEvalStr(pchar(newlispstr));
  showmessage(PChar('RetStr from Lisp: ' + retstr));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   openNewLispLibrary;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  registerAndCall1(Edit1.Text);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  registerAndCall2(Edit1.Text, Edit2.Text);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  registerAndCall3(Edit1.Text, Edit2.Text, Edit3.Text);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  registerAndCall4(Edit4.Text);
end;

end.


[HPW]

An optional lisp-call as a one-liner without double quotes:

Code Select Expand


 newlispstr := '(silent(setq retvalue(dup " " (+ 16 1))))(foo4 nil "'+ txtparam + '" retvalue)(print(get-string retvalue))';
  retstr := newLispEvalStr(pchar(newlispstr));