MvRens / DelphiLua

An API conversion and wrapper classes for integrating Lua 5.2 into Delphi projects
16 stars 3 forks source link

Auto register class procedure methods #3

Closed tinyBigGAMES closed 4 years ago

tinyBigGAMES commented 4 years ago

Hi, with the new feature of being able to register a LuaCFunction to a table, I was thinking of how I can now take a class and auto register all of its class procedure LuaCFuntions. I have this so far:

  TLuaFuncs = class
  public
    class procedure test2(aContext: ILuaContext);
  end;
procedure RegisterClassFunctions(aClass: TClass; aTableName: string);
var
  FRttiContext: TRttiContext;
  rttiType: TRttiType;
  rttiMethod: TRttiMethod;
  rttiParameters: TArray<System.Rtti.TRttiParameter>;
  tbl: TLuaTable;
begin
  tbl := TLuaTable.Create;

  rttiType := FRttiContext.GetType(aClass);
  for rttiMethod in rttiType.GetMethods do
  begin
    if (rttiMethod.MethodKind <> mkClassProcedure) then continue;
    if (rttiMethod.Visibility <> mvPublic) then continue;

    rttiParameters := rttiMethod.GetParameters;

    { Check if one parameter of type ILuaContext is present }
    if (Length(rttiParameters) = 1) and
       (Assigned(rttiParameters[0].ParamType)) and
       (rttiParameters[0].ParamType.TypeKind = tkInterface) and
       (TRttiInterfaceType(rttiParameters[0].ParamType).GUID = ILuaContext) then
    begin
      WriteLn('class method: %s', [rttiMethod.Name]);

      tbl.SetValue(rttiMethod.Name, WHAT_DO_I_PUT_HERE); <<------- how to handle this

    end;
  end;

  gEngine.Table.SetValue(aTableName, tbl);

  gEngine.Lua.SetGlobalVariable(cVivaceTable, gEngine.Table);
end;

I am trying to figure out how to handle "WHAT_DO_I_PUT_HERE" section of the above code. I discovered I can do this:

tbl.SetValue('test2', TLuaImplicitVariable(TLuaFuncs.test2));

With the rtti info I have a this point, how could then register each class procedure I come across?

I tried this: tbl.SetValue(rttiMethod.Name, TLuaImplicitVariable(TLuaCFunction(rttiMethod.CodeAddress)));

But it will crash at: TLuaCFunction(rttiMethod.CodeAddress)

I'm so close, any ideas?

MvRens commented 4 years ago

There may be a way to link the two directly by building a TMethod using the CodeAddress, much like I did in my latest commit for the lua_pushcclosure call. You'll need a data address as well, and I'm not sure how that works with class methods.

There is another way though, by simply wrapping rttiMethod.Invoke in an anonymous method which is passed to the Lua class. You'll need a helper method to create that anonymous method instance, to properly capture the rttiMethod variable. Here's a modification of your procedure that seems to work:

procedure RegisterClassFunctions(aClass: TClass; aTableName: string);

  // This extra function is required because Delphi captures variables, not values,
  // so "rttiMethod" would change in the loop before it is invoked
  function GetInvokeMethod(AMethod: TRttiMethod): TLuaCFunction;
  begin
    Result :=
      procedure(Context: ILuaContext)
      begin
        AMethod.Invoke(aClass, [TValue.From(Context)]);
      end
  end;

var
  FRttiContext: TRttiContext;
  rttiType: TRttiType;
  rttiMethod: TRttiMethod;
  rttiParameters: TArray<System.Rtti.TRttiParameter>;
  tbl: ILuaTable;
begin
  tbl := TLuaTable.Create;

  rttiType := FRttiContext.GetType(aClass);
  for rttiMethod in rttiType.GetMethods do
  begin
    if (rttiMethod.MethodKind <> mkClassProcedure) then continue;
    if (rttiMethod.Visibility <> mvPublic) then continue;

    rttiParameters := rttiMethod.GetParameters;

    { Check if one parameter of type ILuaContext is present }
    if (Length(rttiParameters) = 1) and
       (Assigned(rttiParameters[0].ParamType)) and
       (rttiParameters[0].ParamType.TypeKind = tkInterface) and
       (TRttiInterfaceType(rttiParameters[0].ParamType).GUID = ILuaContext) then
    begin
      WriteLn('class method: %s', [rttiMethod.Name]);

      tbl.SetValue(rttiMethod.Name, GetInvokeMethod(rttiMethod));
    end;
  end;

  gEngine.Table.SetValue(aTableName, tbl);

  gEngine.Lua.SetGlobalVariable(cVivaceTable, gEngine.Table);
