using Delphi classes in lua :)

[paul_nicholls]

Hi all,
I have whipped up a unit that allows me to make classes in Delphi and use them in Lua 5.x if anyone is interested

Unit LuaClasses;

Interface

Uses
    SysUtils,
    Classes,
    Lua;

Type
    TLuaClass = Class
    Private
        FMethods    : TStringList;
        FLibName: AnsiString;
    Protected
        Procedure RegisterLuaMethod(AName: AnsiString);
        Function  CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer; Virtual;
    Public
        Constructor Create; Virtual;
        Destructor  Destroy; Override;

        Procedure PushOntoLuaStack(L: lua_State);
        Procedure RegisterMethodsWithLua(L: lua_State);

        Property LibName: AnsiString Read FLibName Write FLibName;
    End;

    TLuaClassClass = Class Of TLuaClass;

    TRegisteredLuaClass = Packed Record
        ClassName: AnsiString;
        ClassType: TLuaClassClass;
    End;

    TLuaClassFactory = Class(TLuaClass)
    Private
        FRegisteredClasses: Array Of TRegisteredLuaClass;

        Function  NewLuaClass(L: lua_State): Integer;
        Function  DestroyLuaClass(L: lua_State): Integer;
    Protected
        Function  CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer; Override;
    Public
        Constructor Create; Override;
        Destructor  Destroy; Override;

        Procedure RegisterLuaClass(ClassName: AnsiString; ClassType: TLuaClassClass);
        Function  LuaClassExists(ClassName: AnsiString): Boolean;
        Function  NewLuaClassByName(ClassName: AnsiString): TLuaClass;
    End;

Implementation

{.......................................................}

{.......................................................}
Function  LuaMethodRedirector(L: lua_State): Integer; CDecl;
Var
    LuaClass: TLuaClass;
    Index   : Integer;
Begin
    LuaClass := lua_touserdata    (L, lua_upvalueindex(1));
    Index    := Trunc(lua_tonumber(L, lua_upvalueindex(2)));

    Result := LuaClass.CallLuaMethod(L,Index);
End;
{.......................................................}

{.......................................................}
Constructor TLuaClass.Create;
Begin
    Inherited Create;

    FMethods  := TStringList.Create;
    FLibName := '';
End;
{.......................................................}

{.......................................................}
Destructor  TLuaClass.Destroy;
Begin
    FMethods.Free;

    Inherited Destroy;
End;
{.......................................................}

{.......................................................}
Procedure TLuaClass.RegisterLuaMethod(AName: AnsiString);
Begin
    FMethods.Add(AName);
End;
{.......................................................}

{.......................................................}
Function  TLuaClass.CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer;
Begin
    Result := 0;
End;
{.......................................................}

{.......................................................}
Procedure TLuaClass.PushOntoLuaStack(L: lua_State);
Var
    Table : Integer;
    MT    : Integer;
    i     : Integer;
Begin
    lua_newtable(L);

    Table := lua_gettop(L);

    For i := 0 To FMethods.Count - 1 Do
    Begin
        lua_pushstring   (L,PChar(FMethods.Strings[i]));
        lua_pushlightuserdata(L,Self);
        lua_pushnumber(L,i);
        lua_pushcclosure(L,LuaMethodRedirector,2);

        lua_settable(L,Table);
    End;

    //  create a meta table containing the object pointer
    lua_newtable(L);

    MT := lua_gettop(L);

    lua_pushstring(L,'Self');
    lua_pushlightuserdata(L,Self);
    lua_settable(L,MT);

    lua_setmetatable(L,Table);
End;
{.......................................................}

{.......................................................}
Procedure TLuaClass.RegisterMethodsWithLua(L: lua_State);
Var
    i     : Integer;
    Table : Integer;
Begin
    Table := LUA_GLOBALSINDEX;

    If &#40;FLibName <> ''&#41; Then
    Begin
        lua_newtable&#40;L&#41;;

        Table &#58;= lua_gettop&#40;L&#41;;
    End;

    For i &#58;= 0 To FMethods.Count - 1 Do
    Begin
        lua_pushstring       &#40;L,PChar&#40;FMethods.Strings&#91;i&#93;&#41;&#41;;
        lua_pushlightuserdata&#40;L,Self&#41;;
        lua_pushnumber       &#40;L,i&#41;;
        lua_pushcclosure     &#40;L,LuaMethodRedirector,2&#41;;

        lua_settable&#40;L, Table&#41;;
    End;

    If &#40;FLibName <> ''&#41; Then
        lua_setglobal&#40;L,PChar&#40;FLibName&#41;&#41;;
End;
&#123;.......................................................&#125;

&#123;.......................................................&#125;
Constructor TLuaClassFactory.Create;
Begin
    Inherited Create;

    RegisterLuaMethod&#40;'NewLuaClass'&#41;;
    RegisterLuaMethod&#40;'DestroyLuaClass'&#41;;

    SetLength&#40;FRegisteredClasses,0&#41;;
End;
&#123;.......................................................&#125;

