Embeded Lisp in Delphi

[HPW]

Als Nachtrag hier noch ein Beispiel wie man callbacks aus Lisp realisieren kann:

Delphi-Quellcode:

unit Unit1; 

interface 

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

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; 

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; 

procedure registerAndCall1(txtparam : String); 
var 
  newlispstr: string; 
begin 
  // I'm using Lutz code to link Pascal 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)); 

  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 Pascal 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)); 

  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 Pascal 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)); 

  newlispstr := '(foo2 nil "'+ txtparam1 + ' is the String from the edit-field" "Param2:'+ txtparam2 + '" "Param3:'+ txtparam3 + '")'; 
  newLispEvalStr(pchar(newlispstr)); 
end; 

procedure TForm1.Button1Click(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; 

end.