using Delphi classes in lua :) [Archive]

paul_nicholls

05-04-2006, 01:47 AM

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 (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.RegisterLuaClas s: LuaClass "'+ClassName+'" is already registered');

SetLength(FRegisteredClasses,Length(FRegisteredCla sses) + 1);
FRegisteredClasses[High(FRegisteredClasses)].Class Name := ClassName;
FRegisteredClasses[High(FRegisteredClasses)].Class Type := 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.

paul_nicholls

05-04-2006, 01:49 AM

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('Counter',TLuaCla ssCounter);
Except
On E: Exception Do
ShowMessage(E.Message);
End;

LuaClassFactory.RegisterMethodsWithLua(LuaState);

//run a lua script

TestScript :=

'a = NewLuaClass("Counter")' +#13#10#13#10+

'for i = 1,10 do' +#13#10+
' a.IncCount()' +#13#10+
'end' +#13#10#13#10+

'print(a.GetCount())' +#13#10#13#10+

'DestroyLuaClass(a)';

lua_dostring(LuaState,PChar(TestScript));

ReadLn;

//close the lua state
{...}

Robert Kosek

05-04-2006, 02:12 AM

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

05-04-2006, 02:43 AM

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

05-04-2006, 04:21 AM

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

05-04-2006, 05:17 AM

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

05-04-2006, 12:50 PM

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

05-04-2006, 02:56 PM

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

05-04-2006, 03:19 PM

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

05-04-2006, 04:06 PM

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

paul_nicholls

05-04-2006, 10:45 PM

WOW you mean I'm not the only freak using LUA in Delphi?

LOL!

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 :).

Thanks for the nice comments, and I am just glad to be able to occasionally help other people after myself getting lots of help from the net over the years :)

cheers,
Paul.

paul_nicholls

05-04-2006, 10:52 PM

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 :)

I was thinking about '__index' as well, but as far as I can figure this would only help with making readable properties, not writable ones :(

How would using '__newindex' help with emulating properties? This is only called if one is adding a new key + value to a table, not for pre-existing keys...

I would be interested in how you got the '__newindex' working for this sort of thing :)

Also I have no clue as to if it is even possible to protect the existing 'class methods' created in the table from being accidently overwritten by a lua script using the table and assigning a value to that key...

Any thoughts on that one?

cheers,
Paul.

paul_nicholls

06-04-2006, 04:49 AM

I'm not sure if this will help us guys, but I found this post over on a Lua forum:

http://www.icynorth.com/forums/viewtopic.php?t=404&highlight=

looks interesting :-)

cheers,
Paul

jdarling

06-04-2006, 01:07 PM

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 :)

I was thinking about '__index' as well, but as far as I can figure this would only help with making readable properties, not writable ones :(

How would using '__newindex' help with emulating properties? This is only called if one is adding a new key + value to a table, not for pre-existing keys...

I would be interested in how you got the '__newindex' working for this sort of thing :)

Also I have no clue as to if it is even possible to protect the existing 'class methods' created in the table from being accidently overwritten by a lua script using the table and assigning a value to that key...

Any thoughts on that one?

cheers,
Paul.

Just as soon as I have the code completed and cleaned up I'll post it up for everyone to use. The basic idea is this:

Create your "Class" using the methods provided in Luna thus hiding the metatable and object level manager from the Lua script in general. Overide the __index and __newindex (witch fires when an unknown is set) and make sure that ALL properties are removed from the meta table. Any time a person makes a request to the object using dot notation either __index (read) or __newindex (write) will be fired, using RTTI scan the object and find out if the property exists, if so then return/set the value otherwise throw an error or pass it back up to Lua as a new table entitity using lua_settable(L, TableIndex) lua_pushstring(L, [PropName]) lua_pushvalue(L, val). Thus the next time its accessed it won't fire __index or __newindex, since you have caught the ones that do fire these "events" (and I use the term loosly) your code will still execute. Now before you ask what if the person overrides __index or __newindex remember that we hid the MetaTable and ObjectTable from the user, they can still get at it using upval() but thats another topic for another day. You simply have to let your users know not to screw with the __index and __newindex methods attached to your objects :)

paul_nicholls

06-04-2006, 11:29 PM

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 :)

I was thinking about '__index' as well, but as far as I can figure this would only help with making readable properties, not writable ones :(

How would using '__newindex' help with emulating properties? This is only called if one is adding a new key + value to a table, not for pre-existing keys...

I would be interested in how you got the '__newindex' working for this sort of thing :)

Also I have no clue as to if it is even possible to protect the existing 'class methods' created in the table from being accidently overwritten by a lua script using the table and assigning a value to that key...

Any thoughts on that one?

cheers,
Paul.

Just as soon as I have the code completed and cleaned up I'll post it up for everyone to use. The basic idea is this:

Create your "Class" using the methods provided in Luna thus hiding the metatable and object level manager from the Lua script in general. Overide the __index and __newindex (witch fires when an unknown is set) and make sure that ALL properties are removed from the meta table. Any time a person makes a request to the object using dot notation either __index (read) or __newindex (write) will be fired, using RTTI scan the object and find out if the property exists, if so then return/set the value otherwise throw an error or pass it back up to Lua as a new table entitity using lua_settable(L, TableIndex) lua_pushstring(L, [PropName]) lua_pushvalue(L, val). Thus the next time its accessed it won't fire __index or __newindex, since you have caught the ones that do fire these "events" (and I use the term loosly) your code will still execute. Now before you ask what if the person overrides __index or __newindex remember that we hid the MetaTable and ObjectTable from the user, they can still get at it using upval() but thats another topic for another day. You simply have to let your users know not to screw with the __index and __newindex methods attached to your objects :)

Ahh! that makes sense, with the starting with no properties! cool :)
I'll give it a go myself in the meantime to try it :)

cheers,
Paul.

jdarling

07-04-2006, 02:34 AM

Ok, this is going to be ugly as I haven't posted the TLUA component yet, but I think you can figure it out w/o it as basically all you have to do is replace its reference with a Plua_State :)

This code is my reference code for my Delphi->Lua application that is comming around:
unit TestLuaClass;

interface

uses
Classes, LuaWrapper, Lua, LuaUtils, Lauxlib, LuaLib;

type
TTestClass=class(TPersistent)
private
FBalance: Double;
procedure SetBalance(const Value: Double);
public
class procedure RegisterTo(LuaScript:TLUA);
published
procedure Deposit(Amount:Double);
procedure Withdraw(Amount:Double);
property Balance : Double read FBalance write SetBalance;
end;