&#123;.......................................................&#125;
Destructor  TLuaClassFactory.Destroy;
Begin
    SetLength&#40;FRegisteredClasses,0&#41;;

    Inherited Destroy;
End;
&#123;.......................................................&#125;

&#123;.......................................................&#125;
Function  TLuaClassFactory.CallLuaMethod&#40;L&#58; lua_State; MethodIndex&#58; Integer&#41;&#58; Integer;
Begin
    Case MethodIndex Of
        0 &#58; Result &#58;= NewLuaClass&#40;L&#41;;
        1 &#58; Result &#58;= DestroyLuaClass&#40;L&#41;;
    Else
        lua_pushstring&#40;L,PChar&#40;Format&#40;
            'TLuaClassFactory.CallLuaMethod&#58; MethodIndex "%d" out of bounds',
            &#91;MethodIndex&#93;&#41;&#41;&#41;;
        lua_error&#40;L&#41;;
    End;
End;
&#123;.......................................................&#125;

&#123;.......................................................&#125;
Procedure TLuaClassFactory.RegisterLuaClass&#40;ClassName&#58; AnsiString; ClassType&#58; TLuaClassClass&#41;;
Var
    LuaClass&#58; TLuaClass;
Begin
    If &#40;ClassName = ''&#41; Then
        Exit;

    If &#40;LuaClassExists&#40;ClassName&#41;&#41; Then
        Raise Exception.Create&#40;'TLuaClassFactory.RegisterLuaClass&#58; LuaClass "'+ClassName+'" is already registered'&#41;;

    SetLength&#40;FRegisteredClasses,Length&#40;FRegisteredClasses&#41; + 1&#41;;
    FRegisteredClasses&#91;High&#40;FRegisteredClasses&#41;&#93;.ClassName &#58;= ClassName;
    FRegisteredClasses&#91;High&#40;FRegisteredClasses&#41;&#93;.ClassType &#58;= ClassType;
End;
&#123;.......................................................&#125;

&#123;.......................................................&#125;
Function  TLuaClassFactory.LuaClassExists&#40;ClassName&#58; AnsiString&#41;&#58; Boolean;
Var
    i&#58; Integer;
Begin
    Result &#58;= False;

    For i &#58;= 0 To High&#40;FRegisteredClasses&#41; Do
    Begin
        If &#40;ClassName = FRegisteredClasses&#91;i&#93;.ClassName&#41; Then
        Begin
            Result &#58;= True;
            Break;
        End;
    End;
End;
&#123;.......................................................&#125;

&#123;.......................................................&#125;
Function  TLuaClassFactory.NewLuaClassByName&#40;ClassName&#58; AnsiString&#41;&#58; TLuaClass;
Var
    i&#58; Integer;
Begin
    Result &#58;= Nil;

    For i &#58;= 0 To High&#40;FRegisteredClasses&#41; Do
    Begin
        If &#40;ClassName = FRegisteredClasses&#91;i&#93;.ClassName&#41; Then
        Begin
            Result &#58;= FRegisteredClasses&#91;i&#93;.ClassType.Create;
            Break;
        End;
    End;
End;
&#123;.......................................................&#125;

&#123;.......................................................&#125;
Function  TLuaClassFactory.NewLuaClass&#40;L&#58; lua_State&#41;&#58; Integer;
Var
    Table     &#58; Integer;
    LuaClass  &#58; TLuaClass;
    i         &#58; Integer;
    ClassName &#58; AnsiString;
Begin
    ClassName &#58;= luaL_checkstring&#40;L,1&#41;;

    LuaClass &#58;= NewLuaClassByName&#40;ClassName&#41;;

    If &#40;LuaClass = Nil&#41; Then
    Begin
        lua_pushstring&#40;L,PChar&#40;'NewLuaClass&#58; Unknown class name "'+ClassName+'"'&#41;&#41;;
        lua_error&#40;L&#41;;
    End;

    LuaClass.PushOntoLuaStack&#40;L&#41;;

    Result &#58;= 1;
End;
&#123;.......................................................&#125;

&#123;.......................................................&#125;
Function  TLuaClassFactory.DestroyLuaClass&#40;L&#58; lua_State&#41;&#58; Integer;
Var
    LuaRef  &#58; Integer;
    LuaClass&#58; TLuaClass;
Begin
    luaL_checktype&#40;L,1,LUA_TTABLE&#41;;

    lua_getmetatable&#40;L,1&#41;;

    lua_pushstring&#40;L,'Self'&#41;;
    lua_gettable&#40;L,-2&#41;;

    LuaClass &#58;= lua_touserdata&#40;L,-1&#41;;

    lua_pop&#40;L,1&#41;;

    If &#40;Not&#40;LuaClass Is TLuaClass&#41;&#41; Then
    Begin
        lua_pushstring&#40;L,'LuaDestroyClass&#58; LuaClass expected'&#41;;
        lua_error&#40;L&#41;;
    End;

    LuaClass.Free;

    Result &#58;= 0;
End;
&#123;.......................................................&#125;

&#123;.......................................................&#125;
End.