end;

Note that I also changed the variable to be of type ILuaTable. Since it is a TInterfacedObject this will prevent issues with the reference count.

Hope that helps!

tinyBigGAMES commented 4 years ago

Ahh, I see. Ok so I tried this and it get param miss match when the function is call on the lua side.

tinyBigGAMES commented 4 years ago

Ok, I think I go it. I discovered I can use your CaptureCallback method. Just set the TMethod.Data to aClass and that worked. Using this method, the class procedures can be auto registered and called successfully. They must NOT have the static keyword added, however. Otherwise seems to work. Hey man, thanks again for all your help with this.

type
  TLuaFuncs = class
  public
    class procedure test1(aContext: ILuaContext);
    class procedure test2(aContext: ILuaContext);
  end;

class procedure TLuaFuncs.test1(aContext: ILuaContext);
var
  aId: Integer;
begin
  aId := aContext.Parameters.Items[0].AsInteger;
  WriteLn('aId: %d', [aid]);
end;

class procedure TLuaFuncs.test2(aContext: ILuaContext);
var
  aMsg: string;
begin
  aMsg := aContext.Parameters.Items[0].AsString;
  WriteLn(aMsg, []);
end;
procedure RegisterClassFunctions(aClass: TClass; aTableName: string);
var
  FRttiContext: TRttiContext;
  rttiType: TRttiType;
  rttiMethod: TRttiMethod;
  rttiParameters: TArray<System.Rtti.TRttiParameter>;
  tbl: ILuaTable;
  callback: TMethod;

  { This wrapper is needed because Delphi's anonymous functions capture
    variables, not values. We need a stable 'callback' here. }
  function CaptureCallback(AMethod: TMethod): TLuaCFunction; inline;
  begin
    Result := TLuaCMethod(AMethod);
  end;

begin
  tbl := TLuaTable.Create;

  rttiType := FRttiContext.GetType(aClass);
  for rttiMethod in rttiType.GetMethods do
  begin
    if (rttiMethod.MethodKind <> mkClassProcedure) then continue;
    if (rttiMethod.Visibility <> mvPublic) then continue;

    rttiParameters := rttiMethod.GetParameters;

    { Check if one parameter of type ILuaContext is present }
    if (Length(rttiParameters) = 1) and
       (Assigned(rttiParameters[0].ParamType)) and
       (rttiParameters[0].ParamType.TypeKind = tkInterface) and
       (TRttiInterfaceType(rttiParameters[0].ParamType).GUID = ILuaContext) then
    begin
      callback.Code := rttiMethod.CodeAddress;
      callback.Data := aClass;
      tbl.SetValue(rttiMethod.Name, CaptureCallback(callback));
    end;
  end;

  // this code below just updates add this new table to my global outter table in my project
  gEngine.Table.SetValue(aTableName, tbl);
  gEngine.Lua.SetGlobalVariable(cVivaceTable, gEngine.Table);
end;
tinyBigGAMES commented 4 years ago

Here is a more generic version of it. It will register all the class procedures and return a table.

function RegisterClassFunctions(aClass: TClass): ILuaTable;
var
  FRttiContext: TRttiContext;
  rttiType: TRttiType;
  rttiMethod: TRttiMethod;
  rttiParameters: TArray<System.Rtti.TRttiParameter>;
  callback: TMethod;

  { This wrapper is needed because Delphi's anonymous functions capture
    variables, not values. We need a stable 'callback' here. }
  function CaptureCallback(AMethod: TMethod): TLuaCFunction; inline;
  begin
    Result := TLuaCMethod(AMethod);
  end;

begin
  Result := nil;

  rttiType := FRttiContext.GetType(aClass);
  for rttiMethod in rttiType.GetMethods do
  begin
    if (rttiMethod.MethodKind <> mkClassProcedure) then continue;
    if (rttiMethod.Visibility <> mvPublic) then continue;

    rttiParameters := rttiMethod.GetParameters;

    { Check if one parameter of type ILuaContext is present }
    if (Length(rttiParameters) = 1) and
       (Assigned(rttiParameters[0].ParamType)) and
       (rttiParameters[0].ParamType.TypeKind = tkInterface) and
       (TRttiInterfaceType(rttiParameters[0].ParamType).GUID = ILuaContext) then
    begin
      if Result = nil then
      begin
        Result := TLuaTable.Create;
      end;
      callback.Code := rttiMethod.CodeAddress;
      callback.Data := aClass;
      Result.SetValue(rttiMethod.Name, CaptureCallback(callback));
    end;
  end;
end;