implementation

uses
SysUtils,
TypInfo;

const
LuaClassName = 'TestClass';

function Check(L: Plua_State; Idx : Integer) : TTestClass;
begin
result := nil;
if lua_type(L, Idx) = LUA_TTABLE then
result := LuaGetTableLightUserData(L, Idx, '_Self')
else
luaL_typerror(L, Idx, LuaClassName);
end;

function new_TestClass(L: Plua_State): Integer; cdecl;
var
c : TTestClass;
begin
if lua_type(L, 1) <> LUA_TTABLE then
lua_remove(L, 1);
c := TTestClass.Create;
LuaSetTableLightUserData(L, 1, '_Self', c);
luaL_getmetatable(L, LuaClassName);
lua_setmetatable(L, -2);
result := 1;
end;

function gc_TestClass(L: Plua_State): Integer; cdecl;
var
c : TTestClass;
begin
c := Check(L, 1);
c.Free;
result := 0;
end;

function indexTestClass(L: Plua_State): Integer; cdecl;
var
c : TTestClass;
propName : String;
v : Variant;
begin
c := Check(L, 1);
lua_remove(L, 1);
propName := LuaToString(L, 1);
if IsPublishedProp(c, propName) then
begin
v := GetPropValue(c, propName);
LuaPushVariant(L, v);
end
else
luaL_error(L, PChar('Property "'+propName+'" does not exist'));
result := 1;
end;

function newindexTestClass(L:PLua_State): Integer; cdecl;
var
c : TTestClass;
propName : String;
v : Variant;
begin
c := Check(L, 1);
lua_remove(L, 1);
propName := LuaToString(L, 1);
v := LuaToVariant(L, 2);
if IsPublishedProp(c, propName) then
SetPropValue(c, propName, v)
else
luaL_error(L, PChar('Property "'+propName+'" does not exist'));
result := 0;
end;

function luaDeposit(L: Plua_State): Integer; cdecl;
var
c : TTestClass;
begin
c := Check(L, 1);
lua_remove(L, 1);
if lua_type(L, 1)<>LUA_TNUMBER then
luaL_error(L, 'Deposit expects one parameter (Amount) that should be an integer.')
else
c.Deposit(lua_tonumber(L, 1));
result := 0;
end;

function luaWithdraw(L: Plua_State): Integer; cdecl;
var
c : TTestClass;
begin
c := Check(L, 1);
lua_remove(L, 1);
if lua_type(L, 1)<>LUA_TNUMBER then
luaL_error(L, 'Withdraw expects one parameter (Amount) that should be an integer.')
else
c.Withdraw(lua_tonumber(L, 1));
result := 0;
end;

{ TTestClass }

procedure TTestClass.Deposit(Amount: Double);
begin
FBalance := FBalance + Amount;
end;

class procedure TTestClass.RegisterTo(LuaScript: TLUA);
var
MetaTable,
MethodTable,
Methods : Integer;
begin
lua_newtable(LuaScript.LuaState);
Methods := lua_gettop(LuaScript.LuaState);

luaL_newmetatable(LuaScript.LuaState, LuaClassName);
MetaTable := lua_gettop(LuaScript.LuaState);

lua_pushstring(LuaScript.LuaState, LuaClassName);
lua_pushvalue(LuaScript.LuaState, Methods);
lua_settable(LuaScript.LuaState, LUA_GLOBALSINDEX);

lua_pushliteral(LuaScript.LuaState, '__metatable');
lua_pushvalue(LuaScript.LuaState, Methods);
lua_settable(LuaScript.LuaState, metatable);

lua_pushliteral(LuaScript.LuaState, '__index');
lua_pushcfunction(LuaScript.LuaState, indexTestClass);
lua_settable(LuaScript.LuaState, MetaTable);

lua_pushliteral(LuaScript.LuaState, '__newindex');
lua_pushcfunction(LuaScript.LuaState, newindexTestClass);
lua_settable(LuaScript.LuaState, MetaTable);

lua_pushliteral(LuaScript.LuaState, '__gc');
lua_pushcfunction(LuaScript.LuaState, gc_TestClass);
lua_settable(LuaScript.LuaState, MetaTable);

lua_newtable(LuaScript.LuaState);
MethodTable := lua_gettop(LuaScript.LuaState);
lua_pushliteral(LuaScript.LuaState, '__call');
lua_pushcfunction(LuaScript.LuaState, new_TestClass);
lua_pushliteral(LuaScript.LuaState, 'new');
lua_pushvalue(LuaScript.LuaState, -2);
lua_settable(LuaScript.LuaState, Methods);
lua_settable(LuaScript.LuaState, MethodTable);
lua_setmetatable(LuaScript.LuaState, Methods);

//Test Method
lua_pushstring(LuaScript.LuaState, 'Deposit');
lua_pushcfunction(LuaScript.LuaState, luaDeposit);
lua_settable(LuaScript.LuaState, Methods);

lua_pushstring(LuaScript.LuaState, 'Withdraw');
lua_pushcfunction(LuaScript.LuaState, luaWithdraw);
lua_settable(LuaScript.LuaState, Methods);
//End of Test Method}

lua_pop(LuaScript.LuaState, 2);
end;

procedure TTestClass.SetBalance(const Value: Double);
begin
FBalance := Value;
end;

procedure TTestClass.Withdraw(Amount: Double);
begin
FBalance := FBalance - Amount;
end;

end.

paul_nicholls

07-04-2006, 03:29 AM

Awsome work chief! :)

:wink: That TTestClass.RegisterTo() method is almost scary! hehe

Paul.

paul_nicholls

07-04-2006, 03:33 AM

Actually, I was thinking. Instead of subclassing from TPersistent, you could possible do something like so instead for more flexability with base class types:

{$M+}
TTestClass=class
private
FBalance: Double;
procedure SetBalance(const Value: Double);
public
class procedure RegisterTo(LuaScript:TLUA);
published
procedure Deposit(Amount:Double);
procedure Withdraw(Amount:Double);
property Balance : Double read FBalance write SetBalance;
end;
{$M-}

I believe the ($M+} will also give you RTTI info as well :)

Paul.

jdarling

07-04-2006, 01:24 PM

Actually, I was thinking. Instead of subclassing from TPersistent, you could possible do something like so instead for more flexability with base class types:

{$M+}
TTestClass=class
private
FBalance: Double;
procedure SetBalance(const Value: Double);
public
class procedure RegisterTo(LuaScript:TLUA);
published
procedure Deposit(Amount:Double);
procedure Withdraw(Amount:Double);
property Balance : Double read FBalance write SetBalance;
end;
{$M-}

