Convert member function pointer to function pointer in FreePascal - function-pointers

Question

I want to pass to a GLUT function (glutKeyboardFunc) a pointer to a member function (TDisplayer.GlKeyboard). GLUT callback just accept function pointer. Is there a way to "pack" self pointer into the function ?
unit UDisplayer;
{$mode objfpc}
interface
type
TDisplayer = class(TObject)
public
constructor Create(x, y : Integer; caption : AnsiString);
destructor Destroy; override;
procedure GlKeyboard(key : Byte; x, y : Longint); cdecl;
private
winX : Integer;
winY : Integer;
end;
implementation
uses gl, glut, glext, UTools;
constructor TDisplayer.Create(x, y : Integer; caption : AnsiString);
var
cmd : array of PChar;
cmdCount : Integer;
keyboardCallback : pointer;
begin
winX := x;
winY := y;
cmdCount := 1;
SetLength(cmd, cmdCount);
cmd[0] := PChar(ParamStr(0));
glutInit(#cmdCount, #cmd);
glutInitDisplayMode(GLUT_DOUBLE or GLUT_RGB or GLUT_DEPTH);
glutInitWindowSize(x, y);
glutCreateWindow(PChar(caption));
glClearColor(0.0, 0.0, 0.0, 0);
//glutKeyBoardFunc(#self.glKeyBoard); <--- HERE
glutMainLoop;
end;
destructor TDisplayer.Destroy;
begin
inherited;
end;
procedure TDisplayer.GlKeyboard(key : Byte; x, y : Longint); cdecl;
begin
end;
end.

Answer 1

No. A method pointer is two pointers large, and a simple function pointer only one, so it simply won't fit.
If the callback system provides some "context" you can sometimes pass the instance into the context, and make a somewhat more general thunk like
function callme(context:pointer;x,y:integer);integer; cdecl;
begin
TTheClass(context).callme(x,y);
end;
Then pass "Self" as context when registering the callback. But it doesn't look like this callback setter has a context that is passed back to the callback when it is called.

Answer 2

In a first time, declare the callback as a global procedure.
It'll be a context-independent method, not relying on Self
type TDisplayer = class(TObject)
public
constructor Create(x, y : Integer; caption : AnsiString);
destructor Destroy; override;
private
winX : Integer;
winY : Integer;
end;
procedure GlKeyboard(key : Byte; x, y : Longint); cdecl;
Then since glutCreateWindow() returns an unique context, you can use it to associate it to your class instance. So you define an associative array wich allows to retrieve a TDisplayer instance using a GLUT window as Key:
type TCtxtArr = specialize TFPGMap<Integer,TForm>;
You add one as a global var which will be created and freed in the initialization and the finalization sections:
var
ctxtarray: TCtxtArr;
initialization
ctxtarray:= TCtxtArr.create;
finalization
ctxtarray.free;
end.
Then in TDisplayer.Create() you add an entry to the AA:
// id is a local integer.
id = glutCreateWindow(PChar(caption));
ctxtarray.Add(id, Self);
// assign the callback here or elsewhere
glutKeyBoardFunc(#glKeyBoard);
When your callback is called, you can retrieve the TDisplayer instance, so that you can access to its variables and methods:
procedure GlKeyboard(key : Byte; x, y : Longint); cdecl;
var
disp: TDisplayer;
id: integer;
begin
glutGetWindow(id);
disp := ctxtarray[id];
end;
Unfortunately, i cant test the answer as it seems to be part of a bigger program. However this sample works in an analog way:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, dialogs, fgl;
type
TForm1 = class;
TProc = procedure(x,y: integer);
TCtxtArr = specialize TFPGMap<Integer,TForm1>;
TForm1 = class(TForm)
constructor Create(TheOwner: TComponent); override;
procedure hello;
end;
procedure callback(x,y: integer);
var
Form1: TForm1; Proc: TProc;
ctxtarray: TCtxtArr;
implementation
{$R *.lfm}
constructor TForm1.Create(TheOwner: TComponent);
begin
inherited;
proc := #callback;
ctxtarray.Add(0,Self);
proc(0,0);
end;
procedure TForm1.hello;
begin
showmessage('hello');
end;
procedure callback(x, y: integer);
var
frm: TForm1;
begin
frm := ctxtarray.Data[0];
frm.hello;
end;
initialization
ctxtarray:= TCtxtArr.create;
finalization
ctxtarray.free;
end.
As a foot note: theorically FPC allows to define static class methods (similar to global procedures), but for some reason it seems that they cant be assigned to a global procedure pointer, at least it fails with FPC 2.6.4

Answer 3

You have to assemble some bytecode and keep wrapper with 'hardcoded' self pointer, which manages invocation stack:
procOfObj = packed record
method : pointer;
this : pointer;
end;
obj = packed object
procedure ASIOBufferSwitch(
ip: pointer; {the added IP artifact }
doubleBufferIndex: longint; directProcess: longbool); cdecl;
end;
cdeclProxy = packed object
procedure build( const src: procOfObj );
private
push : byte; push_arg: pointer;
call : byte; call_arg: pointer;
add_ret : longint;
end;
procedure cdeclProxy.build( const src: procOfObj );
begin
push := $68; push_arg := src.this;
call := $e8; call_arg := pointer( src.method - #call - 5 );
add_ret := $c304c483;
result := #push;
end;
var cdp : cdeclProxy;
o : obj;
begin
cdp.build( procOfObj( #o.ASIOBufferSwitch ))
pointer(... procedure var ...) := #cdp;
end.
Notice that provided example requires additional arg in method signature, but it allows to build wrapper without knowledge of arg count. If you do not want ip arg, you have to re-push all args again before calling actual method and then clean up stack inside wrapper.