parent
745c8b5a35
commit
31e205288f
107
Lua.pas
107
Lua.pas
@ -46,14 +46,20 @@ type
|
||||
TLuaLibraries = set of TLuaLibrary;
|
||||
|
||||
TLuaDataType = (LuaNone, LuaNil, LuaNumber, LuaBoolean, LuaString, LuaTable,
|
||||
LuaFunction, LuaUserData, LuaThread, LuaLightUserData);
|
||||
LuaFunction, LuaUserData, LuaThread, LuaLightUserData, LuaCClosure);
|
||||
|
||||
TLuaVariableType = (VariableNone, VariableBoolean, VariableInteger,
|
||||
VariableNumber, VariableUserData, VariableString,
|
||||
VariableTable, VariableFunction);
|
||||
VariableTable, VariableFunction, VariableCFunction);
|
||||
|
||||
ILuaTable = interface;
|
||||
ILuaFunction = interface;
|
||||
ILuaContext = interface;
|
||||
|
||||
|
||||
TLuaCFunction = reference to procedure(Context: ILuaContext);
|
||||
TLuaCMethod = procedure(Context: ILuaContext) of object;
|
||||
TLuaPushFunction = reference to procedure(AFunction: TLuaCFunction);
|
||||
|
||||
|
||||
ILuaVariable = interface
|
||||
@ -68,6 +74,7 @@ type
|
||||
function GetAsString: string;
|
||||
function GetAsTable: ILuaTable;
|
||||
function GetAsFunction: ILuaFunction;
|
||||
function GetAsCFunction: TLuaCFunction;
|
||||
|
||||
procedure SetAsBoolean(ABoolean: Boolean);
|
||||
procedure SetAsInteger(AInteger: Integer);
|
||||
@ -86,6 +93,7 @@ type
|
||||
property AsString: string read GetAsString write SetAsString;
|
||||
property AsTable: ILuaTable read GetAsTable write SetAsTable;
|
||||
property AsFunction: ILuaFunction read GetAsFunction;
|
||||
property AsCFunction: TLuaCFunction read GetAsCFunction;
|
||||
end;
|
||||
|
||||
|
||||
@ -99,6 +107,8 @@ type
|
||||
class operator Implicit(AValue: Pointer): TLuaImplicitVariable;
|
||||
class operator Implicit(const AValue: string): TLuaImplicitVariable;
|
||||
class operator Implicit(AValue: ILuaTable): TLuaImplicitVariable;
|
||||
class operator Implicit(AValue: TLuaCFunction): TLuaImplicitVariable;
|
||||
|
||||
class operator Implicit(AValue: TLuaImplicitVariable): ILuaVariable;
|
||||
class operator Implicit(AValue: TLuaImplicitVariable): Boolean;
|
||||
class operator Implicit(AValue: TLuaImplicitVariable): Integer;
|
||||
@ -223,6 +233,7 @@ type
|
||||
function GetAsString: string;
|
||||
function GetAsTable: ILuaTable;
|
||||
function GetAsFunction: ILuaFunction;
|
||||
function GetAsCFunction: TLuaCFunction;
|
||||
|
||||
procedure SetAsBoolean(ABoolean: Boolean);
|
||||
procedure SetAsInteger(AInteger: Integer);
|
||||
@ -278,11 +289,6 @@ type
|
||||
end;
|
||||
|
||||
|
||||
TLuaCFunction = reference to procedure(Context: ILuaContext);
|
||||
TLuaCMethod = procedure(Context: ILuaContext) of object;
|
||||
TLuaPushFunction = reference to procedure(AFunction: TLuaCFunction);
|
||||
|
||||
|
||||
TCustomLuaRegistration = class(TObject)
|
||||
private
|
||||
FName: string;
|
||||
@ -435,6 +441,7 @@ type
|
||||
class procedure PushVariable(AState: lua_State; AVariable: ILuaVariable; AVariableType: TLuaVariableType); overload;
|
||||
class procedure PushString(AState: lua_State; const AValue: string);
|
||||
class procedure PushTable(AState: lua_State; ATable: ILuaTable);
|
||||
class procedure PushCFunction(AState: lua_State; AClosure: TLuaCFunction);
|
||||
|
||||
class function AllocLuaString(const AValue: string): PAnsiChar;
|
||||
class procedure FreeLuaString(AValue: PAnsiChar);
|
||||
@ -509,6 +516,7 @@ type
|
||||
function GetAsString: string;
|
||||
function GetAsTable: ILuaTable;
|
||||
function GetAsFunction: ILuaFunction;
|
||||
function GetAsCFunction: TLuaCFunction;
|
||||
|
||||
procedure SetAsBoolean(ABoolean: Boolean);
|
||||
procedure SetAsInteger(AInteger: Integer);
|
||||
@ -542,6 +550,7 @@ type
|
||||
FStringValue: string;
|
||||
FTableValue: ILuaTable;
|
||||
FFunctionValue: ILuaFunction;
|
||||
FCFunctionValue: TLuaCFunction;
|
||||
protected
|
||||
property VariableType: TLuaVariableType read FVariableType write FVariableType;
|
||||
property DataType: TLuaDataType read FDataType write FDataType;
|
||||
@ -552,6 +561,7 @@ type
|
||||
property StringValue: string read FStringValue write FStringValue;
|
||||
property TableValue: ILuaTable read FTableValue write FTableValue;
|
||||
property FunctionValue: ILuaFunction read FFunctionValue write FFunctionValue;
|
||||
property CFunctionValue: TLuaCFunction read FCFunctionValue write FCFunctionValue;
|
||||
public
|
||||
constructor Create; overload;
|
||||
constructor Create(ABoolean: Boolean); overload;
|
||||
@ -561,6 +571,7 @@ type
|
||||
constructor Create(const AString: string); overload;
|
||||
constructor Create(ATable: ILuaTable); overload;
|
||||
constructor Create(AFunction: ILuaFunction); overload;
|
||||
constructor Create(AFunction: TLuaCFunction); overload;
|
||||
|
||||
{ ILuaParameter }
|
||||
function GetVariableType: TLuaVariableType;
|
||||
@ -573,6 +584,7 @@ type
|
||||
function GetAsString: string;
|
||||
function GetAsTable: ILuaTable;
|
||||
function GetAsFunction: ILuaFunction;
|
||||
function GetAsCFunction: TLuaCFunction;
|
||||
|
||||
procedure SetAsBoolean(ABoolean: Boolean);
|
||||
procedure SetAsInteger(AInteger: Integer);
|
||||
@ -679,6 +691,7 @@ begin
|
||||
LuaFunction: Result := VariableFunction;
|
||||
LuaUserData: Result := VariableUserData;
|
||||
LuaLightUserData: Result := VariableUserData;
|
||||
LuaCClosure: Result := VariableCFunction;
|
||||
else
|
||||
Result := VariableNone;
|
||||
end;
|
||||
@ -752,6 +765,7 @@ begin
|
||||
|
||||
VariableString: PushString(AState, AVariable.AsString);
|
||||
VariableTable: PushTable(AState, AVariable.AsTable);
|
||||
VariableCFunction: PushCFunction(AState, AVariable.AsCFunction);
|
||||
else
|
||||
raise ELuaUnsupportedVariableException.CreateFmt('Variable type not supported: %d', [Ord(AVariableType)]);
|
||||
end;
|
||||
@ -788,6 +802,43 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function LuaWrapperClosure(L: lua_State): Integer; cdecl;
|
||||
var
|
||||
method: TMethod;
|
||||
closure: TLuaCFunction absolute method;
|
||||
context: ILuaContext;
|
||||
|
||||
begin
|
||||
method.Code := lua_touserdata(L, lua_upvalueindex(1));
|
||||
method.Data := lua_touserdata(L, lua_upvalueindex(2));
|
||||
|
||||
context := TLuaContext.Create(L);
|
||||
try
|
||||
closure(context);
|
||||
Result := context.Result.Count;
|
||||
except
|
||||
on E:Exception do
|
||||
Result := luaL_error(L, PAnsiChar(AnsiString(E.Message)), nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
class procedure TLuaHelpers.PushCFunction(AState: lua_State; AClosure: TLuaCFunction);
|
||||
var
|
||||
method: TMethod absolute AClosure;
|
||||
|
||||
|
||||
begin
|
||||
{ Assume the reference to AClosure is being kept alive by the caller for as long
|
||||
as it's needed, for example by the ILuaVariable that contains it. That way we
|
||||
don't need to keep our own reference, as we can't determine when it's ok to go out
|
||||
of scope, which would result in memory increase on every use. }
|
||||
lua_pushlightuserdata(AState, method.Code);
|
||||
lua_pushlightuserdata(AState, method.Data);
|
||||
lua_pushcclosure(AState, @LuaWrapperClosure, 2);
|
||||
end;
|
||||
|
||||
|
||||
// Casting strings directly to PAnsiChar (via AnsiString) causes corruption
|
||||
// with table values, at least in Delphi XE2. Can't really explain why, seems
|
||||
// the input string goes out of scope, so let's just go through the motions
|
||||
@ -929,6 +980,11 @@ begin
|
||||
Result.Variable := TLuaVariable.Create(AValue);
|
||||
end;
|
||||
|
||||
class operator TLuaImplicitVariable.Implicit(AValue: TLuaCFunction): TLuaImplicitVariable;
|
||||
begin
|
||||
Result.Variable := TLuaVariable.Create(AValue);
|
||||
end;
|
||||
|
||||
|
||||
class operator TLuaImplicitVariable.Implicit(AValue: TLuaImplicitVariable): ILuaVariable;
|
||||
begin
|
||||
@ -1856,6 +1912,12 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TCustomLuaParameters.GetAsCFunction: TLuaCFunction;
|
||||
begin
|
||||
Result := GetDefaultVariable.GetAsCFunction;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCustomLuaParameters.SetAsBoolean(ABoolean: Boolean);
|
||||
begin
|
||||
GetDefaultVariable.SetAsBoolean(ABoolean);
|
||||
@ -1910,7 +1972,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TLuaCFunctionParameters }
|
||||
{ TLuaStackParameters }
|
||||
constructor TLuaStackParameters.Create(AState: lua_State; ACount: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
@ -1938,7 +2000,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TLuaCFunctionParameter }
|
||||
{ TLuaStackVariable }
|
||||
constructor TLuaStackVariable.Create(AState: lua_State; AIndex: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
@ -1993,7 +2055,7 @@ end;
|
||||
function TLuaStackVariable.GetAsTable: ILuaTable;
|
||||
begin
|
||||
if not lua_istable(State, Index) then
|
||||
Result := nil;
|
||||
Exit(nil);
|
||||
|
||||
if not Assigned(FTable) then
|
||||
FTable := TLuaCachedTable.Create(State, Index);
|
||||
@ -2005,12 +2067,18 @@ end;
|
||||
function TLuaStackVariable.GetAsFunction: ILuaFunction;
|
||||
begin
|
||||
if not lua_isfunction(State, Index) then
|
||||
Result := nil;
|
||||
Exit(nil);
|
||||
|
||||
Result := TLuaFunction.Create(State, Index);
|
||||
end;
|
||||
|
||||
|
||||
function TLuaStackVariable.GetAsCFunction: TLuaCFunction;
|
||||
begin
|
||||
raise ELuaUnsupportedVariableException.Create('Can not read stack variables as TLuaCFunction');
|
||||
end;
|
||||
|
||||
|
||||
procedure TLuaStackVariable.SetAsBoolean(ABoolean: Boolean);
|
||||
begin
|
||||
lua_pushboolean(State, IfThen(ABoolean, 1, 0));
|
||||
@ -2152,6 +2220,15 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
constructor TLuaVariable.Create(AFunction: TLuaCFunction);
|
||||
begin
|
||||
Create;
|
||||
VariableType := VariableCFunction;
|
||||
DataType := LuaCClosure;
|
||||
CFunctionValue := AFunction;
|
||||
end;
|
||||
|
||||
|
||||
function TLuaVariable.GetVariableType: TLuaVariableType;
|
||||
begin
|
||||
Result := VariableType;
|
||||
@ -2206,6 +2283,12 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TLuaVariable.GetAsCFunction: TLuaCFunction;
|
||||
begin
|
||||
Result := CFunctionValue;
|
||||
end;
|
||||
|
||||
|
||||
procedure TLuaVariable.SetAsBoolean(ABoolean: Boolean);
|
||||
begin
|
||||
VariableType := VariableBoolean;
|
||||
@ -2477,7 +2560,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TLuaCFunction }
|
||||
{ TLuaFunction }
|
||||
constructor TLuaFunction.Create(AState: lua_State; AIndex: Integer);
|
||||
var
|
||||
actualIndex: Integer;
|
||||
|
@ -46,6 +46,8 @@ type
|
||||
procedure TableOutput;
|
||||
procedure TableDelphiFunction;
|
||||
procedure TableLuaFunction;
|
||||
procedure TableInTable;
|
||||
procedure CFunctionInNestedTable;
|
||||
|
||||
procedure VariableFunction;
|
||||
procedure ByteCode;
|
||||
@ -386,6 +388,55 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TTestWrapper.TableInTable;
|
||||
var
|
||||
inner: ILuaTable;
|
||||
outer: ILuaTable;
|
||||
|
||||
begin
|
||||
inner := TLuaTable.Create;
|
||||
inner.SetValue('text', 'Hello from the inner table!');
|
||||
|
||||
outer := TLuaTable.Create;
|
||||
outer.SetValue('inner', inner);
|
||||
|
||||
Lua.LoadFromString('print(outer.inner.text)', False);
|
||||
Lua.SetGlobalVariable('outer', outer);
|
||||
Lua.Run;
|
||||
|
||||
CheckEquals('Hello from the inner table!', Printed.ToString);
|
||||
end;
|
||||
|
||||
|
||||
{ The fact that it's in a nested table shouldn't matter for registering functions
|
||||
in tables, but it demonstrates https://github.com/MvRens/DelphiLua/issues/2 }
|
||||
procedure TTestWrapper.CFunctionInNestedTable;
|
||||
var
|
||||
inner: ILuaTable;
|
||||
outer: ILuaTable;
|
||||
output: string;
|
||||
|
||||
begin
|
||||
output := '';
|
||||
|
||||
inner := TLuaTable.Create;
|
||||
inner.SetValue('go',
|
||||
procedure(Context: ILuaContext)
|
||||
begin
|
||||
output := Context.Parameters[0].AsString;
|
||||
end);
|
||||
|
||||
outer := TLuaTable.Create;
|
||||
outer.SetValue('inner', inner);
|
||||
|
||||
Lua.LoadFromString('outer.inner.go(''Hello inner function!'')', False);
|
||||
Lua.SetGlobalVariable('outer', outer);
|
||||
Lua.Run;
|
||||
|
||||
CheckEquals('Hello inner function!', output);
|
||||
end;
|
||||
|
||||
|
||||
procedure TTestWrapper.VariableFunction;
|
||||
var
|
||||
functions: ILuaTable;
|
||||
|
Loading…
x
Reference in New Issue
Block a user