I believe the ($M+} will also give you RTTI info as well :)

Paul.

Well actually when complete the importer will just be ran on your source and will create a wrapper unit for it. The problem was I needed an object that was quick and easy to test on that exhibited everything I wanted to wrap up. The only one I haven't figured out yet is properties with array indexes. BTW: If you want to use object assignment for properties then you have to do a GetPropType(Instance, PropName) = tkClass (thats off the top of my head so its probiably wrong) and then get the table's reference to _Self. Other then that its pretty straight forward :). Hopefully I get everything completed some time soon.

paul_nicholls

13-04-2006, 02:17 AM

For you info, using jdarling's idea of an empty table + __index and __newindex I have updated my TLuaClass to check/protect methods + properties :)

example:

class declaration

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;
Procedure ReadPropertyValue(L: lua_State; PropertyIndex: Integer); Override;
Procedure WritePropertyValue(L: lua_State; PropertyIndex: Integer); Override;
Public
Constructor Create; Override;
End;

class body

Constructor TLuaClassCounter.Create;
Begin
Inherited Create;

RegisterLuaMethod ('IncCount',0);
RegisterLuaMethod ('GetCount',1);
RegisterLuaProperty('Count' ,0,eIntegerProperty,False);
RegisterLuaProperty('Count2x' ,1,eIntegerProperty,True);
RegisterLuaProperty('Self' ,2,eLuaClassProperty,True);

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
Result := 0;

Case MethodIndex Of
0 : Result := IncCount(L);
1 : Result := GetCount(L);
Else
End;
End;
{................................................. ......}

{................................................. ......}
Procedure TLuaClassCounter.ReadPropertyValue(L: lua_State; PropertyIndex: Integer);
Begin
Case PropertyIndex Of
0 : lua_pushnumber(L,FCount);
1 : lua_pushnumber(L,FCount * 2);
2 : PushOntoLuaStack(L);
Else
End;

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

{................................................. ......}
Procedure TLuaClassCounter.WritePropertyValue(L: lua_State; PropertyIndex: Integer);
Var
Value: Double;
Begin
Case PropertyIndex Of
0 : FCount := Trunc(lua_tonumber(L,3));
Else
End;
End;
{................................................. ......}

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

Behind the scenes, no properties or methods can be overwritten in a Lua script, and read-only properties can't be written to in Lua script :)
Also, you can't assign the wrong type to writable properties and it will tell you :)

BTW, is there anywhere on this site that one can post largeish code/units to share with people?

cheers,
Paul

Robert Kosek

13-04-2006, 02:31 AM

You can post the unit here, I would offer some of my own webspace but just learned I need to clean up ... I got hacked apparantly.

paul_nicholls

13-04-2006, 04:29 AM

You can post the unit here, I would offer some of my own webspace but just learned I need to clean up ... I got hacked apparantly.

Sorry to hear you got hacked! :(

Ok, here is my code so far. BTW, the last code chunk is a snippit only as the whole unit is 1272 lines long! So I don't think I should really post it here?

The TLuaDataStore allows lua objects to be stored/retrieved by name across lua scripts as references are used.

TheTLuaDataStoreManager allows TLuaDataStore objects to be created and retrieved by name to allow for multiple stores :)

Here is an axample script

-- create the LuaClass
a = NewLuaClass("Counter")

a.Count = 4 + 5

a.IncCount()

-- retrieve a DataStore called "Vault" (created if necessary)
b = DataStore("Vault")

-- store a in it under some name
b.StoreByName("SomeLuaThing",a)

-- retrieve 'a' by name
c = b.RetrieveByName("SomeLuaThing")

print(c.Count)
print(c.Count2x)

DestroyLuaClass(a)

LuaClasses unit

Unit LuaClasses;

Interface

Uses
SysUtils,
Classes,
Lua,
LuaObjects;

Type
TLuaPropertyType =
(
eUnknownProperty,
eIntegerProperty,
eNumberProperty,
eStringProperty,
eBooleanProperty,
eLuaClassProperty);

PLuaPropertyInfo = ^TLuaPropertyInfo;
TLuaPropertyInfo = Packed Record
Index : Integer;
PropType : TLuaPropertyType;
IsReadOnly: Boolean;
End;

TLuaClass = Class
Private
FMethods : TStringList;
FProperties : TStringList;
FLibName: AnsiString;
Protected
Function KeyIsReadonly(Key: AnsiString): Boolean;
Function KeyIsProperty(Key: AnsiString): Boolean;
Function KeyIsMethod (Key: AnsiString): Boolean;
Function KeyType (Key: AnsiString): TLuaPropertyType;
Procedure ReadPropertyValue(L: lua_State; PropertyIndex: Integer); Virtual;
Procedure WritePropertyValue(L: lua_State; PropertyIndex: Integer); Virtual;
Procedure PushMethodsOntoLuaStack(L: lua_State; Table: Integer);
Procedure RegisterLuaMethod(AName: AnsiString; MethodIndex: Integer);
Procedure RegisterLuaProperty(AName: AnsiString;
Index: Integer;
PropType: TLuaPropertyType;
IsReadOnly: Boolean);
Procedure PushMethodOntoLuaStack(L: lua_State; Name: AnsiString; Index: Integer);
Function ReadKeyValue(L: lua_State; Key: AnsiString): Integer; Virtual;
Procedure WriteKeyValue(L: lua_State; Key: AnsiString); Virtual;
Function CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer; Virtual;
Public
Constructor Create; Virtual;
Destructor Destroy; Override;

