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.

[paul_nicholls]

And here is some test code to show how to create and use a lua class

I hope people find this helpfull!

Test code:

Uses
    SysUtils,
    Lua,
    LuaClasses;

Type
//
//  a simple lua class counter as a test
//
    TLuaClassCounter = Class(TLuaClass)
    Private
        FCount: Integer;

        Function IncCount(L: lua_State): Integer;
        Function GetCount(L: lua_State): Integer;
    Protected
        Function  CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer; Override;
    Public
        Constructor Create; Override;
    End;

Constructor TLuaClassCounter.Create;
Begin
    Inherited Create;

    RegisterLuaMethod('IncCount');
    RegisterLuaMethod('GetCount');

    FCount := 0;
End;
{.......................................................}

{.......................................................}
Function  TLuaClassCounter.IncCount(L: lua_State): Integer;
Begin
    Inc(FCount);

    Result := 0;
End;
{.......................................................}

{.......................................................}
Function  TLuaClassCounter.GetCount(L: lua_State): Integer;
Begin
    lua_pushnumber(L,FCount);

    Result := 1;
End;
{.......................................................}

{.......................................................}
Function  TLuaClassCounter.CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer;
Begin
    Case MethodIndex Of
        0 : Result := IncCount(L);
        1 : Result := GetCount(L);
    Else
        lua_pushstring(L,PChar(Format(
            'TLuaClassCounter.CallLuaMethod: MethodIndex "%d" out of bounds',
            [MethodIndex])));
        lua_error(L);
    End;
End;
{.......................................................}

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

//  Using TLuaClass Test example

    LuaClassFactory : TLuaClassFactory;
    LuaState        : lua_State;
    TestScript      : AnsiString;
Begin
    //open and initialize a lua state
    {...}

    LuaClassFactory := TLuaClassFactory.Create;
    LuaClassFactory.LibName := '';
    
    //  if TLuaClass.LibName <> '' then
    //  the TLuaClass methods become part of a global table called .LibName
    //  just like a library instead of stand-alone global routines and 
    //  LibName.<method name> needs to be used when calling them
    //  instead of <method name>

    Try
        LuaClassFactory.RegisterLuaClass&#40;'Counter',TLuaClassCounter&#41;;
    Except
        On E&#58; Exception Do
            ShowMessage&#40;E.Message&#41;;
    End;

    LuaClassFactory.RegisterMethodsWithLua&#40;LuaState&#41;;

    //run a lua script

    TestScript &#58;=

    'a = NewLuaClass&#40;"Counter"&#41;'    +#13#10#13#10+

    'for i = 1,10 do'               +#13#10+
    '  a.IncCount&#40;&#41;'                +#13#10+
    'end'                           +#13#10#13#10+

    'print&#40;a.GetCount&#40;&#41;&#41;'           +#13#10#13#10+

    'DestroyLuaClass&#40;a&#41;';

    lua_dostring&#40;LuaState,PChar&#40;TestScript&#41;&#41;;

    ReadLn;

    //close the lua state
    &#123;...&#125;

[Robert Kosek]

Interesting.

Where did you get the Lua 5.x headers from? I've not figured out where to get them for Delphi. (I've got 2005 PE)

[paul_nicholls]

Interesting.

Where did you get the Lua 5.x headers from? I've not figured out where to get them for Delphi. (I've got 2005 PE)

hmm, let me think...

I think I got the Delphi headers + Lua binaries from here:
http://www.matrix44.de/lua/

have fun!

cheers,
Paul.

[Robert Kosek]

Thanks much, Paul.

Quick question since I only skimmed your code. Does this, or can this, emulate properties too? And functions with variables, not just a single function with no variables or returns?

[paul_nicholls]

Thanks much, Paul.

Quick question since I only skimmed your code. Does this, or can this, emulate properties too? And functions with variables, not just a single function with no variables or returns?

The only way I can think to simulate properties, is to create Get/Set methods in the TLuaClass descendent and use those :-)

To your other question, your TLuaClass methods MUST take 1 input parameter of type lua_State and return a result as Integer like so:

Function MyMethodName(L: lua_State): Integer;

but they can then quite happily receive any number of Lua input parameters via the lua_State's stack, and return any number of Lua variables back onto the lua_State's stack like so:

This one takes no input parameters and returns no results

Function  TLuaClassCounter.IncCount(L: lua_State): Integer;
Begin
    Inc(FCount);

    Result := 0;
End;

This one takes no input parameters and returns 1 result (the number)

Function  TLuaClassCounter.GetCount(L: lua_State): Integer; 
Begin
    lua_pushnumber(L,FCount);

    Result := 1;
End;

Here is an example of a TLuaClass method that takes 2 numbers, and returns the Sum and the Difference of the 2 numbers as 2 separate results

Function TLuaClassTest.SumDiff(L: lua_State): Integer;
Var
    a,b: Single;
    sum,diff: Single;
Begin
    //  make sure that there are 2 inputs, and that they are numbers
    a := luaL_checknumber(L,1);
    b := luaL_checknumber(L,2);

    sum := a + b;
    diff := a - b;

    //  push both results onto the Lua stack
    lua_pushnumber(L,sum);
    lua_pushnumber(L,diff);

    Result := 2;
End;

For example this may be called like so in a Lua script:

a,b = Test.SumDiff(5,10) -- assume it is created already

print(a,b)

This one calles the appropriate internal TLuaClass methods depending on the MethodIndex

Function  TLuaClassCounter.CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer;
Begin
    Case MethodIndex Of
        0 : Result := IncCount(L);
        1 : Result := GetCount(L);
    Else
        lua_pushstring(L,PChar(Format(
            'TLuaClassCounter.CallLuaMethod: MethodIndex "%d" out of bounds',
            [MethodIndex])));
        lua_error(L);
    End;
End;

[jdarling]

WOW you mean I'm not the only freak using LUA in Delphi? Nice work thus far, I've been working on a way to create wrappers for units and objects for my own code. I'll have to take a look at what you've put together as it may aid along the way .

[Robert Kosek]

In that case you could use a function to recieve and return variables? It could be a little choppy, but I think it's doable.

[jdarling]

If you write an __newindex handler (writer) that uses RTTI to look at the parent class and write a specialized __index handler (reader) then you can emulate properties quite well. I have this working some place, but the method callers arn't complete yet. Actually the code above gives me some ideas so I may be posting up my code for LUA some time soon too

[Robert Kosek]

Cool. I think you two need to work together after the competition and combine your Lua units.