diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5a1f635 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +__history +*.local +*.dcu +*.exe +*.identcache diff --git a/G940LEDControl/Bin/lua52.dll b/G940LEDControl/Bin/lua52.dll new file mode 100644 index 0000000..d5c63a5 Binary files /dev/null and b/G940LEDControl/Bin/lua52.dll differ diff --git a/G940LEDControl/DelphiLua/Lua.API.pas b/G940LEDControl/DelphiLua/Lua.API.pas new file mode 100644 index 0000000..6ef1730 --- /dev/null +++ b/G940LEDControl/DelphiLua/Lua.API.pas @@ -0,0 +1,767 @@ +{ + Header for Lua 5.2.1 Binaries DLL + http://luabinaries.sourceforge.net/ + + Delphi conversion by M. van Renswoude, April 2014: + + This software is provided 'as-is', without any express or implied + warranty. In no event will the authors be held liable for any damages + arising from the use of this software. + + Permission is granted to anyone to use this software for any purpose, + including commercial applications, and to alter it and redistribute it + freely, subject to the following restrictions: + + 1. The origin of this software must not be misrepresented; you must not + claim that you wrote the original software. If you use this software + in a product, an acknowledgment in the product documentation would be + appreciated but is not required. + + 2. Altered source versions must be plainly marked as such, and must not be + misrepresented as being the original software. + + 3. This notice may not be removed or altered from any source + distribution. +} +unit Lua.API; + +interface +uses + System.SysUtils; + + +const + LUA_VERSION_MAJOR = '5'; + LUA_VERSION_MINOR = '2'; + LUA_VERSION_NUM = 502; + LUA_VERSION_RELEASE = '1'; + + LUA_VERSION_ = 'Lua ' + LUA_VERSION_MAJOR + '.' + LUA_VERSION_MINOR; + LUA_RELEASE = LUA_VERSION_ + '.' + LUA_VERSION_RELEASE; + LUA_COPYRIGHT = LUA_RELEASE + ' Copyright (C) 1994-2012 Lua.org, PUC-Rio'; + LUA_AUTHORS = 'R. Ierusalimschy, L. H. de Figueiredo, W. Celes'; + + + { mark for precompiled code ('Lua') } + LUA_SIGNATURE = #33'Lua'; + + { option for multiple returns in 'lua_pcall' and 'lua_call' } + LUA_MULTRET = -1; + + { reserve some space for error handling } + LUAI_MAXSTACK = 1000000; + LUAI_FIRSTPSEUDOIDX = (-LUAI_MAXSTACK - 1000); + + { pseudo-indices } + LUA_REGISTRYINDEX = LUAI_FIRSTPSEUDOIDX; + + function lua_upvalueindex(idx: Integer): Integer; inline; + +const + { thread status } + LUA_OK = 0; + LUA_YIELD_ = 1; + LUA_ERRRUN = 2; + LUA_ERRSYNTAX = 3; + LUA_ERRMEM = 4; + LUA_ERRGCMM = 5; + LUA_ERRERR = 6; + + +type + size_t = NativeUint; + psize_t = ^size_t; + + lua_State = type Pointer; + lua_CFunction = function(L: lua_State): Integer; cdecl; + + { functions that read/write blocks when loading/dumping Lua chunks } + lua_Reader = function(L: lua_State; ud: Pointer; var sz: size_t): PAnsiChar; cdecl; + lua_Writer = function(L: lua_State; p: Pointer; sz: size_t; ud: Pointer): Integer; cdecl; + + { prototype for memory-allocation functions } + lua_Alloc = function(ud, ptr: Pointer; osize, nsize: size_t): Pointer; cdecl; + +const + { basic types } + LUA_TNONE = (-1); + + LUA_TNIL = 0; + LUA_TBOOLEAN = 1; + LUA_TLIGHTUSERDATA = 2; + LUA_TNUMBER = 3; + LUA_TSTRING = 4; + LUA_TTABLE = 5; + LUA_TFUNCTION = 6; + LUA_TUSERDATA = 7; + LUA_TTHREAD = 8; + + LUA_NUMTAGS = 9; + + { minimum Lua stack available to a C function } + LUA_MINSTACK = 20; + + + { predefined values in the registry } + LUA_RIDX_MAINTHREAD = 1; + LUA_RIDX_GLOBALS = 2; + LUA_RIDX_LAST = LUA_RIDX_GLOBALS; + + +type + { type of numbers in Lua } + lua_Number = type Double; + + { type for integer functions } + lua_Integer = type Integer; + + { unsigned integer type } + lua_Unsigned = type Cardinal; + + +var + { state manipulation } + lua_newstate: function(f: lua_Alloc; ud: Pointer): lua_State; cdecl; + lua_close: procedure(L: lua_State); cdecl; + lua_newthread: function(L: lua_State): lua_State; cdecl; + + lua_atpanic: function(L: lua_State; panicf: lua_CFunction): lua_CFunction; cdecl; + lua_version: function(L: lua_State): lua_Number; cdecl; + + { basic stack manipulation } + lua_absindex: function(L: lua_State; idx: Integer): Integer; cdecl; + lua_gettop: function(L: lua_State): Integer; cdecl; + + lua_settop: procedure(L: lua_State; idx: Integer); cdecl; + lua_pushvalue: procedure(L: lua_State; idx: Integer); cdecl; + lua_remove: procedure(L: lua_State; idx: Integer); cdecl; + lua_insert: procedure(L: lua_State; idx: Integer); cdecl; + lua_replace: procedure(L: lua_State; idx: Integer); cdecl; + lua_copy: procedure(L: lua_State; fromidx, toidx: Integer); cdecl; + lua_checkstack: function(L: lua_State; sz: Integer): Integer; cdecl; + + lua_xmove: procedure(from: lua_State; _to: lua_State; n: Integer); cdecl; + + { access functions (stack -> C) } + lua_isnumber: function (L: lua_State; idx: Integer): Integer; cdecl; + lua_isstring: function (L: lua_State; idx: Integer): Integer; cdecl; + lua_iscfunction: function (L: lua_State; idx: Integer): Integer; cdecl; + lua_isuserdata: function (L: lua_State; idx: Integer): Integer; cdecl; + lua_type: function (L: lua_State; idx: Integer): Integer; cdecl; + lua_typename: function (L: lua_State; tp: Integer): PAnsiChar; cdecl; + lua_tonumberx: function (L: lua_State; idx: Integer; isnum: PInteger): lua_Number; cdecl; + lua_tointegerx: function (L: lua_State; idx: Integer; isnum: PInteger): lua_Integer; cdecl; + lua_tounsignedx: function (L: lua_State; idx: Integer; isnum: PInteger): lua_Unsigned; cdecl; + lua_toboolean: function (L: lua_State; idx: Integer): Integer; cdecl; + lua_tolstring: function(L: lua_State; idx: Integer; len: psize_t): PAnsiChar; cdecl; + lua_rawlen: function (L: lua_State; idx: Integer): size_t; cdecl; + lua_tocfunction: function (L: lua_State; idx: Integer): lua_CFunction; cdecl; + lua_touserdata: function (L: lua_State; idx: Integer): Pointer; cdecl; + lua_tothread: function (L: lua_State; idx: Integer): lua_State; cdecl; + lua_topointer: function (L: lua_State; idx: Integer): Pointer; cdecl; + + +const + { Comparison and arithmetic functions } + LUA_OPADD = 0; { ORDER TM } + LUA_OPSUB = 1; + LUA_OPMUL = 2; + LUA_OPDIV = 3; + LUA_OPMOD = 4; + LUA_OPPOW = 5; + LUA_OPUNM = 6; + + +var + lua_arith: procedure(L: lua_State; op: Integer); cdecl; + + +const + LUA_OPEQ = 0; + LUA_OPLT = 1; + LUA_OPLE = 2; + + +var + lua_rawequal: function(L: lua_State; idx1, idx2: Integer): Integer; cdecl; + lua_compare: function(L: lua_State; idx1, idx2, op: Integer): Integer; cdecl; + + + { push functions (C -> stack) } + lua_pushnil: procedure(L: lua_State); cdecl; + lua_pushnumber: procedure(L: lua_State; n: lua_Number); cdecl; + lua_pushinteger: procedure(L: lua_State; n: lua_Integer); cdecl; + lua_pushunsigned: procedure(L: lua_State; n: lua_Unsigned); cdecl; + lua_pushlstring: function (L: lua_State; s: PAnsiChar; l_: size_t): PAnsiChar; cdecl; + lua_pushstring: function (L: lua_State; s: PAnsiChar): PAnsiChar; cdecl; + lua_pushvfstring: function (L: lua_State; fmt: PAnsiChar; argp: Pointer): PAnsiChar; cdecl; + lua_pushfstring: function (L: lua_State; fmt: PAnsiChar; argp: Pointer): PAnsiChar; cdecl; + lua_pushcclosure: procedure(L: lua_State; fn: lua_CFunction; n: Integer); cdecl; + lua_pushboolean: procedure(L: lua_State; b: Integer); cdecl; + lua_pushlightuserdata: procedure(L: lua_State; p: Pointer); cdecl; + lua_pushthread: function (L: lua_State): Integer; cdecl; + + { get functions (Lua -> stack) } + lua_getglobal: procedure(L: lua_State; value: PAnsiChar); cdecl; + lua_gettable: procedure(L: lua_State; idx: Integer); cdecl; + lua_getfield: procedure(L: lua_State; idx: Integer; k: PAnsiChar); cdecl; + lua_rawget: procedure(L: lua_State; idx: Integer); cdecl; + lua_rawgeti: procedure(L: lua_State; idx, n: Integer); cdecl; + lua_rawgetp: procedure(L: lua_State; idx: Integer; p: Pointer); cdecl; + lua_createtable: procedure(L: lua_State; narr: Integer; nrec: Integer); cdecl; + lua_newuserdata: procedure(L: lua_State; sz: size_t); cdecl; + lua_getmetatable: function(L: lua_State; objindex: Integer): Integer; cdecl; + lua_getuservalue: procedure(L: lua_State; idx: Integer); cdecl; + + { set functions (stack -> Lua) } + lua_setglobal: procedure(L: lua_State; value: PAnsiChar); cdecl; + lua_settable: procedure(L: lua_State; idx: Integer); cdecl; + lua_setfield: procedure(L: lua_State; idx: Integer; k: PAnsiChar); cdecl; + lua_rawset: procedure(L: lua_State; idx: Integer); cdecl; + lua_rawseti: procedure(L: lua_State; idx, n: Integer); cdecl; + lua_rawsetp: procedure(L: lua_State; idx: Integer; p: Pointer); cdecl; + lua_setmetatable: function(L: lua_State; objindex: Integer): Integer; cdecl; + lua_setuservalue: procedure(L: lua_State; idx: Integer); cdecl; + + + { 'load' and 'call' functions (load and run Lua code) } + lua_callk: procedure(L: lua_State; nargs, nresults, ctx: Integer; k: lua_CFunction); cdecl; + lua_getctx: function(L: lua_State; var ctx: Integer): Integer; cdecl; + lua_pcallk: function(L: lua_State; nargs, nresults, errfunc, ctx: Integer; k: lua_CFunction): Integer; cdecl; + + lua_load: function(L: lua_State; reader: lua_Reader; dt: Pointer; chunkname, mode: PAnsiChar): Integer; cdecl; + lua_dump: function(L: lua_State; writer: lua_Writer; data: Pointer): Integer; cdecl; + + + procedure lua_call(L: lua_State; nargs, nresults: Integer); inline; + function lua_pcall(L: lua_State; nargs, nresults, errfunc: Integer): Integer; inline; + + +var + { coroutine functions } + lua_yieldk: function(L: lua_State; nresults, ctx: Integer; k: lua_CFunction): Integer; cdecl; + lua_resume: function(L, from: lua_State; nargs: Integer): Integer; cdecl; + lua_status: function(L: lua_State): Integer; cdecl; + + function lua_yield(L: lua_State; nresults: Integer): Integer; inline; + + +const + { garbage-collection function and options } + LUA_GCSTOP = 0; + LUA_GCRESTART = 1; + LUA_GCCOLLECT = 2; + LUA_GCCOUNT = 3; + LUA_GCCOUNTB = 4; + LUA_GCSTEP = 5; + LUA_GCSETPAUSE = 6; + LUA_GCSETSTEPMU = 7; + LUA_GCSETMAJORIN = 8; + LUA_GCISRUNNING = 9; + LUA_GCGEN = 0; + LUA_GCINC = 1; + +var + lua_gc: function(L: lua_State; what, data: Integer): Integer; cdecl; + + +var + { miscellaneous functions } + lua_error: function(L: lua_State): Integer; cdecl; + lua_next: function(L: lua_State; idx: Integer): Integer; cdecl; + + lua_concat: procedure(L: lua_State; n: Integer); cdecl; + lua_len: procedure(L: lua_State; idx: Integer); cdecl; + + lua_getallocf: function(L: lua_State; ud: Pointer): lua_Alloc; cdecl; + lua_setallocf: procedure(L: lua_State; f: lua_Alloc; ud: Pointer); cdecl; + + + { some useful macros } + function lua_tonumber(L: lua_State; idx: Integer): lua_Number; inline; + function lua_tointeger(L: lua_State; idx: Integer): lua_Integer; inline; + function lua_tounsigned(L: lua_State; idx: Integer): lua_Unsigned; inline; + + procedure lua_pop(L: lua_State; n: Integer); inline; + procedure lua_newtable(L: lua_State); inline; + procedure lua_register(L: lua_State; name: PAnsiChar; f: lua_CFunction); inline; + procedure lua_pushcfunction(L: lua_State; f: lua_CFunction); inline; + + function lua_isfunction(L: lua_State; n: Integer): Boolean; inline; + function lua_istable(L: lua_State; n: Integer): Boolean; inline; + function lua_islightuserdata(L: lua_State; n: Integer): Boolean; inline; + function lua_isnil(L: lua_State; n: Integer): Boolean; inline; + function lua_isboolean(L: lua_State; n: Integer): Boolean; inline; + function lua_isthread(L: lua_State; n: Integer): Boolean; inline; + function lua_isnone(L: lua_State; n: Integer): Boolean; inline; + function lua_isnoneornil(L: lua_State; n: Integer): Boolean; inline; + function lua_pushliteral(L: lua_State; const s: AnsiString): PAnsiChar; inline; + + procedure lua_pushglobaltable(L: lua_State); inline; + function lua_tostring(L: lua_State; idx: Integer): PAnsiChar; inline; + + +const + {====================================================================== + Debug API + =======================================================================} + + { Event codes } + LUA_HOOKCALL = 0; + LUA_HOOKRET = 1; + LUA_HOOKLINE = 2; + LUA_HOOKCOUNT = 3; + LUA_HOOKTAILCALL = 4; + + + { Event masks } + LUA_MASKCALL = (1 shl LUA_HOOKCALL); + LUA_MASKRET = (1 shl LUA_HOOKRET); + LUA_MASKLINE = (1 shl LUA_HOOKLINE); + LUA_MASKCOUNT = (1 shl LUA_HOOKCOUNT); + + +const + LUA_IDSIZE = 60; + + +type + lua_Debug = record + event: Integer; + name: PAnsiChar; + namewhat: PAnsiChar; // 'global', 'local', 'field', 'method' + what: PAnsiChar; // 'Lua', 'C', 'main', 'tail' + source: PAnsiChar; + currentline: Integer; + linedefined: Integer; + lastlinedefined: Integer; + nups: Byte; + nparams: Byte; + isvararg: Byte; + istailcall: Byte; + short_src: array[0..LUA_IDSIZE - 1] of AnsiChar; + //struct CallInfo *i_ci; /* active function */ + end; + + { Functions to be called by the debugger in specific events } + lua_Hook = procedure(L: lua_State; var ar: lua_Debug); cdecl; + + +var + lua_getstack: function(L: lua_State; level: Integer; var ar: lua_Debug): Integer; cdecl; + lua_getinfo: function(L: lua_State; what: PAnsiChar; var ar: lua_Debug): Integer; cdecl; + + lua_getlocal: function(L: lua_State; var ar: lua_Debug; n: Integer): PAnsiChar; cdecl; + lua_setlocal: function(L: lua_State; var ar: lua_Debug; n: Integer): PAnsiChar; cdecl; + lua_getupvalue: function(L: lua_State; funcindex, n: Integer): PAnsiChar; cdecl; + lua_setupvalue: function(L: lua_State; funcindex, n: Integer): PAnsiChar; cdecl; + + lua_upvalueid: function(L: lua_State; fidx, n: Integer): Pointer; cdecl; + lua_upvaluejoin: procedure(L: lua_State; fidx1, n1, fidx2, n2: Integer); + + lua_sethook: function(L: lua_State; func: lua_Hook; mask, count: Integer): Integer; cdecl; + lua_gethook: function(L: lua_State): lua_Hook; cdecl; + lua_gethookmask: function(L: lua_State): Integer; cdecl; + lua_gethookcount: function(L: lua_State): Integer; cdecl; + + {====================================================================== } + + +const + LUA_COLIBNAME = 'coroutine'; + LUA_TABLIBNAME = 'table'; + LUA_IOLIBNAME = 'io'; + LUA_OSLIBNAME = 'os'; + LUA_STRLIBNAME = 'string'; + LUA_BITLIBNAME = 'bit32'; + LUA_MATHLIBNAME = 'math'; + LUA_DBLIBNAME = 'debug'; + LUA_LOADLIBNAME = 'package'; + + +var + { lualib } + luaopen_base: function(L: lua_State): Integer; cdecl; + luaopen_coroutine: function(L: lua_State): Integer; cdecl; + luaopen_table: function(L: lua_State): Integer; cdecl; + luaopen_io: function(L: lua_State): Integer; cdecl; + luaopen_os: function(L: lua_State): Integer; cdecl; + luaopen_string: function(L: lua_State): Integer; cdecl; + luaopen_bit32: function(L: lua_State): Integer; cdecl; + luaopen_math: function(L: lua_State): Integer; cdecl; + luaopen_debug: function(L: lua_State): Integer; cdecl; + luaopen_package: function(L: lua_State): Integer; cdecl; + + { open all previous libraries } + luaL_openlibs: procedure(L: lua_State); cdecl; + luaL_requiref: procedure(L: lua_State; modname: PAnsiChar; openf: lua_CFunction; glb: Integer); cdecl; + + + +type + luaL_Reg = record + name: PAnsiChar; + func: lua_CFunction; + end; + PluaL_Reg = ^luaL_Reg; + +var + luaL_setfuncs: procedure(L: lua_State; luaL_Reg: PluaL_Reg; nup: Integer); cdecl; + + procedure luaL_where(L: lua_State; level: Integer); + function luaL_error(L: lua_State; fmt: PAnsiChar; argp: Pointer): Integer; + + + +const + DefaultLuaLibName = 'lua' + LUA_VERSION_MAJOR + LUA_VERSION_MINOR + '.dll'; + + procedure LoadLuaLib(const AFileName: string = DefaultLuaLibName); + procedure UnloadLuaLib; + + function LuaLibLoaded: Boolean; + + function DefaultLuaAlloc(ud, ptr: Pointer; osize, nsize: size_t): Pointer; cdecl; + + +implementation +uses + System.Generics.Collections, + Winapi.Windows; + +var + LuaLibHandle: THandle; + LuaFunctions: TList; + + +function DefaultLuaAlloc(ud, ptr: Pointer; osize, nsize: size_t): Pointer; +begin + if (nsize = 0) then + begin + FreeMemory(ptr); + Result := nil; + end else + Result := ReallocMemory(ptr, nsize); +end; + + +procedure LoadLuaLib(const AFileName: string = DefaultLuaLibName); + + procedure Load(var AVariable: Pointer; const AName: string); + begin + AVariable := GetProcAddress(LuaLibHandle, PChar(AName)); + LuaFunctions.Add(@AVariable); + end; + + +begin + UnloadLuaLib; + + LuaLibHandle := SafeLoadLibrary(AFileName); + if LuaLibHandle = 0 then + RaiseLastOSError; + + if not Assigned(LuaFunctions) then + LuaFunctions := TList.Create(); + + Load(@lua_newstate, 'lua_newstate'); + Load(@lua_close, 'lua_close'); + Load(@lua_newthread, 'lua_newthread'); + + Load(@lua_atpanic, 'lua_atpanic'); + Load(@lua_version, 'lua_version'); + + Load(@lua_absindex, 'lua_absindex'); + Load(@lua_gettop, 'lua_gettop'); + Load(@lua_settop, 'lua_settop'); + Load(@lua_pushvalue, 'lua_pushvalue'); + Load(@lua_remove, 'lua_remove'); + Load(@lua_insert, 'lua_insert'); + Load(@lua_replace, 'lua_replace'); + Load(@lua_copy, 'lua_copy'); + Load(@lua_checkstack, 'lua_checkstack'); + Load(@lua_xmove, 'lua_xmove'); + + Load(@lua_isnumber, 'lua_isnumber'); + Load(@lua_isstring, 'lua_isstring'); + Load(@lua_iscfunction, 'lua_iscfunction'); + Load(@lua_isuserdata, 'lua_isuserdata'); + Load(@lua_type, 'lua_type'); + Load(@lua_typename, 'lua_typename'); + Load(@lua_tonumberx, 'lua_tonumberx'); + Load(@lua_tointegerx, 'lua_tointegerx'); + Load(@lua_tounsignedx, 'lua_tounsignedx'); + Load(@lua_toboolean, 'lua_toboolean'); + Load(@lua_tolstring, 'lua_tolstring'); + Load(@lua_rawlen, 'lua_rawlen'); + Load(@lua_tocfunction, 'lua_tocfunction'); + Load(@lua_touserdata, 'lua_touserdata'); + Load(@lua_tothread, 'lua_tothread'); + Load(@lua_topointer, 'lua_topointer'); + + Load(@lua_arith, 'lua_arith'); + Load(@lua_rawequal, 'lua_rawequal'); + Load(@lua_compare, 'lua_compare'); + + Load(@lua_pushnil, 'lua_pushnil'); + Load(@lua_pushnumber, 'lua_pushnumber'); + Load(@lua_pushinteger, 'lua_pushinteger'); + Load(@lua_pushunsigned, 'lua_pushunsigned'); + Load(@lua_pushlstring, 'lua_pushlstring'); + Load(@lua_pushstring, 'lua_pushstring'); + Load(@lua_pushvfstring, 'lua_pushvfstring'); + Load(@lua_pushfstring, 'lua_pushfstring'); + Load(@lua_pushcclosure, 'lua_pushcclosure'); + Load(@lua_pushboolean, 'lua_pushboolean'); + Load(@lua_pushlightuserdata, 'lua_pushlightuserdata'); + Load(@lua_pushthread, 'lua_pushthread'); + + Load(@lua_getglobal, 'lua_getglobal'); + Load(@lua_gettable, 'lua_gettable'); + Load(@lua_getfield, 'lua_getfield'); + Load(@lua_rawget, 'lua_rawget'); + Load(@lua_rawgeti, 'lua_rawgeti'); + Load(@lua_rawgetp, 'lua_rawgetp'); + Load(@lua_newuserdata, 'lua_newuserdata'); + Load(@lua_getmetatable, 'lua_getmetatable'); + Load(@lua_getuservalue, 'lua_getuservalue'); + + Load(@lua_createtable, 'lua_createtable'); + Load(@lua_setglobal, 'lua_setglobal'); + Load(@lua_settable, 'lua_settable'); + Load(@lua_setfield, 'lua_setfield'); + + Load(@lua_rawset, 'lua_rawset'); + Load(@lua_rawseti, 'lua_rawseti'); + Load(@lua_rawsetp, 'lua_rawsetp'); + Load(@lua_setmetatable, 'lua_setmetatable'); + Load(@lua_setuservalue, 'lua_setuservalue'); + + Load(@lua_callk, 'lua_callk'); + Load(@lua_getctx, 'lua_getctx'); + Load(@lua_pcallk, 'lua_pcallk'); + + Load(@lua_yieldk, 'lua_yieldk'); + Load(@lua_resume, 'lua_resume'); + Load(@lua_status, 'lua_status'); + + Load(@lua_gc, 'lua_gc'); + + Load(@lua_load, 'lua_load'); + Load(@lua_dump, 'lua_dump'); + + Load(@lua_error, 'lua_error'); + Load(@lua_next, 'lua_next'); + + Load(@lua_concat, 'lua_concat'); + Load(@lua_len, 'lua_len'); + + Load(@lua_getallocf, 'lua_getallocf'); + Load(@lua_setallocf, 'lua_setallocf'); + + + Load(@lua_getstack, 'lua_getstack'); + Load(@lua_getinfo, 'lua_getinfo'); + + Load(@lua_getlocal, 'lua_getlocal'); + Load(@lua_setlocal, 'lua_setlocal'); + Load(@lua_getupvalue, 'lua_getupvalue'); + Load(@lua_setupvalue, 'lua_setupvalue'); + + Load(@lua_upvalueid, 'lua_upvalueid'); + Load(@lua_upvaluejoin, 'lua_upvaluejoin'); + + Load(@lua_sethook, 'lua_sethook'); + Load(@lua_gethook, 'lua_gethook'); + Load(@lua_gethookmask, 'lua_gethookmask'); + Load(@lua_gethookcount, 'lua_gethookcount'); + + Load(@luaopen_base, 'luaopen_base'); + Load(@luaopen_coroutine, 'luaopen_coroutine'); + Load(@luaopen_table, 'luaopen_table'); + Load(@luaopen_io, 'luaopen_io'); + Load(@luaopen_os, 'luaopen_os'); + Load(@luaopen_string, 'luaopen_string'); + Load(@luaopen_bit32, 'luaopen_bit32'); + Load(@luaopen_math, 'luaopen_math'); + Load(@luaopen_debug, 'luaopen_debug'); + Load(@luaopen_package, 'luaopen_package'); + + Load(@luaL_openlibs, 'luaL_openlibs'); + Load(@luaL_requiref, 'luaL_requiref'); + + Load(@luaL_setfuncs, 'luaL_setfuncs'); +end; + + +procedure UnloadLuaLib; +var + variable: PPointer; + +begin + if Assigned(LuaFunctions) then + begin + for variable in LuaFunctions do + variable^ := nil; + end; + + if LuaLibLoaded then + begin + FreeLibrary(LuaLibHandle); + LuaLibHandle := 0; + end; +end; + + +function LuaLibLoaded: Boolean; +begin + Result := (LuaLibHandle <> 0); +end; + + +{ Macros } +function lua_upvalueindex(idx: Integer): Integer; +begin + Result := (LUA_REGISTRYINDEX - idx); +end; + +procedure lua_call(L: lua_State; nargs, nresults: Integer); +begin + lua_callk(L, nargs, nresults, 0, nil); +end; + +function lua_pcall(L: lua_State; nargs, nresults, errfunc: Integer): Integer; +begin + Result := lua_pcallk(L, nargs, nresults, errfunc, 0, nil); +end; + +function lua_yield(L: lua_State; nresults: Integer): Integer; +begin + Result := lua_yieldk(L, nresults, 0, nil); +end; + +function lua_tonumber(L: lua_State; idx: Integer): lua_Number; +begin + Result := lua_tonumberx(L, idx, nil); +end; + +function lua_tointeger(L: lua_State; idx: Integer): lua_Integer; +begin + Result := lua_tointegerx(L, idx, nil); +end; + +function lua_tounsigned(L: lua_State; idx: Integer): lua_Unsigned; +begin + Result := lua_tounsignedx(L, idx, nil); +end; + +procedure lua_pop(L: lua_State; n: Integer); +begin + lua_settop(L, -(n) - 1); +end; + +procedure lua_newtable(L: lua_State); inline; +begin + lua_createtable(L, 0, 0); +end; + +procedure lua_register(L: lua_State; name: PAnsiChar; f: lua_CFunction); inline; +begin + lua_pushcfunction(L, f); + lua_setglobal(L, name); +end; + +procedure lua_pushcfunction(L: lua_State; f: lua_CFunction); +begin + lua_pushcclosure(L, f, 0); +end; + +function lua_isfunction(L: lua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TFUNCTION; +end; + +function lua_istable(L: lua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TTABLE; +end; + +function lua_islightuserdata(L: lua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TLIGHTUSERDATA; +end; + +function lua_isnil(L: lua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TNIL; +end; + +function lua_isboolean(L: lua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TBOOLEAN; +end; + +function lua_isthread(L: lua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TTHREAD; +end; + +function lua_isnone(L: lua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TNONE; +end; + +function lua_isnoneornil(L: lua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) <= 0; +end; + +function lua_pushliteral(L: lua_State; const s: AnsiString): PAnsiChar; +begin + Result := lua_pushlstring(L, PAnsiChar(s), Length(s)); +end; + +procedure lua_pushglobaltable(L: lua_State); +begin + lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS); +end; + +function lua_tostring(L: lua_State; idx: Integer): PAnsiChar; +begin + Result := lua_tolstring(L, idx, nil); +end; + +procedure luaL_where(L: lua_State; level: Integer); +var + ar: lua_Debug; + msg: AnsiString; + +begin + if (lua_getstack(L, level, ar) <> 0) then // check function at level + begin + lua_getinfo(L, 'Sl', ar); // get info about it + if (ar.currentline > 0) then // is there info? + begin + msg := AnsiString(Format('%s:%d: ', [ar.short_src, ar.currentline])); + lua_pushlstring(L, PAnsiChar(msg), Length(msg)); + exit + end; + end; + lua_pushliteral(L, ''); // else, no information available... +end; + +function luaL_error(L: lua_State; fmt: PAnsiChar; argp: Pointer): Integer; +begin + luaL_where(L, 1); + lua_pushvfstring(L, fmt, argp); + lua_concat(L, 2); + Result := lua_error(L); +end; + + +initialization +finalization + UnloadLuaLib; + FreeAndNil(LuaFunctions); + +end. diff --git a/G940LEDControl/DelphiLua/Lua.pas b/G940LEDControl/DelphiLua/Lua.pas new file mode 100644 index 0000000..f00ec3e --- /dev/null +++ b/G940LEDControl/DelphiLua/Lua.pas @@ -0,0 +1,2484 @@ +{ + Wrapper classes for Lua API + + Created by M. van Renswoude, April 2014: + + This software is provided 'as-is', without any express or implied + warranty. In no event will the authors be held liable for any damages + arising from the use of this software. + + Permission is granted to anyone to use this software for any purpose, + including commercial applications, and to alter it and redistribute it + freely, subject to the following restrictions: + + 1. The origin of this software must not be misrepresented; you must not + claim that you wrote the original software. If you use this software + in a product, an acknowledgment in the product documentation would be + appreciated but is not required. + + 2. Altered source versions must be plainly marked as such, and must not be + misrepresented as being the original software. + + 3. This notice may not be removed or altered from any source + distribution. +} +unit Lua; + +interface +uses + System.Classes, + System.Generics.Collections, + System.Generics.Defaults, + System.Rtti, + System.SysUtils, + + Lua.API; + +type + ELuaException = class(Exception); + ELuaInitException = class(ELuaException); + ELuaUnsupportedParameterException = class(ELuaException); + ELuaUnsupportedVariableException = class(ELuaException); + ELuaNoFunctionException = class(ELuaException); + ELuaNativeCodeException = class(ELuaException); + + TLuaLibrary = (Base, Coroutine, Table, IO, OS, StringLib, Bit32, Math, Debug, Package, All); + TLuaLibraries = set of TLuaLibrary; + + TLuaDataType = (LuaNone, LuaNil, LuaNumber, LuaBoolean, LuaString, LuaTable, + LuaFunction, LuaUserData, LuaThread, LuaLightUserData); + + TLuaVariableType = (VariableNone, VariableBoolean, VariableInteger, + VariableNumber, VariableUserData, VariableString, + VariableTable, VariableFunction); + + ILuaTable = interface; + ILuaFunction = interface; + + + ILuaVariable = interface + ['{ADA0D4FB-F0FB-4493-8FEC-6FC92C80117F}'] + function GetVariableType: TLuaVariableType; + function GetDataType: TLuaDataType; + + function GetAsBoolean: Boolean; + function GetAsInteger: Integer; + function GetAsNumber: Double; + function GetAsUserData: Pointer; + function GetAsString: string; + function GetAsTable: ILuaTable; + function GetAsFunction: ILuaFunction; + + procedure SetAsBoolean(ABoolean: Boolean); + procedure SetAsInteger(AInteger: Integer); + procedure SetAsNumber(ANumber: Double); + procedure SetAsUserData(AUserData: Pointer); + procedure SetAsString(AString: string); + procedure SetAsTable(ATable: ILuaTable); + + property VariableType: TLuaVariableType read GetVariableType; + property DataType: TLuaDataType read GetDataType; + + property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean; + property AsInteger: Integer read GetAsInteger write SetAsInteger; + property AsNumber: Double read GetAsNumber write SetAsNumber; + property AsUserData: Pointer read GetAsUserData write SetAsUserData; + property AsString: string read GetAsString write SetAsString; + property AsTable: ILuaTable read GetAsTable write SetAsTable; + property AsFunction: ILuaFunction read GetAsFunction; + end; + + + TLuaImplicitVariable = record + Variable: ILuaVariable; + + class operator Implicit(AValue: ILuaVariable): TLuaImplicitVariable; + class operator Implicit(AValue: Boolean): TLuaImplicitVariable; + class operator Implicit(AValue: Integer): TLuaImplicitVariable; + class operator Implicit(AValue: Double): TLuaImplicitVariable; + class operator Implicit(AValue: Pointer): TLuaImplicitVariable; + class operator Implicit(const AValue: string): TLuaImplicitVariable; + class operator Implicit(AValue: ILuaTable): TLuaImplicitVariable; + class operator Implicit(AValue: TLuaImplicitVariable): ILuaVariable; + class operator Implicit(AValue: TLuaImplicitVariable): Boolean; + class operator Implicit(AValue: TLuaImplicitVariable): Integer; + class operator Implicit(AValue: TLuaImplicitVariable): Double; + class operator Implicit(AValue: TLuaImplicitVariable): Pointer; + class operator Implicit(AValue: TLuaImplicitVariable): string; + class operator Implicit(AValue: TLuaImplicitVariable): ILuaTable; + end; + + + TLuaKeyValuePair = record + Key: ILuaVariable; + Value: ILuaVariable; + end; + + + ILuaTableEnumerator = interface + ['{4C3F4E20-F9E7-42E6-9446-78C535AF2E30}'] + function GetCurrent: TLuaKeyValuePair; + function MoveNext: Boolean; + + property Current: TLuaKeyValuePair read GetCurrent; + end; + + + ILuaTable = interface + ['{57FD52A1-7D53-485B-A630-29841C498387}'] + function GetEnumerator: ILuaTableEnumerator; + + function HasValue(AKey: TLuaImplicitVariable): Boolean; + function GetValue(AKey: TLuaImplicitVariable): ILuaVariable; + procedure SetValue(AKey: TLuaImplicitVariable; AValue: TLuaImplicitVariable); + end; + + + TLuaTableEnumerator = class(TInterfacedObject, ILuaTableEnumerator) + private + FEnumerator: TEnumerator>; + public + constructor Create(AEnumerator: TEnumerator>); + destructor Destroy; override; + + { ILuaTableEnumerator } + function GetCurrent: TLuaKeyValuePair; + function MoveNext: Boolean; + + property Current: TLuaKeyValuePair read GetCurrent; + end; + + + TLuaVariableEqualityComparer = class(TInterfacedObject, IEqualityComparer) + public + { IEqualityComparer } + function Equals(const Left, Right: ILuaVariable): Boolean; reintroduce; + function GetHashCode(const Value: ILuaVariable): Integer; reintroduce; + end; + + + TLuaTable = class(TInterfacedObject, ILuaTable) + private + FTable: TDictionary; + public + constructor Create; + destructor Destroy; override; + + { ILuaTable } + function GetEnumerator: ILuaTableEnumerator; + + function HasValue(AKey: TLuaImplicitVariable): Boolean; + function GetValue(AKey: TLuaImplicitVariable): ILuaVariable; + procedure SetValue(AKey: TLuaImplicitVariable; AValue: TLuaImplicitVariable); + end; + + + ILuaParametersEnumerator = interface + function GetCurrent: ILuaVariable; + function MoveNext: Boolean; + property Current: ILuaVariable read GetCurrent; + end; + + + ILuaReadParameters = interface(ILuaVariable) + ['{FB611D9E-B51D-460B-B5AB-B567EF853222}'] + function GetCount: Integer; + function GetItem(Index: Integer): ILuaVariable; + + function GetEnumerator: ILuaParametersEnumerator; + function ToString: string; + + property Count: Integer read GetCount; + property Items[Index: Integer]: ILuaVariable read GetItem; default; + end; + + + ILuaWriteParameters = interface + ['{5CEEB16B-158E-44BE-8CAD-DC2C330A244A}'] + function GetCount: Integer; + + procedure Push(ABoolean: Boolean); overload; + procedure Push(AInteger: Integer); overload; + procedure Push(ANumber: Double); overload; + procedure Push(AUserData: Pointer); overload; + procedure Push(const AString: string); overload; + procedure Push(ATable: ILuaTable); overload; + + property Count: Integer read GetCount; + end; + + + ILuaFunction = interface + ['{1BE5E470-0318-410E-8D5B-94BFE04A3DBE}'] + function Call(): ILuaReadParameters; overload; + function Call(AParameters: array of const): ILuaReadParameters; overload; + function Call(AParameters: ILuaReadParameters): ILuaReadParameters; overload; + end; + + + ILuaContext = interface + ['{1F999593-E3D1-4195-9463-A42025AE9830}'] + function GetParameters: ILuaReadParameters; + function GetResult: ILuaWriteParameters; + + property Parameters: ILuaReadParameters read GetParameters; + property Result: ILuaWriteParameters read GetResult; + 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; + protected + property Name: string read FName write FName; + public + constructor Create(const AName: string); + + procedure Apply(AState: lua_State; APushFunction: TLuaPushFunction); virtual; abstract; + end; + + + 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; + + 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; + TLuaRegisteredFunctionDictionary = TDictionary; + + + TLuaScript = class(TObject) + private + FStream: TStream; + FStreamOwnership: TStreamOwnership; + FBuffer: PAnsiChar; + public + constructor Create(const AData: string); overload; + constructor Create(const AStream: TStream; AOwnership: TStreamOwnership = soReference); overload; + destructor Destroy; override; + + function GetNextChunk(out ASize: NativeUint): PAnsiChar; virtual; + end; + + + TLua = class(TObject) + private + FState: lua_State; + FLoaded: Boolean; + FRegistrations: TLuaRegistrationList; + FRegisteredFunctions: TLuaRegisteredFunctionDictionary; + FRegisteredFunctionCookie: Integer; + FAutoOpenLibraries: TLuaLibraries; + FHasRun: Boolean; + FRttiContext: TRttiContext; + protected + function GetHasState: Boolean; virtual; + function GetState: lua_State; virtual; + + function DoAlloc(APointer: Pointer; AOldSize, ANewSize: NativeUint): Pointer; virtual; + + procedure DoNewState; virtual; + procedure DoClose; virtual; + procedure DoRegistration(ARegistration: TCustomLuaRegistration); virtual; + + procedure SetAutoOpenLibraries(const Value: TLuaLibraries); virtual; + protected + procedure CheckState; virtual; + procedure CheckIsFunction; virtual; + procedure AfterLoad; virtual; + + procedure AddRegistration(ARegistration: TCustomLuaRegistration); virtual; + function GetRegisteredFunctionCookie: Integer; virtual; + function RunRegisteredFunction(ACookie: Integer): Integer; virtual; + + property Loaded: Boolean read FLoaded write FLoaded; + property HasRun: Boolean read FHasRun write FHasRun; + property Registrations: TLuaRegistrationList read FRegistrations; + property RegisteredFunctions: TLuaRegisteredFunctionDictionary read FRegisteredFunctions; + public + constructor Create; + destructor Destroy; override; + + procedure LoadFromString(const AData: string; AAutoRun: Boolean = True; const AChunkName: string = ''); virtual; + procedure LoadFromStream(AStream: TStream; AOwnership: TStreamOwnership = soReference; AAutoRun: Boolean = True; const AChunkName: string = ''); virtual; + procedure LoadFromFile(const AFileName: string; AAutoRun: Boolean = True; const AChunkName: string = ''); virtual; + procedure LoadFromScript(AScript: TLuaScript; AOwnership: TStreamOwnership = soReference; AAutoRun: Boolean = True; const AChunkName: string = ''); virtual; + + function GetGlobalVariable(const AName: string): ILuaVariable; virtual; + procedure SetGlobalVariable(const AName: string; AVariable: TLuaImplicitVariable); 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; + + { These methods should only be called right after one of the + LoadFrom methods, which must have AutoRun set to False. } + procedure Run; virtual; + procedure GetByteCode(AStream: TStream; APop: Boolean = False); virtual; + procedure Capture(const AName: string); virtual; + + function Call(const AFunctionName: string): ILuaReadParameters; overload; virtual; + function Call(const AFunctionName: string; AParameters: array of const): ILuaReadParameters; overload; virtual; + function Call(const AFunctionName: string; AParameters: ILuaReadParameters): ILuaReadParameters; overload; virtual; + + property HasState: Boolean read GetHasState; + property State: lua_State read GetState; + + property AutoOpenLibraries: TLuaLibraries read FAutoOpenLibraries write SetAutoOpenLibraries default [TLuaLibrary.All]; + end; + + + TLuaHelpers = class(TObject) + private + class var RegistryKeyCounter: Int64; + public + class function GetLuaDataType(AType: Integer): TLuaDataType; + class function GetLuaVariableType(ADataType: TLuaDataType): TLuaVariableType; + + class function CreateParameters(AParameters: array of const): ILuaReadParameters; + + class procedure PushVariable(AState: lua_State; AVariable: ILuaVariable); overload; + 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 function AllocLuaString(const AValue: string): PAnsiChar; + class procedure FreeLuaString(AValue: PAnsiChar); + + class procedure RaiseLastLuaError(AState: lua_State); + class function LuaToString(AState: lua_State; AIndex: Integer): string; + class function CallFunction(AState: lua_State; AParameters: ILuaReadParameters): ILuaReadParameters; + + class function NewRegistryKey: string; + end; + + + +implementation +uses + System.Math, + System.SyncObjs, + System.TypInfo; + + +type + PLuaScript = ^TLuaScript; + + TLuaParametersEnumerator = class(TInterfacedObject, ILuaParametersEnumerator) + private + FParameters: ILuaReadParameters; + FIndex: Integer; + protected + property Parameters: ILuaReadParameters read FParameters; + public + constructor Create(AParameters: ILuaReadParameters); + + function GetCurrent: ILuaVariable; + function MoveNext: Boolean; + end; + + + TCustomLuaParameters = class(TInterfacedObject, ILuaVariable, ILuaReadParameters) + protected + function GetDefaultVariable: ILuaVariable; + public + { ILuaVariable } + function GetVariableType: TLuaVariableType; + function GetDataType: TLuaDataType; + + function GetAsBoolean: Boolean; + function GetAsInteger: Integer; + function GetAsNumber: Double; + function GetAsUserData: Pointer; + function GetAsString: string; + function GetAsTable: ILuaTable; + function GetAsFunction: ILuaFunction; + + procedure SetAsBoolean(ABoolean: Boolean); + procedure SetAsInteger(AInteger: Integer); + procedure SetAsNumber(ANumber: Double); + procedure SetAsUserData(AUserData: Pointer); + procedure SetAsString(AString: string); + procedure SetAsTable(ATable: ILuaTable); + + { ILuaReadParameters } + function GetCount: Integer; virtual; abstract; + function GetItem(Index: Integer): ILuaVariable; virtual; abstract; + + function GetEnumerator: ILuaParametersEnumerator; + function ToString: string; override; + end; + + + TLuaStackParameters = class(TCustomLuaParameters) + private + FState: lua_State; + FCount: Integer; + protected + property State: lua_State read FState; + public + constructor Create(AState: lua_State; ACount: Integer = -1); + + { ILuaReadParameters } + function GetCount: Integer; override; + function GetItem(Index: Integer): ILuaVariable; override; + end; + + + TLuaStackVariable = class(TInterfacedObject, ILuaVariable) + private + FState: lua_State; + FIndex: Integer; + FTable: ILuaTable; + protected + property State: lua_State read FState; + property Index: Integer read FIndex; + public + constructor Create(AState: lua_State; AIndex: Integer); + + { ILuaVariable } + function GetDataType: TLuaDataType; + function GetVariableType: TLuaVariableType; + + function GetAsBoolean: Boolean; + function GetAsInteger: Integer; + function GetAsNumber: Double; + function GetAsUserData: Pointer; + function GetAsString: string; + function GetAsTable: ILuaTable; + function GetAsFunction: ILuaFunction; + + procedure SetAsBoolean(ABoolean: Boolean); + procedure SetAsInteger(AInteger: Integer); + procedure SetAsNumber(ANumber: Double); + procedure SetAsUserData(AUserData: Pointer); + procedure SetAsString(AString: string); + procedure SetAsTable(ATable: ILuaTable); + end; + + + TLuaResultParameters = class(TCustomLuaParameters) + private + FParameters: TList; + public + constructor Create(AState: lua_State; ACount: Integer); + destructor Destroy; override; + + function GetCount: Integer; override; + function GetItem(Index: Integer): ILuaVariable; override; + end; + + + TLuaVariable = class(TInterfacedObject, ILuaVariable) + private + FVariableType: TLuaVariableType; + FDataType: TLuaDataType; + FBooleanValue: Boolean; + FIntegerValue: Integer; + FNumberValue: Double; + FUserDataValue: Pointer; + FStringValue: string; + FTableValue: ILuaTable; + FFunctionValue: ILuaFunction; + protected + property VariableType: TLuaVariableType read FVariableType write FVariableType; + property DataType: TLuaDataType read FDataType write FDataType; + property BooleanValue: Boolean read FBooleanValue write FBooleanValue; + property IntegerValue: Integer read FIntegerValue write FIntegerValue; + property NumberValue: Double read FNumberValue write FNumberValue; + property UserDataValue: Pointer read FUserDataValue write FUserDataValue; + property StringValue: string read FStringValue write FStringValue; + property TableValue: ILuaTable read FTableValue write FTableValue; + property FunctionValue: ILuaFunction read FFunctionValue write FFunctionValue; + public + constructor Create; overload; + constructor Create(ABoolean: Boolean); overload; + constructor Create(AInteger: Integer); overload; + constructor Create(ANumber: Double); overload; + constructor Create(AUserData: Pointer); overload; + constructor Create(const AString: string); overload; + constructor Create(ATable: ILuaTable); overload; + constructor Create(AFunction: ILuaFunction); overload; + + { ILuaParameter } + function GetVariableType: TLuaVariableType; + function GetDataType: TLuaDataType; + + function GetAsBoolean: Boolean; + function GetAsInteger: Integer; + function GetAsNumber: Double; + function GetAsUserData: Pointer; + function GetAsString: string; + function GetAsTable: ILuaTable; + function GetAsFunction: ILuaFunction; + + procedure SetAsBoolean(ABoolean: Boolean); + procedure SetAsInteger(AInteger: Integer); + procedure SetAsNumber(ANumber: Double); + procedure SetAsUserData(AUserData: Pointer); + procedure SetAsString(AString: string); + procedure SetAsTable(ATable: ILuaTable); + end; + + + TLuaCachedVariable = class(TLuaVariable) + public + constructor Create(AState: lua_State; AIndex: Integer); + end; + + + TLuaCachedTable = class(TLuaTable) + public + constructor Create(AState: lua_State; AIndex: Integer); + end; + + + TLuaReadWriteParameters = class(TCustomLuaParameters, ILuaWriteParameters) + private + FParameters: TList; + public + constructor Create; + destructor Destroy; override; + + function GetCount: Integer; override; + function GetItem(Index: Integer): ILuaVariable; override; + + { ILuaWriteParameters } + procedure Push(ABoolean: Boolean); overload; + procedure Push(AInteger: Integer); overload; + procedure Push(ANumber: Double); overload; + procedure Push(AUserData: Pointer); overload; + procedure Push(const AString: string); overload; + procedure Push(ATable: ILuaTable); overload; + end; + + + TLuaStackWriteParameters = class(TInterfacedObject, ILuaWriteParameters) + private + FState: lua_State; + FCount: Integer; + protected + procedure Pushed; + + property State: lua_State read FState; + public + constructor Create(AState: lua_State); + + { ILuaWriteParameters } + function GetCount: Integer; + + procedure Push(ABoolean: Boolean); overload; + procedure Push(AInteger: Integer); overload; + procedure Push(ANumber: Double); overload; + procedure Push(AUserData: Pointer); overload; + procedure Push(const AString: string); overload; + procedure Push(ATable: ILuaTable); overload; + end; + + + TLuaFunction = class(TInterfacedObject, ILuaFunction) + private + FState: lua_State; + FRegistryKey: string; + protected + property State: lua_State read FState; + property RegistryKey: string read FRegistryKey; + public + constructor Create(AState: lua_State; AIndex: Integer); + destructor Destroy; override; + + { ILuaFunction } + function Call(): ILuaReadParameters; overload; + function Call(AParameters: array of const): ILuaReadParameters; overload; + function Call(AParameters: ILuaReadParameters): ILuaReadParameters; overload; + end; + + + TLuaContext = class(TInterfacedObject, ILuaContext) + private + FParameters: ILuaReadParameters; + FResult: ILuaWriteParameters; + public + constructor Create(AState: lua_State); + + { ILuaContext } + function GetParameters: ILuaReadParameters; + function GetResult: ILuaWriteParameters; + end; + + + +{ TLuaHelpers } +class function TLuaHelpers.GetLuaDataType(AType: Integer): TLuaDataType; +begin + case AType of + LUA_TNIL: Result := LuaNil; + LUA_TNUMBER: Result := LuaNumber; + LUA_TBOOLEAN: Result := LuaBoolean; + LUA_TSTRING: Result := LuaString; + LUA_TTABLE: Result := LuaTable; + LUA_TFUNCTION: Result := LuaFunction; + LUA_TUSERDATA: Result := LuaUserData; + LUA_TTHREAD: Result := LuaThread; + LUA_TLIGHTUSERDATA: Result := LuaLightUserData; + else + Result := LuaNone; + end; +end; + + +class function TLuaHelpers.GetLuaVariableType(ADataType: TLuaDataType): TLuaVariableType; +begin + case ADataType of + LuaNumber: Result := VariableNumber; + LuaBoolean: Result := VariableBoolean; + LuaString: Result := VariableString; + LuaTable: Result := VariableTable; + LuaFunction: Result := VariableFunction; + LuaUserData: Result := VariableUserData; + LuaLightUserData: Result := VariableUserData; + else + Result := VariableNone; + end; +end; + + +class function TLuaHelpers.CreateParameters(AParameters: array of const): ILuaReadParameters; +var + parameterIndex: Integer; + parameter: TVarRec; + resultParameters: TLuaReadWriteParameters; + table: ILuaTable; + +begin + resultParameters := TLuaReadWriteParameters.Create; + + for parameterIndex := Low(AParameters) to High(AParameters) do + begin + parameter := AParameters[parameterIndex]; + case parameter.VType of + vtInteger: resultParameters.Push(parameter.VInteger); + vtBoolean: resultParameters.Push(parameter.VBoolean); + vtChar: resultParameters.Push(string(parameter.VChar)); + vtExtended: resultParameters.Push(parameter.VExtended^); + vtString: resultParameters.Push(string(parameter.VString)); + vtPointer: resultParameters.Push(parameter.VPointer); + vtPChar: resultParameters.Push(string(parameter.VPChar)); + vtObject: + if parameter.VObject is TLuaTable then + resultParameters.Push(TLuaTable(parameter.VObject)); + + vtWideChar: resultParameters.Push(string(parameter.VWideChar)); + vtPWideChar: resultParameters.Push(string(parameter.VPWideChar)); + vtAnsiString: resultParameters.Push(string(PAnsiChar(parameter.VAnsiString))); + vtCurrency: resultParameters.Push(parameter.VCurrency^); +// vtVariant: resultParameters.Push(parameter.VVariant); + vtInterface: + if Supports(IInterface(parameter.VInterface), ILuaTable, table) then + resultParameters.Push(table); + + vtWideString: resultParameters.Push(string(PWideString(parameter.VWideString))); + vtInt64: resultParameters.Push(parameter.VInt64^); + vtUnicodeString: resultParameters.Push(string(PUnicodeString(parameter.VUnicodeString))); + else + raise ELuaUnsupportedParameterException.CreateFmt('Parameter type %d not supported (index: %d)', [parameter.VType, parameterIndex]); + end; + end; + + Result := resultParameters; +end; + + +class procedure TLuaHelpers.PushVariable(AState: lua_State; AVariable: ILuaVariable); +begin + PushVariable(AState, AVariable, AVariable.VariableType); +end; + + +class procedure TLuaHelpers.PushVariable(AState: lua_State; AVariable: ILuaVariable; AVariableType: TLuaVariableType); +begin + case AVariableType of + VariableNone: lua_pushnil(AState); + VariableBoolean: lua_pushboolean(AState, IfThen(AVariable.AsBoolean, 1, 0)); + VariableInteger: lua_pushinteger(AState, AVariable.AsInteger); + VariableNumber: lua_pushnumber(AState, AVariable.AsNumber); + VariableUserData: + if AVariable.AsUserData = nil then + lua_pushnil(AState) + else + lua_pushlightuserdata(AState, AVariable.AsUserData); + + VariableString: PushString(AState, AVariable.AsString); + VariableTable: PushTable(AState, AVariable.AsTable); + else + raise ELuaUnsupportedVariableException.CreateFmt('Variable type not supported: %d', [Ord(AVariableType)]); + end; +end; + + +class procedure TLuaHelpers.PushString(AState: lua_State; const AValue: string); +var + stringValue: PAnsiChar; + +begin + stringValue := AllocLuaString(AValue); + try + lua_pushlstring(AState, stringValue, Length(AValue)); + finally + FreeLuaString(stringValue); + end; +end; + + +class procedure TLuaHelpers.PushTable(AState: lua_State; ATable: ILuaTable); +var + pair: TLuaKeyValuePair; + +begin + lua_newtable(AState); + + for pair in ATable do + begin + PushVariable(AState, pair.Key); + PushVariable(AState, pair.Value); + lua_settable(AState, -3); + end; +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 +// to create a copy and be safe. +class function TLuaHelpers.AllocLuaString(const AValue: string): PAnsiChar; +begin + if Length(AValue) > 0 then + begin + GetMem(Result, Length(AValue) + 1); + StrPCopy(Result, AnsiString(AValue)); + end else + Result := nil; +end; + + +class procedure TLuaHelpers.FreeLuaString(AValue: PAnsiChar); +begin + FreeMem(AValue); +end; + +// If someone cares to reproduce this issue and optimize the code, use these +// two and the TableLuaFunction test should fail with a corrupted value +// (#11#0#0#0#11#0#0#0#11#0#0#0#11#0#0#0#11). +(* +class function TLuaHelpers.AllocLuaString(const AValue: string): PAnsiChar; +begin + if Length(AValue) > 0 then + Result := PAnsiChar(AnsiString(AValue)) + else + Result := nil; +end; + +class procedure TLuaHelpers.FreeLuaString(AValue: PAnsiChar); +begin +end; +*) + + + + +class procedure TLuaHelpers.RaiseLastLuaError(AState: lua_State); +var + errorMessage: string; + +begin + errorMessage := LuaToString(AState, -1); + lua_pop(AState, 1); + + raise ELuaException.Create(errorMessage); +end; + + +class function TLuaHelpers.LuaToString(AState: lua_State; AIndex: Integer): string; +var + len: NativeUint; + value: PAnsiChar; + stringValue: RawByteString; + +begin + value := lua_tolstring(AState, AIndex, @len); + SetString(stringValue, value, len); + + Result := string(stringValue); +end; + + +class function TLuaHelpers.CallFunction(AState: lua_State; AParameters: ILuaReadParameters): ILuaReadParameters; +var + stackIndex: Integer; + parameterCount: Integer; + parameter: ILuaVariable; + +begin + { Assumption: the function to call is the top item on the stack } + stackIndex := Pred(lua_gettop(AState)); + + parameterCount := 0; + if Assigned(AParameters) then + begin + parameterCount := AParameters.Count; + for parameter in AParameters do + PushVariable(AState, parameter); + end; + + if lua_pcall(AState, parameterCount, LUA_MULTRET, 0) <> 0 then + RaiseLastLuaError(AState); + + Result := TLuaResultParameters.Create(AState, lua_gettop(AState) - stackIndex); +end; + + +class function TLuaHelpers.NewRegistryKey: string; +begin + // This could be incremented on a per-State basis, but this'll do for now. + Result := Format('DelphiLuaWrapper_%d', [TInterlocked.Increment(RegistryKeyCounter)]); +end; + + + +{ TLuaImplicitVariable } +class operator TLuaImplicitVariable.Implicit(AValue: ILuaVariable): TLuaImplicitVariable; +begin + Result.Variable := AValue; +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: Boolean): TLuaImplicitVariable; +begin + Result.Variable := TLuaVariable.Create(AValue); +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: Integer): TLuaImplicitVariable; +begin + Result.Variable := TLuaVariable.Create(AValue); +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: Double): TLuaImplicitVariable; +begin + Result.Variable := TLuaVariable.Create(AValue); +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: Pointer): TLuaImplicitVariable; +begin + Result.Variable := TLuaVariable.Create(AValue); +end; + + +class operator TLuaImplicitVariable.Implicit(const AValue: string): TLuaImplicitVariable; +begin + Result.Variable := TLuaVariable.Create(AValue); +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: ILuaTable): TLuaImplicitVariable; +begin + Result.Variable := TLuaVariable.Create(AValue); +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: TLuaImplicitVariable): ILuaVariable; +begin + Result := AValue.Variable; +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: TLuaImplicitVariable): Boolean; +begin + Result := AValue.Variable.AsBoolean; +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: TLuaImplicitVariable): Integer; +begin + Result := AValue.Variable.AsInteger; +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: TLuaImplicitVariable): Double; +begin + Result := AValue.Variable.AsNumber; +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: TLuaImplicitVariable): Pointer; +begin + Result := AValue.Variable.AsUserData; +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: TLuaImplicitVariable): string; +begin + Result := AValue.Variable.AsString; +end; + + +class operator TLuaImplicitVariable.Implicit(AValue: TLuaImplicitVariable): ILuaTable; +begin + Result := AValue.Variable.AsTable; +end; + + +{ TLuaTableEnumerator } +constructor TLuaTableEnumerator.Create(AEnumerator: TEnumerator>); +begin + inherited Create; + + FEnumerator := AEnumerator; +end; + + +destructor TLuaTableEnumerator.Destroy; +begin + FreeAndNil(FEnumerator); + + inherited Destroy; +end; + + +function TLuaTableEnumerator.GetCurrent: TLuaKeyValuePair; +var + current: TPair; + +begin + current := FEnumerator.Current; + + Result.Key := current.Key; + Result.Value := current.Value; +end; + + +function TLuaTableEnumerator.MoveNext: Boolean; +begin + Result := FEnumerator.MoveNext; +end; + + +{ TLuaVariableEqualityComparer } +function TLuaVariableEqualityComparer.Equals(const Left, Right: ILuaVariable): Boolean; +begin + Result := (Left.VariableType = Right.VariableType); + if Result then + begin + case Left.VariableType of + VariableBoolean: Result := (Left.AsBoolean = Right.AsBoolean); + VariableInteger: Result := (Left.AsInteger = Right.AsInteger); + VariableNumber: Result := SameValue(Left.AsNumber, Right.AsNumber); + VariableUserData: Result := (Left.AsUserData = Right.AsUserData); + VariableString: Result := (Left.AsString = Right.AsString); + VariableTable: Result := (Left.AsTable = Right.AsTable); + end; + end; +end; + +function TLuaVariableEqualityComparer.GetHashCode(const Value: ILuaVariable): Integer; +var + i: Integer; + m: Extended; + e: Integer; + p: Pointer; + s: string; + +begin + Result := 0; + + // System.Generics.Defaults has a decent set of GetHashCode_ functions... + // ...which are of course private. + case Value.VariableType of + VariableBoolean: + Result := Ord(Value.AsBoolean); + VariableInteger: + begin + i := Value.AsInteger; + Result := BobJenkinsHash(i, SizeOf(i), 0); + end; + VariableNumber: + begin + // Denormalized floats and positive/negative 0.0 complicate things. + Frexp(Value.AsNumber, m, e); + if m = 0 then + m := Abs(m); + Result := BobJenkinsHash(m, SizeOf(m), 0); + Result := BobJenkinsHash(e, SizeOf(e), Result); + end; + VariableUserData: + begin + p := Value.AsUserData; + Result := BobJenkinsHash(p, SizeOf(p), 0); + end; + VariableString: + begin + s := Value.AsString; + if Length(s) > 0 then + Result := BobJenkinsHash(s[1], Length(s) * SizeOf(s[1]), 0); + end; + VariableTable: + begin + p := Pointer(Value.AsTable); + Result := BobJenkinsHash(p, SizeOf(p), 0); + end; + end; +end; + + +{ TLuaTable } +constructor TLuaTable.Create; +begin + inherited Create; + + FTable := TDictionary.Create(TLuaVariableEqualityComparer.Create); +end; + + +destructor TLuaTable.Destroy; +begin + FreeAndNil(FTable); + + inherited Destroy; +end; + + +function TLuaTable.GetEnumerator: ILuaTableEnumerator; +begin + Result := TLuaTableEnumerator.Create(FTable.GetEnumerator); +end; + + +function TLuaTable.HasValue(AKey: TLuaImplicitVariable): Boolean; +begin + Result := FTable.ContainsKey(AKey); +end; + +function TLuaTable.GetValue(AKey: TLuaImplicitVariable): ILuaVariable; +begin + Result := FTable[AKey]; +end; + + +procedure TLuaTable.SetValue(AKey, AValue: TLuaImplicitVariable); +begin + FTable.AddOrSetValue(AKey, AValue); +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; + 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 } +constructor TLuaScript.Create(const AData: string); +begin + Create(TStringStream.Create(AData), soOwned); +end; + + +constructor TLuaScript.Create(const AStream: TStream; AOwnership: TStreamOwnership); +begin + inherited Create; + + FStream := AStream; + FStreamOwnership := AOwnership; +end; + + +destructor TLuaScript.Destroy; +begin + if Assigned(FBuffer) then + FreeMem(FBuffer); + + if FStreamOwnership = soOwned then + FreeAndNil(FStream); + + inherited Destroy; +end; + + +function TLuaScript.GetNextChunk(out ASize: NativeUint): PAnsiChar; +const + BufferSize = 4096; + +begin + if not Assigned(FBuffer) then + GetMem(FBuffer, BufferSize); + + ASize := FStream.Read(FBuffer^, BufferSize); + if ASize > 0 then + Result := FBuffer + else + Result := nil; +end; + + + +{ Callback functions } +function LuaWrapperAlloc(ud, ptr: Pointer; osize, nsize: size_t): Pointer; cdecl; +begin + Result := TLua(ud).DoAlloc(ptr, osize, nsize); +end; + + +function LuaWrapperReader(L: lua_State; ud: Pointer; var sz: Lua.size_t): PAnsiChar; cdecl; +var + script: PLuaScript; + +begin + script := ud; + Result := script^.GetNextChunk(sz); +end; + + +function LuaWrapperWriter(L: lua_State; p: Pointer; sz: size_t; ud: Pointer): Integer; cdecl; +var + stream: TStream; + +begin + stream := TStream(ud^); + try + stream.WriteBuffer(p^, sz); + Result := 0; + except + on E:EStreamError do + Result := 1; + end; +end; + + +function LuaWrapperFunction(L: lua_State): Integer; cdecl; +var + lua: TLua; + cookie: Integer; + +begin + Result := 0; + + lua := TLua(lua_touserdata(L, lua_upvalueindex(1))); + cookie := lua_tointeger(L, lua_upvalueindex(2)); + + if Assigned(lua) then + Result := lua.RunRegisteredFunction(cookie); +end; + + +{ TLua } +constructor TLua.Create; +begin + inherited Create; + + FAutoOpenLibraries := [TLuaLibrary.All]; + FRegistrations := TLuaRegistrationList.Create(True); + FRegisteredFunctions := TLuaRegisteredFunctionDictionary.Create; +end; + + +destructor TLua.Destroy; +begin + FreeAndNil(FRegisteredFunctions); + FreeAndNil(FRegistrations); + + if HasState then + DoClose; + + inherited Destroy; +end; + + +procedure TLua.LoadFromString(const AData: string; AAutoRun: Boolean; const AChunkName: string); +begin + LoadFromScript(TLuaScript.Create(AData), soOwned, AAutoRun, AChunkName); +end; + + +procedure TLua.LoadFromStream(AStream: TStream; AOwnership: TStreamOwnership; AAutoRun: Boolean; const AChunkName: string); +begin + LoadFromScript(TLuaScript.Create(AStream, AOwnership), soOwned, AAutoRun, AChunkName); +end; + + +procedure TLua.LoadFromFile(const AFileName: string; AAutoRun: Boolean; const AChunkName: string); +var + chunkName: string; + +begin + if Length(AChunkName) > 0 then + chunkName := AChunkName + else + chunkName := ExtractFileName(AFileName); + + LoadFromScript(TLuaScript.Create(TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone), soOwned), soOwned, AAutoRun, chunkName); +end; + + +procedure TLua.LoadFromScript(AScript: TLuaScript; AOwnership: TStreamOwnership; AAutoRun: Boolean; const AChunkName: string); +var + chunkName: PAnsiChar; + +begin + try + chunkName := TLuaHelpers.AllocLuaString(AChunkName); + try + if lua_load(State, LuaWrapperReader, @AScript, chunkName, nil) <> 0 then + TLuaHelpers.RaiseLastLuaError(State); + finally + TLuaHelpers.FreeLuaString(chunkName); + end; + + if not Loaded then + AfterLoad; + + if AAutoRun then + Run; + finally + if AOwnership = soOwned then + FreeAndNil(AScript); + end; +end; + + +procedure TLua.OpenLibraries(ALibraries: TLuaLibraries); +begin + if TLuaLibrary.All in ALibraries then + luaL_openlibs(State) + else + begin + if TLuaLibrary.Base in ALibraries then + luaL_requiref(State, 'base', luaopen_base, 1); + + if TLuaLibrary.Coroutine in ALibraries then + luaL_requiref(State, 'coroutine', luaopen_coroutine, 1); + + if TLuaLibrary.Table in ALibraries then + luaL_requiref(State, 'table', luaopen_table, 1); + + if TLuaLibrary.IO in ALibraries then + luaL_requiref(State, 'io', luaopen_io, 1); + + if TLuaLibrary.OS in ALibraries then + luaL_requiref(State, 'os', luaopen_os, 1); + + if TLuaLibrary.StringLib in ALibraries then + luaL_requiref(State, 'string', luaopen_string, 1); + + if TLuaLibrary.Bit32 in ALibraries then + luaL_requiref(State, 'bit32', luaopen_bit32, 1); + + if TLuaLibrary.Math in ALibraries then + luaL_requiref(State, 'math', luaopen_math, 1); + + if TLuaLibrary.Debug in ALibraries then + luaL_requiref(State, 'debug', luaopen_debug, 1); + + if TLuaLibrary.Package in ALibraries then + luaL_requiref(State, 'package', luaopen_package, 1); + end; +end; + + +procedure TLua.Run; +begin + CheckIsFunction; + + if lua_pcall(State, 0, 0, 0) <> 0 then + TLuaHelpers.RaiseLastLuaError(State); + + HasRun := True; +end; + + +procedure TLua.GetByteCode(AStream: TStream; APop: Boolean); +var + returnCode: Integer; + +begin + CheckIsFunction; + + try + returnCode := lua_dump(State, LuaWrapperWriter, @AStream); + if returnCode <> 0 then + raise ELuaException.CreateFmt('lua_dump returned code %d', [returnCode]); + finally + if APop then + lua_pop(State, 1); + end; +end; + + +procedure TLua.Capture(const AName: string); +var + name: PAnsiChar; + +begin + CheckIsFunction; + + // Create a new table to serve as the environment + lua_newtable(State); + + // Set the global AName to the new table + lua_pushvalue(State, -1); + name := TLuaHelpers.AllocLuaString(AName); + try + lua_setglobal(State, name); + finally + TLuaHelpers.FreeLuaString(name); + end; + + // Set the global environment as the table's metatable index, so calls to + // global functions and variables still work + lua_newtable(State); + TLuaHelpers.PushString(State, '__index'); + lua_pushglobaltable(State); + lua_settable(State, -3); + + lua_setmetatable(State, -2); + + // Set the new table as the environment (upvalue at index 1) + lua_setupvalue(State, -2, 1); + + if lua_pcall(State, 0, 0, 0) <> 0 then + TLuaHelpers.RaiseLastLuaError(State); +end; + + +function TLua.Call(const AFunctionName: string): ILuaReadParameters; +begin + Result := Call(AFunctionName, nil); +end; + + +function TLua.Call(const AFunctionName: string; AParameters: array of const): ILuaReadParameters; +begin + Result := Call(AFunctionName, TLuaHelpers.CreateParameters(AParameters)); +end; + + +function TLua.Call(const AFunctionName: string; AParameters: ILuaReadParameters): ILuaReadParameters; +var + functionName: PAnsiChar; + +begin + { Global functions are only present after the has run once: + http://lua-users.org/lists/lua-l/2011-01/msg01154.html } + if not HasRun then + Run; + + functionName := TLuaHelpers.AllocLuaString(AFunctionName); + try + lua_getglobal(State, functionName); + finally + TLuaHelpers.FreeLuaString(functionName); + end; + + Result := TLuaHelpers.CallFunction(State, AParameters); +end; + + +procedure TLua.CheckState; +begin + if not LuaLibLoaded then + LoadLuaLib; + + if not HasState then + DoNewState; +end; + + +procedure TLua.CheckIsFunction; +begin + if not lua_isfunction(State, -1) then + raise ELuaNoFunctionException.Create('No function on top of the stack, use the LoadFrom methods first'); +end; + + +procedure TLua.AfterLoad; +var + registration: TCustomLuaRegistration; + +begin + Loaded := True; + HasRun := False; + + { Register functions in the current environment } + for registration in Registrations do + DoRegistration(registration); +end; + + +function TLua.GetGlobalVariable(const AName: string): ILuaVariable; +var + name: PAnsiChar; + +begin + name := TLuaHelpers.AllocLuaString(AName); + try + lua_getglobal(State, name); + + Result := TLuaCachedVariable.Create(State, -1); + lua_pop(State, 1); + finally + TLuaHelpers.FreeLuaString(name); + end; +end; + + +procedure TLua.SetGlobalVariable(const AName: string; AVariable: TLuaImplicitVariable); +var + name: PAnsiChar; + +begin + name := TLuaHelpers.AllocLuaString(AName); + try + TLuaHelpers.PushVariable(State, AVariable); + lua_setglobal(State, name); + finally + TLuaHelpers.FreeLuaString(name); + end; +end; + + +procedure TLua.RegisterFunction(const AName: string; AFunction: TLuaCFunction); +begin + { Since anonymous methods are basically interfaces, we need to keep a reference around } + AddRegistration(TLuaFunctionRegistration.Create(AName, AFunction)); +end; + + +procedure TLua.RegisterFunctions(AObject: TObject; const ATableName: string; AIncludePublicVisibility: Boolean); + + { 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; + 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; + + +function TLua.DoAlloc(APointer: Pointer; AOldSize, ANewSize: NativeUint): Pointer; +begin + Result := DefaultLuaAlloc(nil, APointer, AOldSize, ANewSize); +end; + + +procedure TLua.DoNewState; +begin + FState := lua_newstate(@LuaWrapperAlloc, Pointer(Self)); + if not HasState then + raise ELuaInitException.Create('Failed to initialize new state'); + + OpenLibraries(AutoOpenLibraries); +end; + + +procedure TLua.DoClose; +begin + lua_close(FState); + FState := nil; +end; + + +procedure TLua.DoRegistration(ARegistration: TCustomLuaRegistration); +var + this: TLua; + +begin + this := Self; + + ARegistration.Apply(State, + procedure(AFunction: TLuaCFunction) + var + cookie: Integer; + + begin + cookie := GetRegisteredFunctionCookie; + RegisteredFunctions.Add(cookie, AFunction); + + lua_pushlightuserdata(State, this); + 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; + + +function TLua.GetRegisteredFunctionCookie: Integer; +begin + Inc(FRegisteredFunctionCookie); + Result := FRegisteredFunctionCookie; +end; + + +function TLua.RunRegisteredFunction(ACookie: Integer): Integer; +var + context: ILuaContext; + +begin + Result := 0; + + if RegisteredFunctions.ContainsKey(ACookie) then + begin + context := TLuaContext.Create(State); + + try + RegisteredFunctions[ACookie](context); + Result := context.Result.Count; + except + on E:Exception do + Result := luaL_error(State, PAnsiChar(AnsiString(E.Message)), nil); + end; + end; +end; + + +function TLua.GetHasState: Boolean; +begin + Result := Assigned(FState); +end; + + +function TLua.GetState: lua_State; +begin + CheckState; + Result := FState; +end; + + +procedure TLua.SetAutoOpenLibraries(const Value: TLuaLibraries); +begin + FAutoOpenLibraries := Value; +end; + + +{ TLuaParametersEnumerator } +constructor TLuaParametersEnumerator.Create(AParameters: ILuaReadParameters); +begin + inherited Create; + FParameters := AParameters; + FIndex := -1; +end; + +function TLuaParametersEnumerator.GetCurrent: ILuaVariable; +begin + Result := Parameters.Items[FIndex]; +end; + + +function TLuaParametersEnumerator.MoveNext: Boolean; +begin + Inc(FIndex); + Result := FIndex < Parameters.Count; +end; + + +{ TCustomLuaParameters } +function TCustomLuaParameters.GetEnumerator: ILuaParametersEnumerator; +begin + Result := TLuaParametersEnumerator.Create(Self); +end; + + +function TCustomLuaParameters.GetVariableType: TLuaVariableType; +begin + Result := GetDefaultVariable.GetVariableType; +end; + + +function TCustomLuaParameters.GetDataType: TLuaDataType; +begin + Result := GetDefaultVariable.GetDataType; +end; + + +function TCustomLuaParameters.GetAsBoolean: Boolean; +begin + Result := GetDefaultVariable.GetAsBoolean; +end; + + +function TCustomLuaParameters.GetAsInteger: Integer; +begin + Result := GetDefaultVariable.GetAsInteger; +end; + + +function TCustomLuaParameters.GetAsNumber: Double; +begin + Result := GetDefaultVariable.GetAsNumber; +end; + + +function TCustomLuaParameters.GetAsUserData: Pointer; +begin + Result := GetDefaultVariable.GetAsUserData; +end; + + +function TCustomLuaParameters.GetAsString: string; +begin + Result := GetDefaultVariable.GetAsString; +end; + + +function TCustomLuaParameters.GetAsTable: ILuaTable; +begin + Result := GetDefaultVariable.GetAsTable; +end; + + +function TCustomLuaParameters.GetAsFunction: ILuaFunction; +begin + Result := GetDefaultVariable.GetAsFunction; +end; + + +procedure TCustomLuaParameters.SetAsBoolean(ABoolean: Boolean); +begin + GetDefaultVariable.SetAsBoolean(ABoolean); +end; + + +procedure TCustomLuaParameters.SetAsInteger(AInteger: Integer); +begin + GetDefaultVariable.SetAsInteger(AInteger); +end; + + +procedure TCustomLuaParameters.SetAsNumber(ANumber: Double); +begin + GetDefaultVariable.SetAsNumber(ANumber); +end; + + +procedure TCustomLuaParameters.SetAsUserData(AUserData: Pointer); +begin + GetDefaultVariable.SetAsUserData(AUserData); +end; + + +procedure TCustomLuaParameters.SetAsString(AString: string); +begin + GetDefaultVariable.SetAsString(AString); +end; + + +procedure TCustomLuaParameters.SetAsTable(ATable: ILuaTable); +begin + GetDefaultVariable.SetAsTable(ATable); +end; + + +function TCustomLuaParameters.GetDefaultVariable: ILuaVariable; +begin + Result := GetItem(0); +end; + + +function TCustomLuaParameters.ToString: string; +var + parameterIndex: Integer; + +begin + Result := ''; + + for parameterIndex := 0 to Pred(GetCount) do + Result := Result + GetItem(parameterIndex).AsString; +end; + + +{ TLuaCFunctionParameters } +constructor TLuaStackParameters.Create(AState: lua_State; ACount: Integer); +begin + inherited Create; + + FState := AState; + FCount := ACount; + + if FCount = -1 then + FCount := lua_gettop(State); +end; + + +function TLuaStackParameters.GetCount: Integer; +begin + Result := FCount; +end; + + +function TLuaStackParameters.GetItem(Index: Integer): ILuaVariable; +begin + if (Index < 0) or (Index >= GetCount) then + raise ERangeError.CreateFmt('Invalid parameter index: %d', [Index]); + + Result := TLuaStackVariable.Create(State, Succ(Index)); +end; + + +{ TLuaCFunctionParameter } +constructor TLuaStackVariable.Create(AState: lua_State; AIndex: Integer); +begin + inherited Create; + + FState := AState; + FIndex := AIndex; +end; + + +function TLuaStackVariable.GetVariableType: TLuaVariableType; +begin + Result := TLuaHelpers.GetLuaVariableType(GetDataType); +end; + + +function TLuaStackVariable.GetDataType: TLuaDataType; +begin + Result := TLuaHelpers.GetLuaDataType(lua_type(State, Index)); +end; + + +function TLuaStackVariable.GetAsBoolean: Boolean; +begin + Result := (lua_toboolean(State, Index) <> 0); +end; + + +function TLuaStackVariable.GetAsInteger: Integer; +begin + Result := lua_tointeger(State, Index); +end; + + +function TLuaStackVariable.GetAsNumber: Double; +begin + Result := lua_tonumber(State, Index); +end; + + +function TLuaStackVariable.GetAsUserData: Pointer; +begin + Result := lua_touserdata(State, Index); +end; + + +function TLuaStackVariable.GetAsString: string; +begin + Result := TLuaHelpers.LuaToString(State, Index); +end; + + +function TLuaStackVariable.GetAsTable: ILuaTable; +begin + if not lua_istable(State, Index) then + Result := nil; + + if not Assigned(FTable) then + FTable := TLuaCachedTable.Create(State, Index); + + Result := FTable; +end; + + +function TLuaStackVariable.GetAsFunction: ILuaFunction; +begin + if not lua_isfunction(State, Index) then + Result := nil; + + Result := TLuaFunction.Create(State, Index); +end; + + +procedure TLuaStackVariable.SetAsBoolean(ABoolean: Boolean); +begin + lua_pushboolean(State, IfThen(ABoolean, 1, 0)); + lua_replace(State, Index); +end; + + +procedure TLuaStackVariable.SetAsInteger(AInteger: Integer); +begin + TLuaHelpers.PushVariable(State, Self, VariableInteger); + lua_replace(State, Index); +end; + + +procedure TLuaStackVariable.SetAsNumber(ANumber: Double); +begin + TLuaHelpers.PushVariable(State, Self, VariableNumber); + lua_replace(State, Index); +end; + + +procedure TLuaStackVariable.SetAsString(AString: string); +begin + TLuaHelpers.PushVariable(State, Self, VariableString); + lua_replace(State, Index); +end; + + +procedure TLuaStackVariable.SetAsTable(ATable: ILuaTable); +begin + TLuaHelpers.PushVariable(State, Self, VariableTable); + lua_replace(State, Index); +end; + + +procedure TLuaStackVariable.SetAsUserData(AUserData: Pointer); +begin + TLuaHelpers.PushVariable(State, Self, VariableUserData); + lua_replace(State, Index); +end; + + +{ TLuaResultParameters } +constructor TLuaResultParameters.Create(AState: lua_State; ACount: Integer); +var + parameterIndex: Integer; + +begin + inherited Create; + + FParameters := TList.Create; + + if ACount > 0 then + begin + FParameters.Capacity := ACount; + + for parameterIndex := ACount downto 1 do + FParameters.Add(TLuaCachedVariable.Create(AState, -ACount)); + + lua_pop(AState, ACount); + end; +end; + + +destructor TLuaResultParameters.Destroy; +begin + FreeAndNil(FParameters); + + inherited Destroy; +end; + + +function TLuaResultParameters.GetCount: Integer; +begin + Result := FParameters.Count; +end; + + +function TLuaResultParameters.GetItem(Index: Integer): ILuaVariable; +begin + Result := FParameters[Index]; +end; + + +{ TLuaVariable } +constructor TLuaVariable.Create; +begin +end; + + +constructor TLuaVariable.Create(ABoolean: Boolean); +begin + Create; + SetAsBoolean(ABoolean); +end; + + +constructor TLuaVariable.Create(AInteger: Integer); +begin + Create; + SetAsInteger(AInteger); +end; + + +constructor TLuaVariable.Create(ANumber: Double); +begin + Create; + SetAsNumber(ANumber); +end; + + +constructor TLuaVariable.Create(AUserData: Pointer); +begin + Create; + SetAsUserData(AUserData); +end; + + +constructor TLuaVariable.Create(const AString: string); +begin + Create; + SetAsString(AString); +end; + + +constructor TLuaVariable.Create(AFunction: ILuaFunction); +begin + Create; + VariableType := VariableFunction; + DataType := LuaFunction; + FunctionValue := AFunction; +end; + + +constructor TLuaVariable.Create(ATable: ILuaTable); +begin + Create; + SetAsTable(ATable); +end; + + +function TLuaVariable.GetVariableType: TLuaVariableType; +begin + Result := VariableType; +end; + + +function TLuaVariable.GetDataType: TLuaDataType; +begin + Result := DataType; +end; + + +function TLuaVariable.GetAsBoolean: Boolean; +begin + Result := BooleanValue; +end; + + +function TLuaVariable.GetAsInteger: Integer; +begin + Result := IntegerValue; +end; + + +function TLuaVariable.GetAsNumber: Double; +begin + Result := NumberValue; +end; + + +function TLuaVariable.GetAsUserData: Pointer; +begin + Result := UserDataValue; +end; + + +function TLuaVariable.GetAsString: string; +begin + Result := StringValue; +end; + + +function TLuaVariable.GetAsTable: ILuaTable; +begin + Result := TableValue; +end; + + +function TLuaVariable.GetAsFunction: ILuaFunction; +begin + Result := FunctionValue; +end; + + +procedure TLuaVariable.SetAsBoolean(ABoolean: Boolean); +begin + VariableType := VariableBoolean; + DataType := LuaBoolean; + BooleanValue := ABoolean; +end; + + +procedure TLuaVariable.SetAsInteger(AInteger: Integer); +begin + VariableType := VariableInteger; + DataType := LuaString; + IntegerValue := AInteger; +end; + + +procedure TLuaVariable.SetAsNumber(ANumber: Double); +begin + VariableType := VariableNumber; + DataType := LuaNumber; + NumberValue := ANumber; +end; + + +procedure TLuaVariable.SetAsUserData(AUserData: Pointer); +begin + VariableType := VariableUserData; + DataType := LuaLightUserData; + UserDataValue := AUserData; +end; + + +procedure TLuaVariable.SetAsString(AString: string); +begin + VariableType := VariableString; + DataType := LuaString; + StringValue := AString; +end; + + +procedure TLuaVariable.SetAsTable(ATable: ILuaTable); +begin + VariableType := VariableTable; + DataType := LuaTable; + TableValue := ATable; +end; + + +{ TLuaCachedVariable } +constructor TLuaCachedVariable.Create(AState: lua_State; AIndex: Integer); +begin + inherited Create; + + DataType := TLuaHelpers.GetLuaDataType(lua_type(AState, AIndex)); + VariableType := TLuaHelpers.GetLuaVariableType(FDataType); + + BooleanValue := (lua_toboolean(AState, AIndex) <> 0); + IntegerValue := lua_tointeger(AState, AIndex); + NumberValue := lua_tonumber(AState, AIndex); + UserDataValue := lua_touserdata(AState, AIndex); + + { While traversing a table, do not call lua_tolstring directly on a key, + unless you know that the key is actually a string. Recall that lua_tolstring + may change the value at the given index; this confuses the next call to + lua_next. + + http://www.lua.org/manual/5.2/manual.html#lua_next } + case lua_type(AState, AIndex) of + LUA_TSTRING: StringValue := TLuaHelpers.LuaToString(AState, AIndex); + LUA_TNUMBER: StringValue := FloatToStr(NumberValue); + end; + + if lua_istable(AState, AIndex) then + TableValue := TLuaCachedTable.Create(AState, AIndex); + + if lua_isfunction(AState, AIndex) then + FunctionValue := TLuaFunction.Create(AState, AIndex); +end; + + +{ TLuaCachedTable } +constructor TLuaCachedTable.Create(AState: lua_State; AIndex: Integer); +var + tableIndex: Integer; + key: ILuaVariable; + value: ILuaVariable; + +begin + inherited Create; + + lua_pushnil(AState); + + tableIndex := AIndex; + if AIndex < 0 then + Dec(tableIndex); + + while (lua_next(AState, tableIndex) <> 0) do + begin + key := TLuaCachedVariable.Create(AState, -2); + value := TLuaCachedVariable.Create(AState, -1); + + SetValue(key, value); + + { Remove value, keep key for the next iteration } + lua_pop(AState, 1); + end; +end; + + +{ TLuaReadWriteParameters } +constructor TLuaReadWriteParameters.Create; +begin + inherited Create; + + FParameters := TList.Create; +end; + + +destructor TLuaReadWriteParameters.Destroy; +begin + FreeAndNil(FParameters); + + inherited Destroy; +end; + + +function TLuaReadWriteParameters.GetCount: Integer; +begin + Result := FParameters.Count; +end; + + +function TLuaReadWriteParameters.GetItem(Index: Integer): ILuaVariable; +begin + Result := FParameters[Index]; +end; + + +procedure TLuaReadWriteParameters.Push(ABoolean: Boolean); +begin + FParameters.Add(TLuaVariable.Create(ABoolean)); +end; + + +procedure TLuaReadWriteParameters.Push(AInteger: Integer); +begin + FParameters.Add(TLuaVariable.Create(AInteger)); +end; + + +procedure TLuaReadWriteParameters.Push(ANumber: Double); +begin + FParameters.Add(TLuaVariable.Create(ANumber)); +end; + + +procedure TLuaReadWriteParameters.Push(AUserData: Pointer); +begin + FParameters.Add(TLuaVariable.Create(AUserData)); +end; + + +procedure TLuaReadWriteParameters.Push(const AString: string); +begin + FParameters.Add(TLuaVariable.Create(AString)); +end; + + +procedure TLuaReadWriteParameters.Push(ATable: ILuaTable); +begin + FParameters.Add(TLuaVariable.Create(ATable)); +end; + + +{ TLuaContext } +constructor TLuaContext.Create(AState: lua_State); +begin + inherited Create; + + FParameters := TLuaStackParameters.Create(AState); + FResult := TLuaStackWriteParameters.Create(AState); +end; + + +function TLuaContext.GetParameters: ILuaReadParameters; +begin + Result := FParameters; +end; + + +function TLuaContext.GetResult: ILuaWriteParameters; +begin + Result := FResult; +end; + + +{ TLuaResult } +constructor TLuaStackWriteParameters.Create(AState: lua_State); +begin + inherited Create; + + FState := AState; +end; + + +function TLuaStackWriteParameters.GetCount: Integer; +begin + Result := FCount; +end; + + +procedure TLuaStackWriteParameters.Push(ABoolean: Boolean); +begin + lua_pushboolean(State, IfThen(ABoolean, 1, 0)); + Pushed; +end; + + +procedure TLuaStackWriteParameters.Push(AInteger: Integer); +begin + lua_pushinteger(State, AInteger); + Pushed; +end; + + +procedure TLuaStackWriteParameters.Push(ANumber: Double); +begin + lua_pushnumber(State, ANumber); + Pushed; +end; + + +procedure TLuaStackWriteParameters.Push(AUserData: Pointer); +begin + if AUserData = nil then + lua_pushnil(State) + else + lua_pushlightuserdata(State, AUserData); + + Pushed; +end; + + +procedure TLuaStackWriteParameters.Push(const AString: string); +var + value: PAnsiChar; + +begin + value := TLuaHelpers.AllocLuaString(AString); + try + lua_pushlstring(State, value, Length(AString)); + Pushed; + finally + TLuaHelpers.FreeLuaString(value); + end; +end; + + +procedure TLuaStackWriteParameters.Push(ATable: ILuaTable); +begin + TLuaHelpers.PushTable(State, ATable); + Pushed; +end; + + +procedure TLuaStackWriteParameters.Pushed; +begin + Inc(FCount); +end; + + +{ TLuaCFunction } +constructor TLuaFunction.Create(AState: lua_State; AIndex: Integer); +var + actualIndex: Integer; + +begin + inherited Create; + + FState := AState; + + // There is no way to retrieve the function in a way that allows pushing + // it back later. Instead, make use of Lua's registry: + // http://stackoverflow.com/questions/1416797/reference-to-lua-function-in-c-c + FRegistryKey := TLuaHelpers.NewRegistryKey; + actualIndex := AIndex; + + // If the index is relative to the top, compensate for pushing the key + if actualIndex < 0 then + Dec(actualIndex); + + TLuaHelpers.PushString(AState, RegistryKey); + lua_pushvalue(AState, actualIndex); + lua_rawset(AState, LUA_REGISTRYINDEX); +end; + + +destructor TLuaFunction.Destroy; +begin + TLuaHelpers.PushString(State, RegistryKey); + lua_pushnil(State); + lua_rawset(State, LUA_REGISTRYINDEX); + + inherited Destroy; +end; + + +function TLuaFunction.Call: ILuaReadParameters; +begin + Result := Call(nil); +end; + + +function TLuaFunction.Call(AParameters: array of const): ILuaReadParameters; +begin + Result := Call(TLuaHelpers.CreateParameters(AParameters)); +end; + + +function TLuaFunction.Call(AParameters: ILuaReadParameters): ILuaReadParameters; +begin + TLuaHelpers.PushString(State, RegistryKey); + lua_rawget(State, LUA_REGISTRYINDEX); + + Result := TLuaHelpers.CallFunction(State, AParameters); +end; + +end. diff --git a/G940LEDControl/DelphiLua/readme.txt b/G940LEDControl/DelphiLua/readme.txt new file mode 100644 index 0000000..cf1b522 --- /dev/null +++ b/G940LEDControl/DelphiLua/readme.txt @@ -0,0 +1 @@ +Source: https://git.x2software.net/delphi/delphilua \ No newline at end of file diff --git a/G940LEDControl/Forms/MainFrm.dfm b/G940LEDControl/Forms/MainFrm.dfm index 2d46e27..c99ab00 100644 --- a/G940LEDControl/Forms/MainFrm.dfm +++ b/G940LEDControl/Forms/MainFrm.dfm @@ -375,6 +375,10 @@ object MainForm: TMainForm object tsConfiguration: TTabSheet Caption = ' Configuration ' ImageIndex = 2 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 DesignSize = ( 442 452) @@ -529,6 +533,10 @@ object MainForm: TMainForm object tsAbout: TTabSheet Caption = 'About' ImageIndex = 1 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblVersionCaption: TLabel Left = 16 Top = 67 diff --git a/G940LEDControl/Forms/MainFrm.pas b/G940LEDControl/Forms/MainFrm.pas index 1fd6bb5..5f6f0eb 100644 --- a/G940LEDControl/Forms/MainFrm.pas +++ b/G940LEDControl/Forms/MainFrm.pas @@ -225,6 +225,7 @@ type implementation uses System.SysUtils, + System.Types, System.Win.ComObj, Vcl.Dialogs, Vcl.Graphics, @@ -241,6 +242,7 @@ uses ButtonFunctionFrm, ConfigConversion, FSXAutoLaunch, + FSXLEDFunctionProvider, FSXLEDFunctionProviderIntf, FSXResources, FSXSimConnectStateMonitor, @@ -248,6 +250,7 @@ uses LEDColorIntf, LEDFunctionIntf, LEDFunctionRegistry, + StaticLEDFunction, StaticResources; @@ -258,6 +261,9 @@ const DefaultProfileName = 'Default'; ProfilePostfixModified = ' (modified)'; + ScriptsPath = 'Scripts\'; + FSXScriptsPath = ScriptsPath + 'FSX\'; + UserDataPath = 'G940LEDControl\'; FilenameProfiles = UserDataPath + 'Profiles.xml'; FilenameSettings = UserDataPath + 'Settings.xml'; @@ -302,6 +308,7 @@ procedure TMainForm.FormCreate(Sender: TObject); var worker: IOmniWorker; + scriptPaths: TStringDynArray; begin FLog := TX2GlobalLog.Category('UI'); @@ -316,6 +323,16 @@ begin SetFSXState(TextFSXDisconnected, False); + + TLEDFunctionRegistry.Register(TStaticLEDFunctionProvider.Create); + + SetLength(scriptPaths, 2); + scriptPaths[0] := App.Path + FSXScriptsPath; + scriptPaths[1] := App.UserPath + UserDataPath + FSXScriptsPath; + + TLEDFunctionRegistry.Register(TFSXLEDFunctionProvider.Create(scriptPaths)); + + FEventMonitor := TOmniEventMonitor.Create(Self); Log.Info('Starting G940 LED state consumer thread'); diff --git a/G940LEDControl/G940LEDControl.dpr b/G940LEDControl/G940LEDControl.dpr index 0d25542..6321365 100644 --- a/G940LEDControl/G940LEDControl.dpr +++ b/G940LEDControl/G940LEDControl.dpr @@ -38,7 +38,10 @@ uses FSXLEDFunctionProviderIntf in 'Units\FSXLEDFunctionProviderIntf.pas', SimBaseDocumentXMLBinding in 'Units\SimBaseDocumentXMLBinding.pas', FSXAutoLaunch in 'Units\FSXAutoLaunch.pas', - ControlIntf in 'Units\ControlIntf.pas'; + ControlIntf in 'Units\ControlIntf.pas', + Lua.API in 'DelphiLua\Lua.API.pas', + Lua in 'DelphiLua\Lua.pas', + LuaLEDFunctionProvider in 'Units\LuaLEDFunctionProvider.pas'; {$R *.res} @@ -65,7 +68,6 @@ begin Application.ShowMainForm := not isRestarting; Application.Title := 'G940 LED Control'; Application.CreateForm(TMainForm, MainForm); - if isRestarting then MainForm.Visible := True; diff --git a/G940LEDControl/G940LEDControl.dproj b/G940LEDControl/G940LEDControl.dproj index 3fde1cf..a9bb03c 100644 --- a/G940LEDControl/G940LEDControl.dproj +++ b/G940LEDControl/G940LEDControl.dproj @@ -8,7 +8,7 @@ VCL 13.4 True - Release + Debug Win32 1 Application @@ -142,6 +142,9 @@ + + + Cfg_2 Base diff --git a/G940LEDControl/G940LEDControl.res b/G940LEDControl/G940LEDControl.res index 794a31c..4ed79be 100644 Binary files a/G940LEDControl/G940LEDControl.res and b/G940LEDControl/G940LEDControl.res differ diff --git a/G940LEDControl/Units/FSXLEDFunction.pas b/G940LEDControl/Units/FSXLEDFunction.pas index a9bce87..638ee9b 100644 --- a/G940LEDControl/Units/FSXLEDFunction.pas +++ b/G940LEDControl/Units/FSXLEDFunction.pas @@ -1,6 +1,7 @@ unit FSXLEDFunction; interface + (* uses FSXLEDFunctionProvider, LEDFunction, @@ -337,9 +338,11 @@ type function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override; end; + *) implementation +(* uses FSXLEDFunctionWorker, FSXResources, @@ -1086,6 +1089,6 @@ end; function TFSXATCVisibilityFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; begin Result := TFSXATCVisibilityFunctionWorker; -end; +end;*) end. diff --git a/G940LEDControl/Units/FSXLEDFunctionProvider.pas b/G940LEDControl/Units/FSXLEDFunctionProvider.pas index 76782f0..ed5d603 100644 --- a/G940LEDControl/Units/FSXLEDFunctionProvider.pas +++ b/G940LEDControl/Units/FSXLEDFunctionProvider.pas @@ -4,79 +4,74 @@ interface uses Generics.Collections, System.SyncObjs, + System.Types, X2Log.Intf, + Lua, FSXLEDFunctionProviderIntf, FSXSimConnectIntf, LEDFunction, LEDFunctionIntf, - LEDStateIntf; + LEDStateIntf, + LuaLEDFunctionProvider; type - TCustomFSXFunction = class; - TCustomFSXFunctionList = TObjectList; + TFSXLEDFunctionWorker = class; - TFSXLEDFunctionProvider = class(TCustomLEDFunctionProvider, IFSXLEDFunctionProvider, IFSXSimConnectObserver) + TFSXLEDFunctionProvider = class(TCustomLuaLEDFunctionProvider, IFSXLEDFunctionProvider, IFSXSimConnectObserver) private FSimConnect: TInterfacedObject; FSimConnectLock: TCriticalSection; FProfileMenuSimConnect: IFSXSimConnectProfileMenu; + FScriptSimConnect: TObject; protected - procedure RegisterFunctions; override; - function GetUID: string; override; - protected + function CreateLuaLEDFunction(AInfo: ILuaTable; AOnSetup: ILuaFunction): TCustomLuaLEDFunction; override; + + procedure InitInterpreter; override; + procedure SetupWorker(AWorker: TFSXLEDFunctionWorker; AOnSetup: ILuaFunction); + { IFSXSimConnectObserver } procedure ObserveDestroy(Sender: IFSXSimConnect); { IFSXLEDFunctionProvider } procedure SetProfileMenu(AEnabled: Boolean; ACascaded: Boolean); public - constructor Create; + constructor Create(const AScriptFolders: TStringDynArray); destructor Destroy; override; function GetSimConnect: IFSXSimConnect; end; - TCustomFSXFunction = class(TCustomMultiStateLEDFunction) + TFSXLEDFunction = class(TCustomLuaLEDFunction) private FProvider: TFSXLEDFunctionProvider; - FDisplayName: string; - FUID: string; protected + function GetDefaultCategoryName: string; override; + + function GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; override; procedure InitializeWorker(AWorker: TCustomLEDMultiStateFunctionWorker); override; property Provider: TFSXLEDFunctionProvider read FProvider; - protected - function GetCategoryName: string; override; - function GetDisplayName: string; override; - function GetUID: string; override; public - constructor Create(AProvider: TFSXLEDFunctionProvider; const ADisplayName, AUID: string); + constructor Create(AProvider: TFSXLEDFunctionProvider; AInfo: ILuaTable; AOnSetup: ILuaFunction); end; - TCustomFSXFunctionClass = class of TCustomFSXFunction; - - - TCustomFSXFunctionWorker = class(TCustomLEDMultiStateFunctionWorker) + TFSXLEDFunctionWorker = class(TCustomLuaLEDFunctionWorker) private FDataHandler: IFSXSimConnectDataHandler; - FDefinitionID: Cardinal; - FSimConnect: IFSXSimConnect; + FDefinitionID: TList; protected - procedure RegisterVariables(ADefinition: IFSXSimConnectDefinition); virtual; abstract; - - procedure SetSimConnect(const Value: IFSXSimConnect); virtual; - property DataHandler: IFSXSimConnectDataHandler read FDataHandler; - property DefinitionID: Cardinal read FDefinitionID; - property SimConnect: IFSXSimConnect read FSimConnect write SetSimConnect; + property DefinitionID: TList read FDefinitionID; protected + procedure AddDefinition(ADefinition: IFSXSimConnectDefinition); + procedure HandleData(AData: Pointer); virtual; abstract; public constructor Create(const AProviderUID, AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''); override; @@ -86,6 +81,7 @@ type implementation uses + System.Classes, System.SysUtils, X2Log.Global, @@ -100,37 +96,88 @@ uses type TCustomFSXFunctionWorkerDataHandler = class(TInterfacedObject, IFSXSimConnectDataHandler) private - FWorker: TCustomFSXFunctionWorker; + FWorker: TFSXLEDFunctionWorker; protected { IFSXSimConnectDataHandler } procedure HandleData(AData: Pointer); - property Worker: TCustomFSXFunctionWorker read FWorker; + property Worker: TFSXLEDFunctionWorker read FWorker; public - constructor Create(AWorker: TCustomFSXFunctionWorker); + constructor Create(AWorker: TFSXLEDFunctionWorker); end; + TLuaSimConnect = class(TPersistent) + private + FProvider: TFSXLEDFunctionProvider; + protected + property Provider: TFSXLEDFunctionProvider read FProvider; + public + constructor Create(AProvider: TFSXLEDFunctionProvider); + published + procedure Monitor(Context: ILuaContext); + end; + + +type + TLuaSimConnectType = record + TypeName: string; + Units: string; + DataType: SIMCONNECT_DATAType; + end; + +const + LuaSimConnectTypes: array[0..4] of TLuaSimConnectType = + ( + ( TypeName: 'Bool'; Units: FSX_UNIT_BOOL; DataType: SIMCONNECT_DATAType_INT32 ), + ( TypeName: 'Percent'; Units: FSX_UNIT_PERCENT; DataType: SIMCONNECT_DATAType_FLOAT64 ), + ( TypeName: 'Integer'; Units: FSX_UNIT_NUMBER; DataType: SIMCONNECT_DATAType_INT32 ), + ( TypeName: 'Float'; Units: FSX_UNIT_NUMBER; DataType: SIMCONNECT_DATAType_FLOAT64 ), + ( TypeName: 'Mask'; Units: FSX_UNIT_MASK; DataType: SIMCONNECT_DATATYPE_INT32 ) + ); + + +function GetUnits(const AType: string; out AUnits: string; out ADataType: SIMCONNECT_DATAType): Boolean; +var + typeIndex: Integer; + +begin + for typeIndex := Low(LuaSimConnectTypes) to High(LuaSimConnectTypes) do + if SameText(AType, LuaSimConnectTypes[typeIndex].TypeName) then + begin + AUnits := LuaSimConnectTypes[typeIndex].Units; + ADataType := LuaSimConnectTypes[typeIndex].DataType; + Exit(True); + end; + + Result := False; +end; + { TFSXLEDFunctionProvider } -constructor TFSXLEDFunctionProvider.Create; +constructor TFSXLEDFunctionProvider.Create(const AScriptFolders: TStringDynArray); begin - inherited Create; - FSimConnectLock := TCriticalSection.Create; + FScriptSimConnect := TLuaSimConnect.Create(Self); + + inherited Create(AScriptFolders); end; destructor TFSXLEDFunctionProvider.Destroy; begin + FreeAndNil(FScriptSimConnect); FreeAndNil(FSimConnectLock); inherited Destroy; end; +(* procedure TFSXLEDFunctionProvider.RegisterFunctions; begin + inherited RegisterFunctions; + { Systems } RegisterFunction(TFSXBatteryMasterFunction.Create( Self, FSXFunctionDisplayNameBatteryMaster, FSXFunctionUIDBatteryMaster)); RegisterFunction(TFSXDeIceFunction.Create( Self, FSXFunctionDisplayNameDeIce, FSXFunctionUIDDeIce)); @@ -193,6 +240,36 @@ begin { ATC } RegisterFunction(TFSXATCVisibilityFunction.Create(FSXProviderUID)); end; +*) + +function TFSXLEDFunctionProvider.CreateLuaLEDFunction(AInfo: ILuaTable; AOnSetup: ILuaFunction): TCustomLuaLEDFunction; +begin + Result := TFSXLEDFunction.Create(Self, AInfo, AOnSetup); +end; + + +procedure TFSXLEDFunctionProvider.InitInterpreter; +var + simConnectType: ILuaTable; + typeIndex: Integer; + +begin + inherited InitInterpreter; + + Interpreter.RegisterFunctions(FScriptSimConnect, 'SimConnect'); + + simConnectType := TLuaTable.Create; + for typeIndex := Low(LuaSimConnectTypes) to High(LuaSimConnectTypes) do + simConnectType.SetValue(LuaSimConnectTypes[typeIndex].TypeName, LuaSimConnectTypes[typeIndex].TypeName); + + Interpreter.SetGlobalVariable('SimConnectType', simConnectType); +end; + + +procedure TFSXLEDFunctionProvider.SetupWorker(AWorker: TFSXLEDFunctionWorker; AOnSetup: ILuaFunction); +begin + AOnSetup.Call([AWorker.UID]); +end; function TFSXLEDFunctionProvider.GetUID: string; @@ -245,81 +322,80 @@ end; -{ TCustomFSXFunction } -constructor TCustomFSXFunction.Create(AProvider: TFSXLEDFunctionProvider; const ADisplayName, AUID: string); +{ TFSXLEDFunction } +constructor TFSXLEDFunction.Create(AProvider: TFSXLEDFunctionProvider; AInfo: ILuaTable; AOnSetup: ILuaFunction); begin - inherited Create(AProvider.GetUID); + inherited Create(AProvider, AInfo, AOnSetup); FProvider := AProvider; - FDisplayName := ADisplayName; - FUID := AUID; end; -procedure TCustomFSXFunction.InitializeWorker(AWorker: TCustomLEDMultiStateFunctionWorker); -begin - (AWorker as TCustomFSXFunctionWorker).SimConnect := Provider.GetSimConnect; -end; - - -function TCustomFSXFunction.GetCategoryName: string; +function TFSXLEDFunction.GetDefaultCategoryName: string; begin Result := FSXCategory; end; -function TCustomFSXFunction.GetDisplayName: string; +function TFSXLEDFunction.GetWorkerClass: TCustomLEDMultiStateFunctionWorkerClass; begin - Result := FDisplayName; + Result := TFSXLEDFunctionWorker; end; -function TCustomFSXFunction.GetUID: string; +procedure TFSXLEDFunction.InitializeWorker(AWorker: TCustomLEDMultiStateFunctionWorker); +var + worker: TFSXLEDFunctionWorker; + begin - Result := FUID; + worker := (AWorker as TFSXLEDFunctionWorker); + worker.Provider := Provider; + + Provider.SetupWorker(worker, Setup); end; -{ TCustomFSXFunctionWorker } -constructor TCustomFSXFunctionWorker.Create(const AProviderUID, AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string); +{ TFSXLEDFunctionWorker } +constructor TFSXLEDFunctionWorker.Create(const AProviderUID, AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string); begin { We can't pass ourselves as the Data Handler, as it would keep a reference to this worker from the SimConnect interface. That'd mean the worker never gets destroyed, and SimConnect never shuts down. Hence this proxy class. } FDataHandler := TCustomFSXFunctionWorkerDataHandler.Create(Self); + FDefinitionID := TList.Create; inherited Create(AProviderUID, AFunctionUID, AStates, ASettings, APreviousState); end; -destructor TCustomFSXFunctionWorker.Destroy; +destructor TFSXLEDFunctionWorker.Destroy; +var + simConnect: IFSXSimConnect; + id: Cardinal; + begin - if DefinitionID <> 0 then - SimConnect.RemoveDefinition(DefinitionID, DataHandler); + if Assigned(Provider) and (DefinitionID.Count > 0) then + begin + simConnect := (Provider as TFSXLEDFunctionProvider).GetSimConnect; + + for id in DefinitionID do + simConnect.RemoveDefinition(id, DataHandler); + end; + + FreeAndNil(FDefinitionID); inherited Destroy; end; -procedure TCustomFSXFunctionWorker.SetSimConnect(const Value: IFSXSimConnect); -var - definition: IFSXSimConnectDefinition; - +procedure TFSXLEDFunctionWorker.AddDefinition(ADefinition: IFSXSimConnectDefinition); begin - FSimConnect := Value; - - if Assigned(SimConnect) then - begin - definition := SimConnect.CreateDefinition; - RegisterVariables(definition); - - FDefinitionID := SimConnect.AddDefinition(definition, DataHandler); - end; + DefinitionID.Add((Provider as TFSXLEDFunctionProvider).GetSimConnect.AddDefinition(ADefinition, DataHandler)); end; { TCustomFSXFunctionWorkerDataHandler } -constructor TCustomFSXFunctionWorkerDataHandler.Create(AWorker: TCustomFSXFunctionWorker); +constructor TCustomFSXFunctionWorkerDataHandler.Create(AWorker: TFSXLEDFunctionWorker); begin inherited Create; @@ -333,7 +409,65 @@ begin end; -initialization - TLEDFunctionRegistry.Register(TFSXLEDFunctionProvider.Create); +{ TLuaSimConnect } +constructor TLuaSimConnect.Create(AProvider: TFSXLEDFunctionProvider); +begin + inherited Create; + + FProvider := AProvider; +end; + + +procedure TLuaSimConnect.Monitor(Context: ILuaContext); +var + workerID: string; + variables: ILuaTable; + onData: ILuaFunction; + worker: TCustomLuaLEDFunctionWorker; + definition: IFSXSimConnectDefinition; + variable: TLuaKeyValuePair; + info: ILuaTable; + units: string; + dataType: SIMCONNECT_DATAType; + +begin + if Context.Parameters.Count < 3 then + raise ELuaScriptError.Create('Not enough parameters for SimConnect.Monitor'); + + if Context.Parameters[0].VariableType <> VariableString then + raise ELuaScriptError.Create('Context expected for SimConnect.Monitor parameter 1'); + + if Context.Parameters[1].VariableType <> VariableTable then + raise ELuaScriptError.Create('Table expected for SimConnect.Monitor parameter 2'); + + if Context.Parameters[2].VariableType <> VariableFunction then + raise ELuaScriptError.Create('Function expected for SimConnect.Monitor parameter 3'); + + workerID := Context.Parameters[0].AsString; + variables := Context.Parameters[1].AsTable; + onData := Context.Parameters[2].AsFunction; + + worker := Provider.FindWorker(workerID); + if not Assigned(worker) then + raise ELuaScriptError.Create('Context expected for SimConnect.Monitor parameter 1'); + + definition := Provider.GetSimConnect.CreateDefinition; + + for variable in variables do + begin + if variable.Value.VariableType = VariableTable then + begin + info := variable.Value.AsTable; + if info.HasValue('variable') and + info.HasValue('type') and + GetUnits(info.GetValue('type').AsString, units, dataType) then + begin + definition.AddVariable(info.GetValue('variable').AsString, units, dataType); + end; + end; + end; + + (worker as TFSXLEDFunctionWorker).AddDefinition(definition); +end; end. diff --git a/G940LEDControl/Units/FSXLEDFunctionWorker.pas b/G940LEDControl/Units/FSXLEDFunctionWorker.pas index f8f9303..3dfaa37 100644 --- a/G940LEDControl/Units/FSXLEDFunctionWorker.pas +++ b/G940LEDControl/Units/FSXLEDFunctionWorker.pas @@ -1,6 +1,7 @@ unit FSXLEDFunctionWorker; interface +(* uses OtlTaskControl, @@ -268,9 +269,10 @@ type constructor Create(const AProviderUID: string; const AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''); override; destructor Destroy; override; end; - +*) implementation +(* uses System.Math, System.StrUtils, @@ -1181,6 +1183,6 @@ begin FVisible := visible; FOnStateChanged(visible); end; -end; +end;*) end. diff --git a/G940LEDControl/Units/LuaLEDFunctionProvider.pas b/G940LEDControl/Units/LuaLEDFunctionProvider.pas new file mode 100644 index 0000000..0dda51c --- /dev/null +++ b/G940LEDControl/Units/LuaLEDFunctionProvider.pas @@ -0,0 +1,332 @@ +unit LuaLEDFunctionProvider; + +interface +uses + System.Generics.Collections, + System.SysUtils, + System.Types, + + LEDFunction, + LEDFunctionIntf, + LEDStateIntf, + Lua; + +type + ELuaScriptError = class(Exception); + + TCustomLuaLEDFunctionWorker = class; + + + TCustomLuaLEDFunction = class(TCustomMultiStateLEDFunction) + private + FCategoryName: string; + FDisplayName: string; + FUID: string; + FScriptStates: ILuaTable; + FSetup: ILuaFunction; + protected + procedure RegisterStates; override; + + function GetDefaultCategoryName: string; virtual; + + { ILEDFunction } + function GetCategoryName: string; override; + function GetDisplayName: string; override; + function GetUID: string; override; + + property ScriptStates: ILuaTable read FScriptStates; + property Setup: ILuaFunction read FSetup; + public + constructor Create(AProvider: ILEDFunctionProvider; AInfo: ILuaTable; ASetup: ILuaFunction); + end; + + + TCustomLuaLEDFunctionProvider = class(TCustomLEDFunctionProvider) + private + FInterpreter: TLua; + FScriptFolders: TStringDynArray; + FWorkers: TDictionary; + protected + function CreateLuaLEDFunction(AInfo: ILuaTable; ASetup: ILuaFunction): TCustomLuaLEDFunction; virtual; abstract; + + procedure InitInterpreter; virtual; + procedure RegisterFunctions; override; + + procedure RegisterWorker(AWorker: TCustomLuaLEDFunctionWorker); + procedure UnregisterWorker(AWorker: TCustomLuaLEDFunctionWorker); + function FindWorker(const AUID: string): TCustomLuaLEDFunctionWorker; + + property Interpreter: TLua read FInterpreter; + property ScriptFolders: TStringDynArray read FScriptFolders; + property Workers: TDictionary read FWorkers; + public + constructor Create(const AScriptFolders: TStringDynArray); + destructor Destroy; override; + end; + + + TCustomLuaLEDFunctionWorker = class(TCustomLEDMultiStateFunctionWorker) + private + FProvider: TCustomLuaLEDFunctionProvider; + FUID: string; + + procedure SetProvider(const Value: TCustomLuaLEDFunctionProvider); + protected + property Provider: TCustomLuaLEDFunctionProvider read FProvider write SetProvider; + public + constructor Create(const AProviderUID, AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string = ''); override; + destructor Destroy; override; + + property UID: string read FUID; + end; + + +implementation +uses + System.IOUtils, + + LEDColorIntf, + LEDState; + + +const + LuaLEDColors: array[TLEDColor] of string = + ( + 'Off', 'Green', 'Amber', 'Red', + 'FlashingGreenFast', 'FlashingGreenNormal', + 'FlashingAmberFast', 'FlashingAmberNormal', + 'FlashingRedFast', 'FlashingRedNormal' + ); + +function GetLEDColor(const AValue: string; ADefault: TLEDColor = lcOff): TLEDColor; +var + color: TLEDColor; + +begin + for color := Low(TLEDColor) to High(TLEDColor) do + if SameText(AValue, LuaLEDColors[color]) then + exit(color); + + Result := ADefault; +end; + + + +{ TCustomLuaLEDFunctionProvider } +constructor TCustomLuaLEDFunctionProvider.Create(const AScriptFolders: TStringDynArray); +begin + FWorkers := TDictionary.Create; + FInterpreter := TLua.Create; + FScriptFolders := AScriptFolders; + + InitInterpreter; + + inherited Create; +end; + + +destructor TCustomLuaLEDFunctionProvider.Destroy; +begin + FreeAndNil(FInterpreter); + FreeAndNil(FWorkers); + + inherited Destroy; +end; + + +procedure TCustomLuaLEDFunctionProvider.InitInterpreter; +var + table: ILuaTable; + color: TLEDColor; + +begin + Interpreter.RegisterFunction('RegisterFunction', + procedure(Context: ILuaContext) + var + info: ILuaTable; + setup: ILuaFunction; + + begin + if Context.Parameters.Count < 2 then + raise ELuaScriptError.Create('Not enough parameters for RegisterFunction'); + + if Context.Parameters[0].VariableType <> VariableTable then + raise ELuaScriptError.Create('Table expected for RegisterFunction parameter 1'); + + if Context.Parameters[1].VariableType <> VariableFunction then + raise ELuaScriptError.Create('Function expected for RegisterFunction parameter 2'); + + info := Context.Parameters[0].AsTable; + setup := Context.Parameters[1].AsFunction; + + if not info.HasValue('uid') then + raise ELuaScriptError.Create('"uid" value is required for RegisterFunction parameter 1'); + + RegisterFunction(CreateLuaLEDFunction(info, setup)); + end); + + table := TLuaTable.Create; + for color := Low(TLEDColor) to High(TLEDColor) do + table.SetValue(LuaLEDColors[color], LuaLEDColors[color]); + + Interpreter.SetGlobalVariable('LEDColor', table); + + // #ToDo1 -oMvR: 28-5-2017: SetState +end; + + +procedure TCustomLuaLEDFunctionProvider.RegisterFunctions; +var + scriptFolder: string; + scriptFile: string; + +begin + for scriptFolder in ScriptFolders do + if TDirectory.Exists(scriptFolder) then + for scriptFile in TDirectory.GetFiles(ScriptFolder, '*.lua') do + try + Interpreter.LoadFromFile(scriptFile); + except + on E:Exception do + Exception.RaiseOuterException(ELuaScriptError.CreateFmt('Error while loading script %s: %s', [scriptFile, E.Message])); + end; +end; + + +procedure TCustomLuaLEDFunctionProvider.RegisterWorker(AWorker: TCustomLuaLEDFunctionWorker); +begin + Workers.Add(AWorker.UID, AWorker); +end; + + +procedure TCustomLuaLEDFunctionProvider.UnregisterWorker(AWorker: TCustomLuaLEDFunctionWorker); +begin + Workers.Remove(AWorker.UID); +end; + + +function TCustomLuaLEDFunctionProvider.FindWorker(const AUID: string): TCustomLuaLEDFunctionWorker; +begin + if not Workers.TryGetValue(AUID, Result) then + Result := nil; +end; + + + +{ TCustomLuaLEDFunction } +constructor TCustomLuaLEDFunction.Create(AProvider: ILEDFunctionProvider; AInfo: ILuaTable; ASetup: ILuaFunction); +begin + FCategoryName := GetDefaultCategoryName; + FDisplayName := 'Unknown function'; + FSetup := ASetup; + + FUID := AInfo.GetValue('uid').AsString; + + if AInfo.HasValue('category') then + FCategoryName := AInfo.GetValue('category').AsString; + + if AInfo.HasValue('displayName') then + FDisplayName := AInfo.GetValue('displayName').AsString; + + FScriptStates := nil; + if AInfo.HasValue('states') then + FScriptStates := AInfo.GetValue('states').AsTable; + + // #ToDo1 -oMvR: 28-5-2017: application filter? + + inherited Create(AProvider.GetUID); +end; + + +function TCustomLuaLEDFunction.GetCategoryName: string; +begin + Result := FCategoryName; +end; + + +function TCustomLuaLEDFunction.GetDisplayName: string; +begin + Result := FDisplayName; +end; + + +function TCustomLuaLEDFunction.GetUID: string; +begin + Result := FUID; +end; + + +procedure TCustomLuaLEDFunction.RegisterStates; +var + state: TLuaKeyValuePair; + displayName: string; + defaultColor: TLEDColor; + info: ILuaTable; + +begin + if not Assigned(ScriptStates) then + exit; + + for state in ScriptStates do + begin + displayName := state.Key.AsString; + defaultColor := lcOff; + + if state.Value.VariableType = VariableTable then + begin + info := state.Value.AsTable; + if info.HasValue('displayName') then + displayName := info.GetValue('displayName').AsString; + + if info.HasValue('default') then + defaultColor := GetLEDColor(info.GetValue('default').AsString); + end; + + RegisterState(TLEDState.Create(state.Key.AsString, displayName, defaultColor)); + end; +end; + + +function TCustomLuaLEDFunction.GetDefaultCategoryName: string; +begin + Result := 'Other'; +end; + + +{ TCustomLuaLEDFunctionWorker } +constructor TCustomLuaLEDFunctionWorker.Create(const AProviderUID, AFunctionUID: string; AStates: ILEDMultiStateFunction; ASettings: ILEDFunctionWorkerSettings; const APreviousState: string); +var + workerGUID: TGUID; + +begin + if CreateGUID(workerGUID) <> 0 then + RaiseLastOSError; + + FUID := GUIDToString(workerGUID); + + inherited Create(AProviderUID, AFunctionUID, AStates, ASettings, APreviousState); +end; + +destructor TCustomLuaLEDFunctionWorker.Destroy; +begin + SetProvider(nil); + + inherited Destroy; +end; + + +procedure TCustomLuaLEDFunctionWorker.SetProvider(const Value: TCustomLuaLEDFunctionProvider); +begin + if Value <> FProvider then + begin + if Assigned(FProvider) then + FProvider.UnregisterWorker(Self); + + FProvider := Value; + + if Assigned(FProvider) then + FProvider.RegisterWorker(Self); + end; +end; + +end. diff --git a/G940LEDControl/Units/StaticLEDFunction.pas b/G940LEDControl/Units/StaticLEDFunction.pas index c3cb7df..076b4e2 100644 --- a/G940LEDControl/Units/StaticLEDFunction.pas +++ b/G940LEDControl/Units/StaticLEDFunction.pas @@ -114,8 +114,4 @@ begin Result := FState; end; - -initialization - TLEDFunctionRegistry.Register(TStaticLEDFunctionProvider.Create); - end. diff --git a/G940LEDControl/XSD/SimBaseDocument.settings.xml b/G940LEDControl/XSD/SimBaseDocument.settings.xml index 10e213f..20c2026 100644 --- a/G940LEDControl/XSD/SimBaseDocument.settings.xml +++ b/G940LEDControl/XSD/SimBaseDocument.settings.xml @@ -1,2 +1,2 @@ -SingleF:\Development\G940\G940LEDControl\Units\SimBaseDocumentXMLBinding.pas +Single..\Units\SimBaseDocumentXMLBinding.pas diff --git a/G940LEDControl/XSD/SimBaseDocument.xsd b/G940LEDControl/XSD/SimBaseDocument.xsd index f7996de..66360dd 100644 --- a/G940LEDControl/XSD/SimBaseDocument.xsd +++ b/G940LEDControl/XSD/SimBaseDocument.xsd @@ -1,6 +1,4 @@ - -