Procedure PushOntoLuaStack(L: lua_State);
Procedure RegisterWithLua(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;

TLuaDataStore = Class(TLuaClass)
Private
FDataStoreRefs: TStringList;

Function StoreByName(L: lua_State): Integer;
Function RetrieveByName(L: lua_State): Integer;
Protected
Function CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer; Override;
Public
Constructor Create; Override;
Destructor Destroy; Override;
End;

TLuaDataStoreManager = Class(TLuaClass)
Private
FDataStores: TStringList;

Function DataStore(L: lua_State): Integer;
Function GetDataStoreByKey(Key: AnsiString): TLuaDataStore;
Protected
Function CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer; Override;
Public
Constructor Create; Override;
Destructor Destroy; Override;
End;

Implementation

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

{................................................. ......}
Function LuaClassCheck(L: lua_State; Idx: Integer): TLuaClass;
Begin
Result := Nil;

If (Not lua_isuserdata(L,Idx)) Then
Begin
LuaDoError(L,'LuaClass expected');
Exit;
End;

Result := lua_touserdata(L,Idx);

If (Not(Result Is TLuaClass)) Then
Begin
LuaDoError(L,'LuaClass expected');
Exit;
End;
End;
{................................................. ......}

{................................................. ......}
Function LuaClassRedirector(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;
{................................................. ......}

{................................................. ......}
Function LuaClassIndex(L: lua_State): Integer; CDecl;
Var
LuaClass: TLuaClass;
Key : AnsiString;
Begin
LuaClass := LuaClassCheck(L,lua_upvalueindex(1));

Key := luaL_checkstring(L,2);

If (Not LuaClass.KeyIsProperty(Key)) And (Not LuaClass.KeyIsMethod(Key)) Then
Begin
LuaDoError(L,LuaClass.ClassName + ': Unknown property/method "'+Key+'"');
Exit;
End;

Result := LuaClass.ReadKeyValue(L,Key);
End;
{................................................. ......}

{................................................. ......}
Function LuaClassNewIndex(L: lua_State): Integer; CDecl;
Var
LuaClass : TLuaClass;
Key : AnsiString;
KeyType : TLuaPropertyType;
ValueType : Integer;
Begin
Result := 0;

LuaClass := LuaClassCheck(L, lua_upvalueindex(1));

Key := luaL_checkstring(L,2);

If (LuaClass.KeyIsMethod(Key)) Then
Begin
LuaDoError(L,LuaClass.ClassName + ': Can''t assign values to method "'+Key+'"');
Exit;
End
Else
If (LuaClass.KeyIsProperty(Key)) Then
Begin
If (LuaClass.KeyIsReadOnly(Key)) Then
Begin
LuaDoError(L,LuaClass.ClassName + ': Can''t assign values to read-only property "'+Key+'"');
Exit;
End
Else
Begin
KeyType := LuaClass.KeyType(Key);
ValueType := lua_type(L,3);

If (KeyType = eUnknownProperty) Then
Begin
LuaDoError(L,LuaClass.ClassName + ': Can''t write to unknown property "'+Key+'"');
Exit;
End
Else
Begin
If (KeyType = eIntegerProperty) And (Not LuaIsInteger(L,3,LuaClass.ClassName + '.' + Key)) Then
Begin
Result := 0;
Exit;
End
Else
If (KeyType = eNumberProperty) And (Not LuaIsNumber(L,3,LuaClass.ClassName + '.' + Key)) Then
Begin
Result := 0;
Exit;
End
Else
If (KeyType = eStringProperty) And (Not LuaIsString(L,3,LuaClass.ClassName + '.' + Key)) Then
Begin
Result := 0;
Exit;
End
Else
If (KeyType = eBooleanProperty) And (Not LuaIsBoolean(L,3,LuaClass.ClassName + '.' + Key)) Then
Begin
Result := 0;
Exit;
End
End;
End;
End
Else
Begin
LuaDoError(L,LuaClass.ClassName + ': Unknown property/method "'+Key+'"');
Exit;
End;

LuaClass.WriteKeyValue(L,Key);
End;
{................................................. ......}

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

FMethods := TStringList.Create;
FMethods.Sorted := True;
FMethods.Duplicates := dupError;
FProperties := TStringList.Create;
FProperties.Sorted := True;
FProperties.Duplicates := dupError;
FLibName := '';
End;
{................................................. ......}

{................................................. ......}
Destructor TLuaClass.Destroy;
Var
i : Integer;
PropertyInfo: PLuaPropertyInfo;
Begin
For i := 0 To FProperties.Count - 1 Do
Begin
PropertyInfo := PLuaPropertyInfo(FProperties.Objects[i]);

Dispose(PropertyInfo);
End;

FProperties.Free;
FMethods.Free;

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

{................................................. ......}
Procedure TLuaClass.RegisterLuaMethod(AName: AnsiString; MethodIndex: Integer);
Begin
FMethods.AddObject(AName,Pointer(MethodIndex));
End;
{................................................. ......}

{................................................. ......}
Procedure TLuaClass.RegisterLuaProperty(AName: AnsiString;
Index: Integer;
PropType: TLuaPropertyType;
IsReadOnly: Boolean);
Var
PropertyInfo: PLuaPropertyInfo;
Begin
New(PropertyInfo);

PropertyInfo.Index := Index;
PropertyInfo.PropType := PropType;
PropertyInfo.IsReadOnly := IsReadOnly;

FProperties.AddObject(AName,TObject(PropertyInfo)) ;
End;
{................................................. ......}

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

{................................................. ......}
Function TLuaClass.KeyIsReadonly(Key: AnsiString): Boolean;
Var
Index : Integer;
PropertyInfo: PLuaPropertyInfo;
Begin
Result := False;

If (FMethods.Find(Key,Index)) Then
Begin
Result := True;
End
Else
If (FProperties.Find(Key,Index)) Then
Begin
PropertyInfo := PLuaPropertyInfo(FProperties.Objects[Index]);

Result := PropertyInfo.IsReadOnly;
End;
End;
{................................................. ......}

{................................................. ......}
Function TLuaClass.KeyIsProperty(Key: AnsiString): Boolean;
Var
Index: Integer;
Begin
Result := FProperties.Find(Key,Index);
End;
{................................................. ......}

{................................................. ......}
Function TLuaClass.KeyIsMethod (Key: AnsiString): Boolean;
Var
Index: Integer;
Begin
Result := FMethods.Find(Key,Index);
End;
{................................................. ......}

{................................................. ......}
Function TLuaClass.KeyType (Key: AnsiString): TLuaPropertyType;
Var
Index : Integer;
PropInfo: PLuaPropertyInfo;
Begin
Result := eUnknownProperty;

If (FProperties.Find(Key,Index)) Then
Begin
PropInfo := PLuaPropertyInfo(FProperties.Objects[Index]);
Result := PropInfo.PropType;
End;
End;
{................................................. ......}

{................................................. ......}
Procedure TLuaClass.ReadPropertyValue(L: lua_State; PropertyIndex: Integer);
Begin
End;
{................................................. ......}

{................................................. ......}
Procedure TLuaClass.WritePropertyValue(L: lua_State; PropertyIndex: Integer);
Begin
End;
{................................................. ......}

{................................................. ......}
Function TLuaClass.ReadKeyValue(L: lua_State; Key: AnsiString): Integer;
Var
Index : Integer;
PropInfo: PLuaPropertyInfo;
Begin
If (KeyIsMethod(Key)) Then
Begin
FMethods.Find(Key,Index);

PushMethodOntoLuaStack(L,Key,Integer(FMethods.Obje cts[Index]));
End
Else
Begin
PropInfo := PLuaPropertyInfo(FProperties.Objects[Index]);

ReadPropertyValue(L,PropInfo.Index);
End;

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

{................................................. ......}
Procedure TLuaClass.WriteKeyValue(L: lua_State; Key: AnsiString);
Var
Index : Integer;
PropInfo: PLuaPropertyInfo;
Begin
FProperties.Find(Key,Index);

PropInfo := PLuaPropertyInfo(FProperties.Objects[Index]);

WritePropertyValue(L,PropInfo.Index);
End;
{................................................. ......}

{................................................. ......}
Procedure TLuaClass.PushMethodOntoLuaStack(L: lua_State; Name: AnsiString; Index: Integer);
Begin
lua_pushstring (L,PChar(Name));
lua_pushlightuserdata(L,Self);
lua_pushnumber(L,Index);
lua_pushcclosure(L,LuaClassRedirector,2);
End;
{................................................. ......}

{................................................. ......}
Procedure TLuaClass.PushMethodsOntoLuaStack(L: lua_State; Table: Integer);
Var
i: Integer;
Begin
// push methods onto the stack
For i := 0 To FMethods.Count - 1 Do
Begin
PushMethodOntoLuaStack(L,FMethods.Strings[i],Integ er(FMethods.Objects[i]));

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

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

Table := lua_gettop(L);

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

MT := lua_gettop(L);

lua_pushstring(L,'__index');
lua_pushlightuserdata(L,Self);
lua_pushnumber(L,i);
lua_pushcclosure(L,LuaClassIndex,2);
lua_settable(L,MT);

lua_pushstring(L,'__newindex');
lua_pushlightuserdata(L,Self);
lua_pushnumber(L,i);
lua_pushcclosure(L,LuaClassNewIndex,2);
lua_settable(L,MT);

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

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

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

If (FLibName <> '') Then
Begin
lua_newtable(L);

Table := lua_gettop(L);
End;

PushMethodsOntoLuaStack(L,Table);

If (FLibName <> '') Then
lua_setglobal(L,PChar(FLibName));
End;
{................................................. ......}

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

RegisterLuaMethod('NewLuaClass',0);
RegisterLuaMethod('DestroyLuaClass',1);

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
LuaDoError(L,Format(
'TLuaClassFactory.CallLuaMethod: MethodIndex "%d" out of bounds',
[MethodIndex]));
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.RegisterLuaClas s: LuaClass "'+ClassName+'" is already registered');

SetLength(FRegisteredClasses,Length(FRegisteredCla sses) + 1);
FRegisteredClasses[High(FRegisteredClasses)].Class Name := ClassName;
FRegisteredClasses[High(FRegisteredClasses)].Class Type := 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
LuaDoError(L,'NewLuaClass: Unknown class type "'+ClassName+'"');
Exit;
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 := LuaClassCheck(L,-1);

If (LuaClass = Nil) Then
Exit;

LuaClass.Free;

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

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

FDataStoreRefs := TStringList.Create;
FDataStoreRefs.Sorted := True;

RegisterLuaMethod('StoreByName',0);
RegisterLuaMethod('RetrieveByName',1);
End;
{................................................. ......}

{................................................. ......}
Destructor TLuaDataStore.Destroy;
Begin
FDataStoreRefs.Free;

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

{................................................. ......}
Function TLuaDataStore.CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer;
Begin
Case MethodIndex Of
0 : Result := StoreByName(L);
1 : Result := RetrieveByName(L);
Else
LuaDoError(L,Format(
'TLuaDataStore.CallLuaMethod: MethodIndex "%d" out of bounds',
[MethodIndex]));
End;
End;
{................................................. ......}

{................................................. ......}
Function TLuaDataStore.StoreByName(L: lua_State): Integer;
Var
DataStoreKey: AnsiString;
DataStoreRef: Integer;
Index : Integer;
Begin
luaL_checktype(L,1,LUA_TSTRING);

DataStoreKey := lua_tostring(L,1);

DataStoreRef := luaL_ref(L,LUA_REGISTRYINDEX);

If (FDataStoreRefs.Find(DataStoreKey,Index)) Then
Begin
FDataStoreRefs.Objects[Index] := Pointer(DataStoreRef);
End
Else
FDataStoreRefs.AddObject(DataStorekey,Pointer(Data StoreRef));

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

{................................................. ......}
Function TLuaDataStore.RetrieveByName(L: lua_State): Integer;
Var
DataStoreKey: AnsiString;
DataStoreRef: Integer;
Index : Integer;
Begin
luaL_checktype(L,1,LUA_TSTRING);

DataStoreKey := lua_tostring(L,1);

If (FDataStoreRefs.Find(DataStoreKey,Index)) Then
Begin
DataStoreRef := Integer(FDataStoreRefs.Objects[Index]);

lua_rawgeti(L, LUA_REGISTRYINDEX, DataStoreRef);
End
Else
lua_pushnil(L);

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

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

FDataStores := TStringList.Create;
FDataStores.Sorted := True;

RegisterLuaMethod('DataStore',0);
End;
{................................................. ......}

{................................................. ......}
Destructor TLuaDataStoreManager.Destroy;
Var
i: Integer;
Begin
For i := 0 To FDataStores.Count - 1 Do
TLuaDataStore(FDataStores.Objects[i]).Free;

FDataStores.Free;

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

{................................................. ......}
Function TLuaDataStoreManager.CallLuaMethod(L: lua_State; MethodIndex: Integer): Integer;
Begin
Case MethodIndex Of
0 : Result := DataStore(L);
Else
LuaDoError(L,Format(
'TLuaDataStoreManager.CallLuaMethod: MethodIndex "%d" out of bounds',
[MethodIndex]));
End;
End;
{................................................. ......}

{................................................. ......}
Function TLuaDataStoreManager.GetDataStoreByKey(Key: AnsiString): TLuaDataStore;
Var
Index: Integer;
Begin
// store DataStores in a list and retrieve by name if it exists,
// and only create it if it doesn't exist.

If (FDataStores.Find(Key,Index)) Then
Result := TLuaDataStore(FDataStores.Objects[Index])
Else
Begin
Result := TLuaDataStore.Create;

FDataStores.AddObject(Key,Result);
End;
End;
{................................................. ......}

{................................................. ......}
Function TLuaDataStoreManager.DataStore(L: lua_State): Integer;
Var
Var
Table : Integer;
DataStore : TLuaDataStore;
DataStoreKey: AnsiString;
Begin
luaL_checktype(L,1,LUA_TSTRING);

DataStoreKey := lua_tostring(L,1);

DataStore := GetDataStoreByKey(DataStoreKey);

DataStore.PushOntoLuaStack(L);

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

{................................................. ......}
End.

necessary code snippit of my LuaObjects unit.

Procedure LuaDoError(L: lua_State; ErrorMsg: String);
Function LuaIsInteger(L: lua_State; Idx: Integer; ErrorMsg: String): Boolean;
Function LuaIsNumber(L: lua_State; Idx: Integer; ErrorMsg: String): Boolean;
Function LuaIsString(L: lua_State; Idx: Integer; ErrorMsg: String): Boolean;
Function LuaIsBoolean(L: lua_State; Idx: Integer; ErrorMsg: String): Boolean;

Implementation

Procedure LuaDoError(L: lua_State; ErrorMsg: String);
Begin
lua_pushstring(L,PChar(ErrorMsg));
lua_error(L);
End;
{................................................. ......}

{................................................. ......}
Function LuaIsInteger(L: lua_State; Idx: Integer; ErrorMsg: String): Boolean;
Var
Value: Double;
Begin
Result := True;

If (lua_type(L,idx) = LUA_TNUMBER) Then
Value := lua_tonumber(L,Idx)
Else
Begin
Result := False;
If (ErrorMsg <> '') Then
LuaDoError(L,ErrorMsg + ': "integer" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"')
Else
LuaDoError(L,'"integer" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"');
Exit;
End;

If (Abs(Value - Trunc(Value)) > 0.0001) Then
Begin
Result := False;
If (ErrorMsg <> '') Then
LuaDoError(L,ErrorMsg + ': "integer" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"')
Else
LuaDoError(L,'"integer" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"');
End;
End;
{................................................. ......}

{................................................. ......}
Function LuaIsNumber(L: lua_State; Idx: Integer; ErrorMsg: String): Boolean;
Begin
Result := True;

If (lua_type(L,idx) <> LUA_TNUMBER) Then
Begin
Result := False;
If (ErrorMsg <> '') Then
LuaDoError(L,ErrorMsg + ': "number" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"')
Else
LuaDoError(L,'"number" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"');
End;
End;
{................................................. ......}

{................................................. ......}
Function LuaIsString(L: lua_State; Idx: Integer; ErrorMsg: String): Boolean;
Begin
Result := True;

If (lua_type(L,idx) <> LUA_TSTRING) Then
Begin
Result := False;
If (ErrorMsg <> '') Then
LuaDoError(L,ErrorMsg + ': "string" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"')
Else
LuaDoError(L,'"string" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"');
End;
End;
{................................................. ......}

{................................................. ......}
Function LuaIsBoolean(L: lua_State; Idx: Integer; ErrorMsg: String): Boolean;
Begin
Result := True;

If (lua_type(L,idx) <> LUA_TBOOLEAN) Then
Begin
Result := False;
If (ErrorMsg <> '') Then
LuaDoError(L,ErrorMsg + ': "boolean" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"')
Else
LuaDoError(L,'"boolean" expected, received "' + lua_typename(L,lua_type(L,Idx)) + '"');
End;
End;
{................................................. ......}

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

Cheers,
Paul.

Robert Kosek

13-04-2006, 05:01 AM

Wow, that's a sizable unit, even snipped! :)

Well, after checking with the group I got the space at, the accounts weren't compromized, although somehow the hacker gained write access to the entire server. If you mail me a zip of the unit with your readme and license, I'll upload it. Send it to "thewickedflea <(at)> gmail >dot> com", you know the anti-spam drill. ;)

paul_nicholls

13-04-2006, 05:12 AM

Wow, that's a sizable unit, even snipped! :)

Well, after checking with the group I got the space at, the accounts weren't compromized, although somehow the hacker gained write access to the entire server. If you mail me a zip of the unit with your readme and license, I'll upload it. Send it to "thewickedflea <(at)> gmail >dot> com", you know the anti-spam drill. ;)

