Actually included the rename which was supposed to happen in the last commit :)
Added RegisterFunctions method which takes an object and registers all compatible methods either globally or in a table
This commit is contained in:
parent
38866639be
commit
cad2054373
|
@ -22,13 +22,14 @@
|
||||||
3. This notice may not be removed or altered from any source
|
3. This notice may not be removed or altered from any source
|
||||||
distribution.
|
distribution.
|
||||||
}
|
}
|
||||||
unit Lua.Wrapper;
|
unit Lua;
|
||||||
|
|
||||||
interface
|
interface
|
||||||
uses
|
uses
|
||||||
System.Classes,
|
System.Classes,
|
||||||
System.Generics.Collections,
|
System.Generics.Collections,
|
||||||
System.Generics.Defaults,
|
System.Generics.Defaults,
|
||||||
|
System.Rtti,
|
||||||
System.SysUtils,
|
System.SysUtils,
|
||||||
|
|
||||||
Lua.API;
|
Lua.API;
|
||||||
|
@ -223,14 +224,52 @@ type
|
||||||
|
|
||||||
|
|
||||||
TLuaCFunction = reference to procedure(Context: ILuaContext);
|
TLuaCFunction = reference to procedure(Context: ILuaContext);
|
||||||
|
TLuaCMethod = procedure(Context: ILuaContext) of object;
|
||||||
|
TLuaPushFunction = reference to procedure(AFunction: TLuaCFunction);
|
||||||
|
|
||||||
|
|
||||||
TLuaRegisteredFunction = record
|
TCustomLuaRegistration = class(TObject)
|
||||||
Name: string;
|
private
|
||||||
Callback: TLuaCFunction;
|
FName: string;
|
||||||
|
protected
|
||||||
|
property Name: string read FName write FName;
|
||||||
|
public
|
||||||
|
constructor Create(const AName: string);
|
||||||
|
|
||||||
|
procedure Apply(AState: lua_State; APushFunction: TLuaPushFunction); virtual; abstract;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TLuaRegisteredFunctionDictionary = TDictionary<Integer, TLuaRegisteredFunction>;
|
|
||||||
|
TLuaFunctionRegistration = class(TCustomLuaRegistration)
|
||||||
|
private
|
||||||
|
FCallback: TLuaCFunction;
|
||||||
|
protected
|
||||||
|
property Callback: TLuaCFunction read FCallback;
|
||||||
|
public
|
||||||
|
constructor Create(const AName: string; ACallback: TLuaCFunction);
|
||||||
|
|
||||||
|
procedure Apply(AState: lua_State; APushFunction: TLuaPushFunction); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TLuaFunctionTable = TDictionary<string, TLuaCFunction>;
|
||||||
|
|
||||||
|
TLuaTableRegistration = class(TCustomLuaRegistration)
|
||||||
|
private
|
||||||
|
FFunctionTable: TLuaFunctionTable;
|
||||||
|
protected
|
||||||
|
property FunctionTable: TLuaFunctionTable read FFunctionTable;
|
||||||
|
public
|
||||||
|
constructor Create(const AName: string);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
procedure RegisterFunction(const AName: string; AFunction: TLuaCFunction); virtual;
|
||||||
|
procedure Apply(AState: lua_State; APushFunction: TLuaPushFunction); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TLuaRegistrationList = TObjectList<TCustomLuaRegistration>;
|
||||||
|
TLuaRegisteredFunctionDictionary = TDictionary<Integer, TLuaCFunction>;
|
||||||
|
|
||||||
|
|
||||||
TLuaScript = class(TObject)
|
TLuaScript = class(TObject)
|
||||||
|
@ -251,20 +290,21 @@ type
|
||||||
private
|
private
|
||||||
FState: lua_State;
|
FState: lua_State;
|
||||||
FLoaded: Boolean;
|
FLoaded: Boolean;
|
||||||
|
FRegistrations: TLuaRegistrationList;
|
||||||
FRegisteredFunctions: TLuaRegisteredFunctionDictionary;
|
FRegisteredFunctions: TLuaRegisteredFunctionDictionary;
|
||||||
FRegisteredFunctionCookie: Integer;
|
FRegisteredFunctionCookie: Integer;
|
||||||
FAutoOpenLibraries: TLuaLibraries;
|
FAutoOpenLibraries: TLuaLibraries;
|
||||||
FHasRun: Boolean;
|
FHasRun: Boolean;
|
||||||
|
FRttiContext: TRttiContext;
|
||||||
function GetHasState: Boolean;
|
|
||||||
function GetState: lua_State;
|
|
||||||
function GetRegisteredFunctions: TLuaRegisteredFunctionDictionary;
|
|
||||||
protected
|
protected
|
||||||
|
function GetHasState: Boolean; virtual;
|
||||||
|
function GetState: lua_State; virtual;
|
||||||
|
|
||||||
function DoAlloc(APointer: Pointer; AOldSize, ANewSize: Cardinal): Pointer; virtual;
|
function DoAlloc(APointer: Pointer; AOldSize, ANewSize: Cardinal): Pointer; virtual;
|
||||||
|
|
||||||
procedure DoNewState; virtual;
|
procedure DoNewState; virtual;
|
||||||
procedure DoClose; virtual;
|
procedure DoClose; virtual;
|
||||||
procedure DoRegisterFunction(ACookie: Integer); virtual;
|
procedure DoRegistration(ARegistration: TCustomLuaRegistration); virtual;
|
||||||
|
|
||||||
procedure SetAutoOpenLibraries(const Value: TLuaLibraries); virtual;
|
procedure SetAutoOpenLibraries(const Value: TLuaLibraries); virtual;
|
||||||
protected
|
protected
|
||||||
|
@ -272,12 +312,14 @@ type
|
||||||
procedure CheckIsFunction; virtual;
|
procedure CheckIsFunction; virtual;
|
||||||
procedure AfterLoad; virtual;
|
procedure AfterLoad; virtual;
|
||||||
|
|
||||||
|
procedure AddRegistration(ARegistration: TCustomLuaRegistration); virtual;
|
||||||
function GetRegisteredFunctionCookie: Integer; virtual;
|
function GetRegisteredFunctionCookie: Integer; virtual;
|
||||||
function RunRegisteredFunction(ACookie: Integer): Integer; virtual;
|
function RunRegisteredFunction(ACookie: Integer): Integer; virtual;
|
||||||
|
|
||||||
property Loaded: Boolean read FLoaded write FLoaded;
|
property Loaded: Boolean read FLoaded write FLoaded;
|
||||||
property HasRun: Boolean read FHasRun write FHasRun;
|
property HasRun: Boolean read FHasRun write FHasRun;
|
||||||
property RegisteredFunctions: TLuaRegisteredFunctionDictionary read GetRegisteredFunctions;
|
property Registrations: TLuaRegistrationList read FRegistrations;
|
||||||
|
property RegisteredFunctions: TLuaRegisteredFunctionDictionary read FRegisteredFunctions;
|
||||||
public
|
public
|
||||||
constructor Create;
|
constructor Create;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
@ -290,6 +332,14 @@ type
|
||||||
function GetGlobalVariable(const AName: string): ILuaVariable; virtual;
|
function GetGlobalVariable(const AName: string): ILuaVariable; virtual;
|
||||||
procedure SetGlobalVariable(const AName: string; AVariable: TLuaImplicitVariable); virtual;
|
procedure SetGlobalVariable(const AName: string; AVariable: TLuaImplicitVariable); virtual;
|
||||||
procedure RegisterFunction(const AName: string; AFunction: TLuaCFunction); virtual;
|
procedure RegisterFunction(const AName: string; AFunction: TLuaCFunction); virtual;
|
||||||
|
// procedure UnregisterFunction();
|
||||||
|
|
||||||
|
{ Registers all published methods of the specified object. If ATableName
|
||||||
|
is provided, the methods will be bundled in a global table and accessible as
|
||||||
|
ATableName.Method(). If not provided, the methods are accessible directly
|
||||||
|
as global functions. }
|
||||||
|
procedure RegisterFunctions(AObject: TObject; const ATableName: string = ''; AIncludePublicVisibility: Boolean = False); virtual;
|
||||||
|
// procedure UnregisterFunctions();
|
||||||
|
|
||||||
procedure OpenLibraries(ALibraries: TLuaLibraries); virtual;
|
procedure OpenLibraries(ALibraries: TLuaLibraries); virtual;
|
||||||
|
|
||||||
|
@ -339,7 +389,8 @@ type
|
||||||
implementation
|
implementation
|
||||||
uses
|
uses
|
||||||
System.Math,
|
System.Math,
|
||||||
System.SyncObjs;
|
System.SyncObjs,
|
||||||
|
System.TypInfo;
|
||||||
|
|
||||||
|
|
||||||
type
|
type
|
||||||
|
@ -1039,6 +1090,91 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TCustomLuaRegistration }
|
||||||
|
constructor TCustomLuaRegistration.Create(const AName: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FName := AName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TLuaFunctionRegistration }
|
||||||
|
procedure TLuaFunctionRegistration.Apply(AState: lua_State; APushFunction: TLuaPushFunction);
|
||||||
|
var
|
||||||
|
functionName: PAnsiChar;
|
||||||
|
|
||||||
|
begin
|
||||||
|
functionName := TLuaHelpers.AllocLuaString(Name);
|
||||||
|
try
|
||||||
|
APushFunction(Callback);
|
||||||
|
lua_setglobal(AState, functionName);
|
||||||
|
finally
|
||||||
|
TLuaHelpers.FreeLuaString(functionName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TLuaFunctionRegistration.Create(const AName: string; ACallback: TLuaCFunction);
|
||||||
|
begin
|
||||||
|
inherited Create(AName);
|
||||||
|
|
||||||
|
FCallback := ACallback;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TLuaTableRegistration }
|
||||||
|
constructor TLuaTableRegistration.Create(const AName: string);
|
||||||
|
begin
|
||||||
|
inherited Create(AName);
|
||||||
|
|
||||||
|
FFunctionTable := TLuaFunctionTable.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TLuaTableRegistration.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FFunctionTable);
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TLuaTableRegistration.RegisterFunction(const AName: string; AFunction: TLuaCFunction);
|
||||||
|
begin
|
||||||
|
FunctionTable.AddOrSetValue(AName, AFunction);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TLuaTableRegistration.Apply(AState: lua_State; APushFunction: TLuaPushFunction);
|
||||||
|
var
|
||||||
|
pair: TPair<string, TLuaCFunction>;
|
||||||
|
functionName: PAnsiChar;
|
||||||
|
tableName: PAnsiChar;
|
||||||
|
|
||||||
|
begin
|
||||||
|
lua_newtable(AState);
|
||||||
|
|
||||||
|
for pair in FunctionTable do
|
||||||
|
begin
|
||||||
|
functionName := TLuaHelpers.AllocLuaString(pair.Key);
|
||||||
|
try
|
||||||
|
lua_pushstring(AState, functionName);
|
||||||
|
APushFunction(pair.Value);
|
||||||
|
lua_settable(AState, -3);
|
||||||
|
finally
|
||||||
|
TLuaHelpers.FreeLuaString(functionName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
tableName := TLuaHelpers.AllocLuaString(Name);
|
||||||
|
try
|
||||||
|
lua_setglobal(AState, tableName);
|
||||||
|
finally
|
||||||
|
TLuaHelpers.FreeLuaString(tableName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TLuaScript }
|
{ TLuaScript }
|
||||||
constructor TLuaScript.Create(const AData: string);
|
constructor TLuaScript.Create(const AData: string);
|
||||||
begin
|
begin
|
||||||
|
@ -1139,12 +1275,15 @@ begin
|
||||||
inherited Create;
|
inherited Create;
|
||||||
|
|
||||||
FAutoOpenLibraries := [TLuaLibrary.All];
|
FAutoOpenLibraries := [TLuaLibrary.All];
|
||||||
|
FRegistrations := TLuaRegistrationList.Create(True);
|
||||||
|
FRegisteredFunctions := TLuaRegisteredFunctionDictionary.Create;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
destructor TLua.Destroy;
|
destructor TLua.Destroy;
|
||||||
begin
|
begin
|
||||||
FreeAndNil(FRegisteredFunctions);
|
FreeAndNil(FRegisteredFunctions);
|
||||||
|
FreeAndNil(FRegistrations);
|
||||||
|
|
||||||
if HasState then
|
if HasState then
|
||||||
DoClose;
|
DoClose;
|
||||||
|
@ -1353,15 +1492,15 @@ end;
|
||||||
|
|
||||||
procedure TLua.AfterLoad;
|
procedure TLua.AfterLoad;
|
||||||
var
|
var
|
||||||
cookie: Integer;
|
registration: TCustomLuaRegistration;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Loaded := True;
|
Loaded := True;
|
||||||
HasRun := False;
|
HasRun := False;
|
||||||
|
|
||||||
{ Register functions in the current environment }
|
{ Register functions in the current environment }
|
||||||
for cookie in RegisteredFunctions.Keys do
|
for registration in Registrations do
|
||||||
DoRegisterFunction(cookie);
|
DoRegistration(registration);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
@ -1398,21 +1537,60 @@ end;
|
||||||
|
|
||||||
|
|
||||||
procedure TLua.RegisterFunction(const AName: string; AFunction: TLuaCFunction);
|
procedure TLua.RegisterFunction(const AName: string; AFunction: TLuaCFunction);
|
||||||
var
|
|
||||||
registeredFunction: TLuaRegisteredFunction;
|
|
||||||
cookie: Integer;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{ Since anonymous methods are basically interfaces, we need to keep a reference around }
|
{ Since anonymous methods are basically interfaces, we need to keep a reference around }
|
||||||
registeredFunction.Name := AName;
|
AddRegistration(TLuaFunctionRegistration.Create(AName, AFunction));
|
||||||
registeredFunction.Callback := AFunction;
|
end;
|
||||||
|
|
||||||
cookie := GetRegisteredFunctionCookie;
|
|
||||||
RegisteredFunctions.Add(cookie, registeredFunction);
|
|
||||||
|
|
||||||
{ Only register functions after Load, otherwise they'll not be available in the environment }
|
procedure TLua.RegisterFunctions(AObject: TObject; const ATableName: string; AIncludePublicVisibility: Boolean);
|
||||||
if Loaded then
|
|
||||||
DoRegisterFunction(cookie);
|
{ This wrapper is needed because Delphi's anonymous functions capture
|
||||||
|
variables, not values. We need a stable 'callback' here. }
|
||||||
|
function CaptureCallback(AMethod: TMethod): TLuaCFunction; inline;
|
||||||
|
begin
|
||||||
|
Result := TLuaCMethod(AMethod);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
rttiType: TRttiType;
|
||||||
|
rttiMethod: TRttiMethod;
|
||||||
|
rttiParameters: TArray<System.Rtti.TRttiParameter>;
|
||||||
|
callback: TMethod;
|
||||||
|
tableRegistration: TLuaTableRegistration;
|
||||||
|
|
||||||
|
begin
|
||||||
|
tableRegistration := nil;
|
||||||
|
if Length(ATableName) > 0 then
|
||||||
|
tableRegistration := TLuaTableRegistration.Create(ATableName);
|
||||||
|
|
||||||
|
rttiType := FRttiContext.GetType(AObject.ClassType);
|
||||||
|
for rttiMethod in rttiType.GetMethods do
|
||||||
|
begin
|
||||||
|
if (rttiMethod.Visibility = mvPublished) or
|
||||||
|
(AIncludePublicVisibility and (rttiMethod.Visibility = mvPublic)) then
|
||||||
|
begin
|
||||||
|
rttiParameters := rttiMethod.GetParameters;
|
||||||
|
|
||||||
|
{ Check if one parameter of type ILuaContext is present }
|
||||||
|
if (Length(rttiParameters) = 1) and
|
||||||
|
(Assigned(rttiParameters[0].ParamType)) and
|
||||||
|
(rttiParameters[0].ParamType.TypeKind = tkInterface) and
|
||||||
|
(TRttiInterfaceType(rttiParameters[0].ParamType).GUID = ILuaContext) then
|
||||||
|
begin
|
||||||
|
callback.Code := rttiMethod.CodeAddress;
|
||||||
|
callback.Data := AObject;
|
||||||
|
|
||||||
|
if Assigned(tableRegistration) then
|
||||||
|
tableRegistration.RegisterFunction(rttiMethod.Name, CaptureCallback(callback))
|
||||||
|
else
|
||||||
|
AddRegistration(TLuaFunctionRegistration.Create(rttiMethod.Name, CaptureCallback(callback)));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Assigned(tableRegistration) then
|
||||||
|
AddRegistration(tableRegistration);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
@ -1439,21 +1617,30 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TLua.DoRegisterFunction(ACookie: Integer);
|
procedure TLua.DoRegistration(ARegistration: TCustomLuaRegistration);
|
||||||
var
|
|
||||||
name: PAnsiChar;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
name := TLuaHelpers.AllocLuaString(RegisteredFunctions[ACookie].Name);
|
ARegistration.Apply(State,
|
||||||
try
|
procedure(AFunction: TLuaCFunction)
|
||||||
lua_pushlightuserdata(State, Self);
|
var
|
||||||
lua_pushinteger(State, ACookie);
|
cookie: Integer;
|
||||||
|
|
||||||
lua_pushcclosure(State, @LuaWrapperFunction, 2);
|
begin
|
||||||
lua_setglobal(State, name);
|
cookie := GetRegisteredFunctionCookie;
|
||||||
finally
|
RegisteredFunctions.Add(cookie, AFunction);
|
||||||
TLuaHelpers.FreeLuaString(name);
|
|
||||||
end;
|
lua_pushlightuserdata(State, Self);
|
||||||
|
lua_pushinteger(State, Cookie);
|
||||||
|
lua_pushcclosure(State, @LuaWrapperFunction, 2);
|
||||||
|
end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLua.AddRegistration(ARegistration: TCustomLuaRegistration);
|
||||||
|
begin
|
||||||
|
Registrations.Add(ARegistration);
|
||||||
|
|
||||||
|
{ Only register functions after Load, otherwise they'll not be available in the environment }
|
||||||
|
if Loaded then
|
||||||
|
DoRegistration(ARegistration);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
@ -1475,7 +1662,7 @@ begin
|
||||||
begin
|
begin
|
||||||
context := TLuaContext.Create(State);
|
context := TLuaContext.Create(State);
|
||||||
|
|
||||||
RegisteredFunctions[ACookie].Callback(context);
|
RegisteredFunctions[ACookie](context);
|
||||||
Result := context.Result.Count;
|
Result := context.Result.Count;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
@ -1494,15 +1681,6 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TLua.GetRegisteredFunctions: TLuaRegisteredFunctionDictionary;
|
|
||||||
begin
|
|
||||||
if not Assigned(FRegisteredFunctions) then
|
|
||||||
FRegisteredFunctions := TLuaRegisteredFunctionDictionary.Create;
|
|
||||||
|
|
||||||
Result := FRegisteredFunctions;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure TLua.SetAutoOpenLibraries(const Value: TLuaLibraries);
|
procedure TLua.SetAutoOpenLibraries(const Value: TLuaLibraries);
|
||||||
begin
|
begin
|
||||||
FAutoOpenLibraries := Value;
|
FAutoOpenLibraries := Value;
|
||||||
|
@ -2264,5 +2442,4 @@ begin
|
||||||
Result := TLuaHelpers.CallFunction(State, AParameters);
|
Result := TLuaHelpers.CallFunction(State, AParameters);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
end.
|
end.
|
|
@ -4,8 +4,8 @@ uses
|
||||||
Forms,
|
Forms,
|
||||||
DUnitTestRunner,
|
DUnitTestRunner,
|
||||||
TestAPI in 'source\TestAPI.pas',
|
TestAPI in 'source\TestAPI.pas',
|
||||||
|
Lua.API in '..\Lua.API.pas',
|
||||||
Lua in '..\Lua.pas',
|
Lua in '..\Lua.pas',
|
||||||
Lua.Wrapper in '..\Lua.Wrapper.pas',
|
|
||||||
TestWrapper in 'source\TestWrapper.pas';
|
TestWrapper in 'source\TestWrapper.pas';
|
||||||
|
|
||||||
{$R *.RES}
|
{$R *.RES}
|
||||||
|
|
|
@ -87,8 +87,8 @@
|
||||||
<MainSource>MainSource</MainSource>
|
<MainSource>MainSource</MainSource>
|
||||||
</DelphiCompile>
|
</DelphiCompile>
|
||||||
<DCCReference Include="source\TestAPI.pas"/>
|
<DCCReference Include="source\TestAPI.pas"/>
|
||||||
|
<DCCReference Include="..\Lua.API.pas"/>
|
||||||
<DCCReference Include="..\Lua.pas"/>
|
<DCCReference Include="..\Lua.pas"/>
|
||||||
<DCCReference Include="..\Lua.Wrapper.pas"/>
|
|
||||||
<DCCReference Include="source\TestWrapper.pas"/>
|
<DCCReference Include="source\TestWrapper.pas"/>
|
||||||
<BuildConfiguration Include="Release">
|
<BuildConfiguration Include="Release">
|
||||||
<Key>Cfg_2</Key>
|
<Key>Cfg_2</Key>
|
||||||
|
|
|
@ -18,6 +18,8 @@ type
|
||||||
procedure SetUp; override;
|
procedure SetUp; override;
|
||||||
procedure TearDown; override;
|
procedure TearDown; override;
|
||||||
|
|
||||||
|
procedure Print(AContext: ILuaContext);
|
||||||
|
|
||||||
property Lua: TLua read FLua;
|
property Lua: TLua read FLua;
|
||||||
property Printed: TStringBuilder read FPrinted;
|
property Printed: TStringBuilder read FPrinted;
|
||||||
published
|
published
|
||||||
|
@ -48,6 +50,9 @@ type
|
||||||
procedure ByteCode;
|
procedure ByteCode;
|
||||||
procedure Capture;
|
procedure Capture;
|
||||||
procedure DenyRequire;
|
procedure DenyRequire;
|
||||||
|
|
||||||
|
procedure RegisterObject;
|
||||||
|
procedure RegisterObjectTable;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
@ -60,6 +65,17 @@ type
|
||||||
TProtectedLua = class(TLua);
|
TProtectedLua = class(TLua);
|
||||||
|
|
||||||
|
|
||||||
|
TTestObject = class(TPersistent)
|
||||||
|
private
|
||||||
|
FOutput: TStringBuilder;
|
||||||
|
public
|
||||||
|
constructor Create(AOutput: TStringBuilder);
|
||||||
|
published
|
||||||
|
procedure Method1(AContext: ILuaContext);
|
||||||
|
procedure Method2(AContext: ILuaContext);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TTestWrapper }
|
{ TTestWrapper }
|
||||||
procedure TTestWrapper.SetUp;
|
procedure TTestWrapper.SetUp;
|
||||||
begin
|
begin
|
||||||
|
@ -69,11 +85,7 @@ begin
|
||||||
|
|
||||||
FLua := TLua.Create;
|
FLua := TLua.Create;
|
||||||
FLua.AutoOpenLibraries := [StringLib];
|
FLua.AutoOpenLibraries := [StringLib];
|
||||||
FLua.RegisterFunction('print',
|
FLua.RegisterFunction('print', Print);
|
||||||
procedure(AContext: ILuaContext)
|
|
||||||
begin
|
|
||||||
FPrinted.Append(AContext.Parameters.ToString);
|
|
||||||
end);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
@ -86,6 +98,12 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TTestWrapper.Print(AContext: ILuaContext);
|
||||||
|
begin
|
||||||
|
FPrinted.Append(AContext.Parameters.ToString);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TTestWrapper.NewState;
|
procedure TTestWrapper.NewState;
|
||||||
begin
|
begin
|
||||||
TProtectedLua(Lua).CheckState;
|
TProtectedLua(Lua).CheckState;
|
||||||
|
@ -424,6 +442,61 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TTestWrapper.RegisterObject;
|
||||||
|
var
|
||||||
|
testObject: TTestObject;
|
||||||
|
|
||||||
|
begin
|
||||||
|
testObject := TTestObject.Create(FPrinted);
|
||||||
|
try
|
||||||
|
Lua.RegisterFunctions(testObject);
|
||||||
|
Lua.LoadFromString('Method1("Hello")'#13#10 +
|
||||||
|
'Method2("world!")');
|
||||||
|
|
||||||
|
CheckEquals('Method1:HelloMethod2:world!', Printed.ToString);
|
||||||
|
finally
|
||||||
|
FreeAndNil(testObject);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TTestWrapper.RegisterObjectTable;
|
||||||
|
var
|
||||||
|
testObject: TTestObject;
|
||||||
|
|
||||||
|
begin
|
||||||
|
testObject := TTestObject.Create(FPrinted);
|
||||||
|
try
|
||||||
|
Lua.RegisterFunctions(testObject, 'Test');
|
||||||
|
Lua.LoadFromString('Test.Method1("Hello")'#13#10 +
|
||||||
|
'Test.Method2("world!")');
|
||||||
|
|
||||||
|
CheckEquals('Method1:HelloMethod2:world!', Printed.ToString);
|
||||||
|
finally
|
||||||
|
FreeAndNil(testObject);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TTestObject }
|
||||||
|
constructor TTestObject.Create(AOutput: TStringBuilder);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FOutput := AOutput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TTestObject.Method1(AContext: ILuaContext);
|
||||||
|
begin
|
||||||
|
FOutput.Append('Method1:' + AContext.Parameters[0].AsString);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestObject.Method2(AContext: ILuaContext);
|
||||||
|
begin
|
||||||
|
FOutput.Append('Method2:' + AContext.Parameters[0].AsString);
|
||||||
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterTest(TTestWrapper.Suite);
|
RegisterTest(TTestWrapper.Suite);
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue