Code:
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.Objects[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],Integer(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.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
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(DataStoreRef));
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.
Code:
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,
Bookmarks