Cool, ok :)

I'll send you a zip file containing a complete demo source and all the needed units in their entirety :)

It would be cool if you could post a link to the zip file when done :-)

cheers,
Paul.

paul_nicholls

13-04-2006, 06:20 AM

[quote="Robert Kosek"]Wow, that's a sizable unit, even snipped! :)

Well, after checking with the group I got the space at, the accounts weren't compromized, although somehow the hacker gained write access to the entire server. If you mail me a zip of the unit with your readme and license, I'll upload it. Send it to "thewickedflea <(at)> gmail >dot> com", you know the anti-spam drill. ;)

Cool, ok :)

I'll send you a zip file containing a complete demo source and all the needed units in their entirety :)

It would be cool if you could post a ]

Hi Robert,
I tried sending my zip file to your email address (edited, non-spammed version) above but got a Delivery Status Notification (Failure) email in response :(

cheers,
Paul.

jdarling

13-04-2006, 01:10 PM

[quote="Robert Kosek"]Wow, that's a sizable unit, even snipped! :)

Well, after checking with the group I got the space at, the accounts weren't compromized, although somehow the hacker gained write access to the entire server. If you mail me a zip of the unit with your readme and license, I'll upload it. Send it to "thewickedflea <(at)> gmail >dot> com", you know the anti-spam drill. ;)

