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
Code:
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 (FLibName <> '') Then
Begin
lua_newtable(L);
Table := lua_gettop(L);
End;
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;
If (FLibName <> '') Then
lua_setglobal(L,PChar(FLibName));
End;
{.......................................................}
{.......................................................}
Constructor TLuaClassFactory.Create;
Begin
Inherited Create;
RegisterLuaMethod('NewLuaClass');
RegisterLuaMethod('DestroyLuaClass');
SetLength(FRegisteredClasses,0);
End;
{.......................................................}
{.......................................................}
Destructor TLuaClassFactory.Destroy;
Begin
SetLength(FRegisteredClasses,0);
Inherited Destroy;
End;
{.......................................................}
{.......................................................}
Function TLuaClassFactory.CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer;
Begin
Case MethodIndex Of
0 : Result := NewLuaClass(L);
1 : Result := DestroyLuaClass(L);
Else
lua_pushstring(L,PChar(Format(
'TLuaClassFactory.CallLuaMethod: MethodIndex "%d" out of bounds',
[MethodIndex])));
lua_error(L);
End;
End;
{.......................................................}
{.......................................................}
Procedure TLuaClassFactory.RegisterLuaClass(ClassName: AnsiString; ClassType: TLuaClassClass);
Var
LuaClass: TLuaClass;
Begin
If (ClassName = '') Then
Exit;
If (LuaClassExists(ClassName)) Then
Raise Exception.Create('TLuaClassFactory.RegisterLuaClass: LuaClass "'+ClassName+'" is already registered');
SetLength(FRegisteredClasses,Length(FRegisteredClasses) + 1);
FRegisteredClasses[High(FRegisteredClasses)].ClassName := ClassName;
FRegisteredClasses[High(FRegisteredClasses)].ClassType := ClassType;
End;
{.......................................................}
{.......................................................}
Function TLuaClassFactory.LuaClassExists(ClassName: AnsiString): Boolean;
Var
i: Integer;
Begin
Result := False;
For i := 0 To High(FRegisteredClasses) Do
Begin
If (ClassName = FRegisteredClasses[i].ClassName) Then
Begin
Result := True;
Break;
End;
End;
End;
{.......................................................}
{.......................................................}
Function TLuaClassFactory.NewLuaClassByName(ClassName: AnsiString): TLuaClass;
Var
i: Integer;
Begin
Result := Nil;
For i := 0 To High(FRegisteredClasses) Do
Begin
If (ClassName = FRegisteredClasses[i].ClassName) Then
Begin
Result := FRegisteredClasses[i].ClassType.Create;
Break;
End;
End;
End;
{.......................................................}
{.......................................................}
Function TLuaClassFactory.NewLuaClass(L: lua_State): Integer;
Var
Table : Integer;
LuaClass : TLuaClass;
i : Integer;
ClassName : AnsiString;
Begin
ClassName := luaL_checkstring(L,1);
LuaClass := NewLuaClassByName(ClassName);
If (LuaClass = Nil) Then
Begin
lua_pushstring(L,PChar('NewLuaClass: Unknown class name "'+ClassName+'"'));
lua_error(L);
End;
LuaClass.PushOntoLuaStack(L);
Result := 1;
End;
{.......................................................}
{.......................................................}
Function TLuaClassFactory.DestroyLuaClass(L: lua_State): Integer;
Var
LuaRef : Integer;
LuaClass: TLuaClass;
Begin
luaL_checktype(L,1,LUA_TTABLE);
lua_getmetatable(L,1);
lua_pushstring(L,'Self');
lua_gettable(L,-2);
LuaClass := lua_touserdata(L,-1);
lua_pop(L,1);
If (Not(LuaClass Is TLuaClass)) Then
Begin
lua_pushstring(L,'LuaDestroyClass: LuaClass expected');
lua_error(L);
End;
LuaClass.Free;
Result := 0;
End;
{.......................................................}
{.......................................................}
End.
Bookmarks