Cool, ok :)

I'll send you a zip file containing a complete demo source and all the needed units in their entirety :)

It would be cool if you could post a ]

Hi Robert,
I tried sending my zip file to your email address (edited, non-spammed version) above but got a Delivery Status Notification (Failure) email in response :(

cheers,
Paul.

If you want, send it to jdarling at eonclash dot com and I'll also be happy to place up a download link for you. Our servers have never been hacked, but they have crashed a few times. Now we have a NAS that backs everything up twice a day :).

On a side note, I've almost completed the class wrapper application that can read in a Delphi file and create class wrappers from it. Maybe you and I should team up and put our stuff together as I think between the two everything is more then covered and could be very useful to others.

jdarling

14-04-2006, 02:08 AM

After quite a bit of work the first Alpha version of Pas2Lua is ready for others to rip apart and help with development. The basic idea is that using a template file for output the unit parses a Pascal Unit, extracts the objects and their definitions and then creates a Lua Wrapper.

You can download the first Alpha exe and all files from:
http://www.eonclash.com/pas2lua/pas2lua.zip

The source (everything needed to compile except SynEdit) can be downloaded from:
http://www.eonclash.com/pas2lua/pas2lua_src.zip

I have performed minimal testing in that I know it parses and constructs for all of the unDelphiX and Delphi VCL components successfully.

Known problems:
It doesn't handle overloaded methods very nicely (you have to go in and play with the output)
Wrapper methods don't always exist for types, thus you have to create them some times (hey thats always going to be true)
Object Properties don't work right now (I'm lazy and don't have time)

Hope everyone finds this of some use and not just a waste of my time :)

paul_nicholls

17-04-2006, 10:45 AM

[quote="Robert Kosek"]Wow, that's a sizable unit, even snipped! :)

Well, after checking with the group I got the space at, the accounts weren't compromized, although somehow the hacker gained write access to the entire server. If you mail me a zip of the unit with your readme and license, I'll upload it. Send it to "thewickedflea <(at)> gmail >dot> com", you know the anti-spam drill. ;)

Cool, ok :)

I'll send you a zip file containing a complete demo source and all the needed units in their entirety :)

It would be cool if you could post a ]

Hi Robert,
I tried sending my zip file to your email address (edited, non-spammed version) above but got a Delivery Status Notification (Failure) email in response :(

cheers,
Paul.

If you want, send it to jdarling at eonclash dot com and I'll also be happy to place up a download link for you. Our servers have never been hacked, but they have crashed a few times. Now we have a NAS that backs everything up twice a day :).

cool, I have resent the zip file to Robert and yourself :-)

On a side note, I've almost completed the class wrapper application that can read in a Delphi file and create class wrappers from it.

nice :-)

Maybe you and I should team up and put our stuff together as I think between the two everything is more then covered and could be very useful to others.

I think that would be an excellent idea! :)
It isn't often I get to help others :-)

For your info, I don't have heaps of free time as I am looking after my wife and new baby daughter, but I would still like to help :)

cheers,
Paul.

jdarling

17-04-2006, 01:09 PM

Well I've found many problems with my importer and can safely say that the code it generates doesn't work right now. Soon though I hope to have it fixed. The basic problem is that I've screwed up some place and now its storing the Self Pointer in the Metatable. Witch means that each new instance changes the Self reference for all existing instances (oops). Have a message out to the LUA Mail Group, as they have helped me to find this type of error many times before.

If anyone is interested in seeing my unDelphiX wrappers at the broken stage you can view them at: http://www.eonclash.com/LUA/DXWrappersLuaImport.pas

Once I get everything working again though this file will be removed and I'll be placing the importer up for download.

Robert Kosek

17-04-2006, 03:21 PM

Interesting stuff guys. :) I'm too busy to try them at the moment, but I'll give you some thoughts on them in ~2 weeks.

You can grab Paul's lua work here: http://freepgs.com/thewickedflea/lua_class.zip

paul_nicholls

19-04-2006, 12:59 PM

Interesting stuff guys. :) I'm too busy to try them at the moment, but I'll give you some thoughts on them in ~2 weeks.

You can grab Paul's lua work here: http://freepgs.com/thewickedflea/lua_class.zip

Thanks again for the hosting of my file :)

cheers,
Paul.

paul_nicholls

01-05-2006, 07:29 AM

Interesting stuff guys. :) I'm too busy to try them at the moment, but I'll give you some thoughts on them in ~2 weeks.

You can grab Paul's lua work here: http://freepgs.com/thewickedflea/lua_class.zip

If for some reason that ]http://www.eonclash.com/LUA/Luaclass.zip[/url]

Paul.

paul_nicholls

08-05-2006, 07:03 AM

Hi al :)

I have been creating an update to my LuaClasses routines. Now I have made it easier to also add LuaRecords to scripts read/write fields :-)

Example Vector3f addition to Lua

Function Vector3f_Read(L: lua_State): Integer; CDecl; Forward;
Function Vector3f_Write(L: lua_State): Integer; CDecl; Forward;
Function Vector3f_Add(L: lua_State): Integer; CDecl; Forward;
Function Vector3f_Sub(L: lua_State): Integer; CDecl; Forward;
Function Vector3f_GC(L: lua_State): Integer; CDecl; Forward;
{................................................. ......}

{................................................. ......}
Function LuaVector3fCheck(L: lua_State; Idx: Integer): PVector3f;
Var
v3f : PVector3f;
Begin
Result := Nil;

If (Not lua_istable(L,Idx)) Then
Begin
LuaDoError(L,'Vector3f expected, found "'+lua_typename(L,lua_type(L,Idx))+'"');
Exit;
End;

lua_getmetatable(L,Idx);

lua_pushstring(L,'_Vector3f');
lua_gettable(L,-2);

If (Not lua_isuserdata(L,-1)) Then
Begin
LuaDoError(L,'Vector3f expected, found "'+lua_typename(L,lua_type(L,Idx))+'"');
Exit;
End;

Result := lua_touserdata(L,-1);
End;
{................................................. ......}

{................................................. ......}
Procedure Vector3f_PushOntoLuaStack(L: lua_State; V3f: PVector3f);
Var
Table : Integer;
MT : Integer;
Begin
lua_newtable(L);

Table := lua_gettop(L);

// create a meta table
lua_newtable(L);

MT := lua_gettop(L);

lua_pushstring(L,'__index');
lua_pushcfunction(L,Vector3f_Read);
lua_settable(L,MT);

lua_pushstring(L,'__newindex');
lua_pushcfunction(L,Vector3f_Write);
lua_settable(L,MT);

lua_pushstring(L,'__add');
lua_pushcfunction(L,Vector3f_Add);
lua_settable(L,MT);

lua_pushstring(L,'__sub');
lua_pushcfunction(L,Vector3f_Sub);
lua_settable(L,MT);

lua_pushstring(L,'__gc');
lua_pushcfunction(L,Vector3f_GC);
lua_settable(L,MT);

lua_pushstring(L,'_Vector3f');
lua_pushlightuserdata(L,V3f);
lua_settable(L,MT);

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

{................................................. ......}
Function Vector3f_New(L: lua_State): Integer; CDecl;
Var
V3f : PVector3f;
Begin
New(V3f);

V3f^.x := luaL_checknumber(L,1);
V3f^.y := luaL_checknumber(L,2);
V3f^.z := luaL_checknumber(L,3);

Vector3f_PushOntoLuaStack(L,V3f);

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

{................................................. ......}
Function Vector3f_Read(L: lua_State): Integer; CDecl;
Var
V3f : PVector3f;
Key : AnsiString;
Begin
Result := 0;

V3f := LuaVector3fCheck(L,1);

If (V3f = Nil) Then
Exit;

Key := luaL_checkstring(L,2);

If (Key = 'x') Then
lua_pushnumber(L,V3f^.x)
Else
If (Key = 'y') Then
lua_pushnumber(L,V3f^.y)
Else
If (Key = 'z') Then
lua_pushnumber(L,V3f^.z)
Else
Begin
LuaDoError(L,'Vector3f: unknown field "' + Key + '"');
End;

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

{................................................. ......}
Function Vector3f_Write(L: lua_State): Integer; CDecl;
Var
V3f : PVector3f;
Key : AnsiString;
Begin
Result := 0;

V3f := LuaVector3fCheck(L,1);

If (V3f = Nil) Then
Exit;

Key := luaL_checkstring(L,2);

If (Key = 'x') Then
V3f^.x := luaL_checknumber(L,3)
Else
If (Key = 'y') Then
V3f^.y := luaL_checknumber(L,3)
Else
If (Key = 'z') Then
V3f^.z := luaL_checknumber(L,3)
Else
Begin
LuaDoError(L,'Vector3f: unknown field "' + Key + '"');
End;

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

{................................................. ......}
Function Vector3f_Add(L: lua_State): Integer; CDecl;
Var
v1,v2,v3 : PVector3f;
Key : AnsiString;
Begin
Result := 0;

v1 := LuaVector3fCheck(L,1);
v2 := LuaVector3fCheck(L,2);

If (v1 = Nil) Or (v2 = Nil) Then
Exit;

New(v3);

v3^.x := v1^.x + v2^.x;
v3^.y := v1^.y + v2^.y;
v3^.z := v1^.z + v2^.z;

Vector3f_PushOntoLuaStack(L,v3);

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

{................................................. ......}
Function Vector3f_Sub(L: lua_State): Integer; CDecl;
Var
v1,v2,v3 : PVector3f;
Key : AnsiString;
Begin
Result := 0;

v1 := LuaVector3fCheck(L,1);
v2 := LuaVector3fCheck(L,2);

If (v1 = Nil) Or (v2 = Nil) Then
Exit;

New(v3);

v3^.x := v1^.x - v2^.x;
v3^.y := v1^.y - v2^.y;
v3^.z := v1^.z - v2^.z;

Vector3f_PushOntoLuaStack(L,v3);

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

{................................................. ......}
Function Vector3f_GC(L: lua_State): Integer; CDecl;
Var
V3f : PVector3f;
Begin
V3f := LuaVector3fCheck(L,1);

If (V3f = Nil) Then
Exit;

Dispose(V3f);

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

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

how to register the record with Lua

// register each record type
RegisterLuaRecord('Vector3f',Vector3f_New);

// register all registered records to the lua state
RegisterLuaRecordsWithLua(Script.State);

Lua script using the record

a = Vector3f(10,20,30)
b = Vector3f(4,5,6)

c = a + b

print(c.x,c.y,c.z)

LuaRecords unit code

Unit LuaRecords;
{................................................. ......}
// created by Paul Nicholls
// Copyright 2006
// Use for anything that you want, but
// please email me with any improvements that you may make :)
//
// Email:
// paul_nicholls.hotmail.com
{................................................. ......}

Interface

Uses
Lua;

Procedure RegisterLuaRecordProcs(ARecordName: AnsiString;
ANewRecordProc: lua_CFunction);
Procedure RegisterLuaRecordsWithLua(L: lua_State);

Implementation

Type
TLuaRecord = Packed Record
RecordName : AnsiString;
ANewRecordProc: lua_CFunction;
End;

TLuaRecordArray = Array Of TLuaRecord;

Var
RegisteredLuaRecords: TLuaRecordArray;

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

{................................................. ......}
Procedure RegisterLuaRecordProcs(ARecordName: AnsiString;
ANewRecordProc: lua_CFunction);
Begin
If (Not Assigned(ANewRecordProc)) Then
Exit;

SetLength(RegisteredLuaRecords,Length(RegisteredLu aRecords) + 1);

RegisteredLuaRecords[High(RegisteredLuaRecords)].R ecordName := ARecordName;
RegisteredLuaRecords[High(RegisteredLuaRecords)].A NewRecordProc := ANewRecordProc;
End;
{................................................. ......}

{................................................. ......}
Procedure RegisterLuaRecordsWithLua(L: lua_State);
Var
i : Integer;
LuaRecord : TLuaRecord;
Begin
For i := 0 To High(RegisteredLuaRecords) Do
Begin
LuaRecord := RegisteredLuaRecords[i];

lua_register(L,PChar(LuaRecord.RecordName),LuaReco rd.ANewRecordProc);
End;
End;
{................................................. ......}

{................................................. ......}
Initialization
SetLength(RegisteredLuaRecords,0);
{................................................. ......}

{................................................. ......}
End.

paul_nicholls

08-05-2006, 07:05 AM

Can someone delete the first post I did?
The second one is more correct and I can't seem to delete it :(

savage

08-05-2006, 08:27 AM

I hope I deleted the right one.

paul_nicholls

08-05-2006, 10:34 PM

I hope I deleted the right one.

Thanks savage, yes you did delete the correct one :)

BTW, I have made another small change to the code.

I have renamed the 'LuaVector3fCheck' function to 'LuaRecordCheck' and am now passing in the RecordName into the function as well to make it a generic LuaRecord checking function.

I then moved it to the LuaRecords unit along with the appropriate interface header for the function.

So you have to change rename the function, make the small code changes to it, move it to the LuaRecords unit and change all references of 'LuaVector3fCheck' in the example code to 'LuaRecordCheck' and add in the 'Vector3f' parameter when using it (substitute for the correct record name when using it for other LuaRecord types like so:

V3f := LuaRecordCheck(L,'Vector3f',1);

New LuaRecordCheck function now in the LuaRecords unit

Function LuaRecordCheck(L: lua_State; RecordName: AnsiString; Idx: Integer): Pointer;
Begin
Result := Nil;

If (Not lua_istable(L,Idx)) Then
Begin
LuaDoError(L,RecordName + ' expected, found "'+lua_typename(L,lua_type(L,Idx))+'"');
Exit;
End;

lua_getmetatable(L,Idx);

lua_pushstring(L,PChar('_' + RecordName));
lua_gettable(L,-2);

If (Not lua_isuserdata(L,-1)) Then
Begin
LuaDoError(L,RecordName + ' expected, found "'+lua_typename(L,lua_type(L,Idx))+'"');
Exit;
End;

Result := lua_touserdata(L,-1);
End;

Enjoy :)

cheers,
Paul.