LuaUtils.pas 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748
  1. //******************************************************************************
  2. //*** LUA SCRIPT DELPHI UTILITIES ***
  3. //*** ***
  4. //*** (c) 2006 Jean-Fran輟is Goulet, Massimo Magnano, Kuma ***
  5. //*** ***
  6. //*** ***
  7. //******************************************************************************
  8. // File : LuaUtils.pas
  9. //
  10. // Description : Useful functions to work with Lua in Delphi.
  11. //
  12. //******************************************************************************
  13. //** See Copyright Notice in lua.h
  14. //Revision 1.2
  15. // MaxM Adds :
  16. // GetCurrentFuncName, LuaSetTablePropertyFuncs
  17. //
  18. //Revision 1.1
  19. // MaxM Adds :
  20. // LuaPCallFunction
  21. //
  22. //Revision 1.0
  23. // MaxM Adds :
  24. // LuaPushVariant
  25. // LuaToVariant
  26. // LuaGetTableInteger, LuaGet\SetTableTMethod
  27. // LuaLoadBufferFromFile
  28. // Solved Bugs : Stack problem in LuaProcessTableName
  29. // LuaToInteger why Round?, Trunc is better
  30. unit LuaUtils;
  31. interface
  32. uses
  33. SysUtils, Classes, ComCtrls, lua, lualib, lauxlib, Variants, VirtualTrees, Contnrs;
  34. const
  35. ERR_Script ='Script Error : ';
  36. type
  37. TOnLuaStdout = procedure (S: PChar; N: Integer);
  38. TOnLuaStdoutEx = procedure (F, S: PChar; L, N: Integer);
  39. ELuaException = class(Exception)
  40. Title: string;
  41. Line: Integer;
  42. Msg: string;
  43. constructor Create(Title: string; Line: Integer; Msg: string);
  44. end;
  45. TLuaVariable = class(TObject)
  46. FName: String;
  47. FValue: String;
  48. public
  49. constructor Create(VarName, VarValue: String);
  50. property Name: String read FName write FName;
  51. property Value: String read FValue write FValue;
  52. end;
  53. TLuaTable = class(TLuaVariable)
  54. FIntKeyValue: array of TLuaVariable;
  55. FStrKeyValue: TList;
  56. public
  57. constructor Create(TableName, TableValue: String);
  58. destructor Destroy();
  59. procedure InsertAt(Index: Cardinal; Member: TLuaVariable); overload;
  60. procedure InsertAt(Index: String; Member: TLuaVariable); overload;
  61. function GetAt(Index: Cardinal): TLuaVariable; overload;
  62. function GetAt(Index: String): TLuaVariable; overload;
  63. procedure Clear();
  64. end;
  65. PBasicTreeData = ^TBasicTreeData;
  66. TBasicTreeData = record
  67. sName: String;
  68. sValue: String;
  69. end;
  70. TVariantArray =array of Variant;
  71. PVariantArray =^TVariantArray;
  72. function Quote(const Str: string): string;
  73. function Dequote(const QuotedStr: string): string;
  74. function lua_print(L: Plua_State): Integer; cdecl;
  75. function lua_printex(L: Plua_State): Integer; cdecl;
  76. function lua_io_write(L: Plua_State): Integer; cdecl;
  77. function lua_io_writeex(L: Plua_State): Integer; cdecl;
  78. function LuaToBoolean(L: PLua_State; Index: Integer): Boolean;
  79. procedure LuaPushBoolean(L: PLua_State; B: Boolean);
  80. function LuaToInteger(L: PLua_State; Index: Integer): Integer;
  81. procedure LuaPushInteger(L: PLua_State; N: Integer);
  82. function LuaToVariant(L: Plua_State; Index: Integer): Variant;
  83. procedure LuaPushVariant(L: Plua_State; N: Variant);
  84. function LuaToString(L: PLua_State; Index: Integer): string;
  85. procedure LuaPushString(L: PLua_State; const S: string);
  86. function LuaIncIndex(L: Plua_State; Index: Integer): Integer;
  87. function LuaAbsIndex(L: Plua_State; Index: Integer): Integer;
  88. procedure LuaGetTable(L: Plua_State; TableIndex: Integer; const Key: string);
  89. function LuaGetTableBoolean(L: Plua_State; TableIndex: Integer; const Key: string): Boolean;
  90. function LuaGetTableNumber(L: Plua_State; TableIndex: Integer; const Key: string): Double;
  91. function LuaGetTableInteger(L: Plua_State; TableIndex: Integer; const Key: string): Integer;
  92. function LuaGetTableString(L: Plua_State; TableIndex: Integer; const Key: string): string;
  93. function LuaGetTableFunction(L: Plua_State; TableIndex: Integer; const Key: string): lua_CFunction;
  94. function LuaGetTableLightUserData(L: Plua_State; TableIndex: Integer; const Key: string): Pointer;
  95. function LuaGetTableTMethod(L: Plua_State; TableIndex: Integer; const Key: string): TMethod;
  96. procedure LuaRawGetTable(L: Plua_State; TableIndex: Integer; const Key: string);
  97. function LuaRawGetTableBoolean(L: Plua_State; TableIndex: Integer; const Key: string): Boolean;
  98. function LuaRawGetTableNumber(L: Plua_State; TableIndex: Integer; const Key: string): Double;
  99. function LuaRawGetTableString(L: Plua_State; TableIndex: Integer; const Key: string): string;
  100. function LuaRawGetTableFunction(L: Plua_State; TableIndex: Integer; const Key: string): lua_CFunction;
  101. function LuaRawGetTableLightUserData(L: Plua_State; TableIndex: Integer; const Key: string): Pointer;
  102. procedure LuaSetTableValue(L: PLua_State; TableIndex: Integer; const Key: string; ValueIndex: Integer);
  103. procedure LuaSetTableNil(L: Plua_State; TableIndex: Integer; const Key: string);
  104. procedure LuaSetTableBoolean(L: Plua_State; TableIndex: Integer; const Key: string; B: Boolean);
  105. procedure LuaSetTableNumber(L: Plua_State; TableIndex: Integer; const Key: string; N: Double);
  106. procedure LuaSetTableString(L: Plua_State; TableIndex: Integer; const Key: string; S: string);
  107. procedure LuaSetTableFunction(L: Plua_State; TableIndex: Integer; const Key: string; F: lua_CFunction);
  108. procedure LuaSetTableLightUserData(L: Plua_State; TableIndex: Integer; const Key: string; P: Pointer);
  109. procedure LuaSetTableTMethod(L: Plua_State; TableIndex: Integer; const Key: string; M: TMethod);
  110. procedure LuaSetTableClear(L: Plua_State; TableIndex: Integer);
  111. procedure LuaSetTablePropertyFuncs(L: PLua_State; TableIndex: Integer;
  112. ReadFunc: lua_CFunction;
  113. WriteFunc: lua_CFunction =nil);
  114. procedure LuaRawSetTableValue(L: PLua_State; TableIndex: Integer; const Key: string; ValueIndex: Integer);
  115. procedure LuaRawSetTableNil(L: Plua_State; TableIndex: Integer; const Key: string);
  116. procedure LuaRawSetTableBoolean(L: Plua_State; TableIndex: Integer; const Key: string; B: Boolean);
  117. procedure LuaRawSetTableNumber(L: Plua_State; TableIndex: Integer; const Key: string; N: Double);
  118. procedure LuaRawSetTableString(L: Plua_State; TableIndex: Integer; const Key: string; S: string);
  119. procedure LuaRawSetTableFunction(L: Plua_State; TableIndex: Integer; const Key: string; F: lua_CFunction);
  120. procedure LuaRawSetTableLightUserData(L: Plua_State; TableIndex: Integer; const Key: string; P: Pointer);
  121. procedure LuaRawSetTableClear(L: Plua_State; TableIndex: Integer);
  122. function LuaGetMetaFunction(L: Plua_State; Index: Integer; Key: string): lua_CFunction;
  123. procedure LuaSetMetaFunction(L: Plua_State; Index: Integer; Key: string; F: lua_CFunction);
  124. procedure LuaShowStack(L: Plua_State; Caption: string = '');
  125. function LuaStackToStr(L: Plua_State; Index: Integer; MaxTable: Integer = -1; SubTableMax: Integer = 99; CheckCyclicReferencing: Boolean = True; TablePtrs: TList = nil): String;
  126. procedure LuaRegisterInPackage(L: PLua_State; const Package: PChar; const lr: PLuaL_Reg);
  127. procedure LuaRegisterCustom(L: PLua_State; TableIndex: Integer; const Name: PChar; F: lua_CFunction);
  128. procedure LuaRegister(L: Plua_State; const Name: PChar; F: lua_CFunction);
  129. procedure LuaRegisterMetatable(L: Plua_State; const Name: PChar; F: lua_CFunction);
  130. procedure LuaRegisterProperty(L: PLua_State; const Name: PChar; ReadFunc, WriteFunc: lua_CFunction);
  131. procedure LuaStackToStrings(L: Plua_State; Lines: TStrings; MaxTable: Integer = -1; SubTableMax: Integer = 99; CheckCyclicReferencing: Boolean = True);
  132. procedure LuaLocalToStrings(L: Plua_State; Lines: TStrings; MaxTable: Integer = -1; Level: Integer = 0; SubTableMax: Integer = 99; CheckCyclicReferencing: Boolean = True);
  133. procedure LuaLocalToVariables(L: Plua_State; Locals: TList; MaxTable: Integer; Level: Integer = 0; SubTableMax: Integer = 99; CheckCyclicReferencing: Boolean = True);
  134. procedure LuaGlobalToStrings(L: PLua_State; Lines: TStrings; MaxTable: Integer = -1; SubTableMax: Integer = 99; CheckCyclicReferencing: Boolean = True);
  135. procedure LuaGlobalToVariables(L: PLua_State; Globals: TLuaTable; MaxTable: Integer = -1; SubTableMax: Integer = 99; CheckCyclicReferencing: Boolean = True);
  136. procedure LuaTableToStrings(L: Plua_State; Index: Integer; Lines: TStrings; MaxTable: Integer = -1; SubTableMax: Integer = 99; CheckCyclicReferencing: Boolean = True);
  137. procedure LuaTableToVariables(L: Plua_State; Index: Integer; Table: TLuaTable; MaxTable: Integer = -1; SubTableMax: Integer = 99; CheckCyclicReferencing: Boolean = True);
  138. procedure LuaTableToVirtualTreeView(L: Plua_State; Index: Integer; VTV: TVirtualStringTree; MaxTable: Integer; SubTableMax: Integer; CheckCyclicReferencing: Boolean);
  139. function LuaGetIdentValue(L: Plua_State; Ident: string; MaxTable: Integer = -1): string;
  140. procedure LuaSetIdentValue(L: Plua_State; Ident, Value: string; MaxTable: Integer = -1);
  141. procedure LuaLoadBuffer(L: Plua_State; const Code: string; const Name: string);
  142. procedure LuaLoadBufferFromFile(L: Plua_State; const Filename: string; const Name: string);
  143. procedure LuaPCall(L: Plua_State; NArgs, NResults, ErrFunc: Integer);
  144. function LuaPCallFunction(L: Plua_State; FunctionName :String;
  145. const Args: array of Variant;
  146. Results : PVariantArray;
  147. ErrFunc: Integer=0;
  148. NResults :Integer=LUA_MULTRET):Integer;
  149. procedure LuaError(L: Plua_State; const Msg: string);
  150. procedure LuaErrorFmt(L: Plua_State; const Fmt: string; const Args: array of Const);
  151. function LuaDataStrToStrings(const TableStr: string; Strings: TStrings): string;
  152. function LuaDoFile(L: Plua_State): Integer; cdecl;
  153. function LuaGetCurrentFuncName(L: Plua_State) :String;
  154. function Lua_VoidFunc(L: Plua_State): Integer; cdecl;
  155. const
  156. LuaGlobalVariableStr = '[LUA_GLOBALSINDEX]';
  157. var
  158. OnLuaStdoutEx: TOnLuaStdoutEx;
  159. OnLuaStdout: TOnLuaStdout;
  160. DefaultMaxTable: Integer;
  161. SubTableCount: Integer;
  162. implementation
  163. uses Dialogs;
  164. const
  165. QuoteStr = '"';
  166. CR = #$0D;
  167. LF = #$0A;
  168. CRLF = CR + LF;
  169. ///////////////////////////////////////////////////////////////////
  170. // TLuaVariable
  171. ///////////////////////////////////////////////////////////////////
  172. constructor TLuaVariable.Create(VarName, VarValue: String);
  173. begin
  174. FName := VarName;
  175. FValue := VarValue;
  176. end;
  177. ///////////////////////////////////////////////////////////////////
  178. // TLuaTable
  179. ///////////////////////////////////////////////////////////////////
  180. constructor TLuaTable.Create(TableName, TableValue: String);
  181. begin
  182. inherited Create(TableName, TableValue);
  183. FStrKeyValue := TList.Create;
  184. end;
  185. destructor TLuaTable.Destroy();
  186. begin
  187. Clear();
  188. FStrKeyValue.Free;
  189. end;
  190. procedure TLuaTable.InsertAt(Index: Cardinal; Member: TLuaVariable);
  191. begin
  192. SetLength(FIntKeyValue, SizeOf(FIntKeyValue) + 1);
  193. FIntKeyValue[Index] := Member;
  194. end;
  195. procedure TLuaTable.InsertAt(Index: String; Member: TLuaVariable);
  196. var
  197. CheckExistance: TLuaVariable;
  198. begin
  199. CheckExistance := GetAt(Index);
  200. if Assigned(CheckExistance) then
  201. FStrKeyValue.Remove(CheckExistance);
  202. FStrKeyValue.Add(Member);
  203. end;
  204. function TLuaTable.GetAt(Index: Cardinal): TLuaVariable;
  205. begin
  206. Result := nil;
  207. if Index < SizeOf(FIntKeyValue) then
  208. Result := FIntKeyValue[Index];
  209. end;
  210. function TLuaTable.GetAt(Index: String): TLuaVariable;
  211. var
  212. x: Integer;
  213. begin
  214. Result := nil;
  215. x := 0;
  216. while ((not Assigned(Result)) and (x < FStrKeyValue.Count)) do
  217. begin
  218. if TLuaVariable(FStrKeyValue.Items[x]).Name = Index then
  219. Result := TLuaVariable(FStrKeyValue.Items[x]);
  220. Inc(x);
  221. end;
  222. end;
  223. procedure TLuaTable.Clear();
  224. var
  225. x: Integer;
  226. begin
  227. for x := 0 to SizeOf(FIntKeyValue) do
  228. TLuaVariable(FIntKeyValue).Free;
  229. SetLength(FIntKeyValue, 0);
  230. FStrKeyValue.Clear();
  231. end;
  232. ///////////////////////////////////////////////////////////////////
  233. // Utilities
  234. ///////////////////////////////////////////////////////////////////
  235. function Quote(const Str: String): String;
  236. begin
  237. Result := AnsiQuotedStr(Str, QuoteStr);
  238. end;
  239. function Dequote(const QuotedStr: string): string;
  240. begin
  241. Result := AnsiDequotedStr(QuotedStr, QuoteStr);
  242. end;
  243. function fwriteex(F, S: PChar; Un, Len: Integer; L, Dummy: Integer): Integer;
  244. var
  245. Size: Integer;
  246. begin
  247. Size := Un * Len;
  248. if (Assigned(OnLuaStdoutEx)) then
  249. OnLuaStdoutEx(F, S, L, Size);
  250. Result := Size;
  251. end;
  252. function fwrite(S: PChar; Un, Len: Integer; Dummy: Integer): Integer;
  253. var
  254. Size: Integer;
  255. begin
  256. Size := Un * Len;
  257. if (Assigned(OnLuaStdout)) then
  258. OnLuaStdout(S, Size);
  259. Result := Size;
  260. end;
  261. function fputsex(const F, S: String; L, Dummy: Integer): Integer;
  262. begin
  263. Result := fwriteex(PChar(F), PChar(S), SizeOf(Char), L, Length(S), Dummy);
  264. end;
  265. function fputs(const S: string; Dummy: Integer): Integer;
  266. begin
  267. Result := fwrite(PChar(S), SizeOf(Char), Length(S), Dummy);
  268. end;
  269. function lua_printex(L: Plua_State): Integer; cdecl;
  270. const
  271. TAB = #$08;
  272. NL = #$0A;
  273. stdout = 0;
  274. var
  275. N, I: Integer;
  276. S: PChar;
  277. Debug: lua_Debug;
  278. AR: Plua_Debug;
  279. begin
  280. AR := @Debug;
  281. lua_getstack(L, 1, AR); {* stack informations *}
  282. lua_getinfo(L, 'Snlu', AR); {* debug informations *}
  283. N := lua_gettop(L); (* number of arguments *)
  284. lua_getglobal(L, 'tostring');
  285. for I := 1 to N do
  286. begin
  287. lua_pushvalue(L, -1); (* function to be called *)
  288. lua_pushvalue(L, i); (* value to print *)
  289. lua_call(L, 1, 1);
  290. S := lua_tostring(L, -1); (* get result *)
  291. if (S = nil) then
  292. begin
  293. Result := luaL_error(L, '`tostring'' must return a string to `print''');
  294. Exit;
  295. end;
  296. if (I > 1) then fputs(TAB, stdout);
  297. fputsex(AR.source, S, AR.currentline, stdout);
  298. lua_pop(L, 1); (* pop result *)
  299. end;
  300. fputsex(AR.source, NL, AR.currentline, stdout);
  301. Result := 0;
  302. end;
  303. function lua_print(L: Plua_State): Integer; cdecl;
  304. const
  305. TAB = #$08;
  306. NL = #$0A;
  307. stdout = 0;
  308. var
  309. N, I: Integer;
  310. S: PChar;
  311. begin
  312. N := lua_gettop(L); (* number of arguments *)
  313. lua_getglobal(L, 'tostring');
  314. for I := 1 to N do
  315. begin
  316. lua_pushvalue(L, -1); (* function to be called *)
  317. lua_pushvalue(L, i); (* value to print *)
  318. lua_call(L, 1, 1);
  319. S := lua_tostring(L, -1); (* get result *)
  320. if (S = nil) then
  321. begin
  322. Result := luaL_error(L, '`tostring'' must return a string to `print''');
  323. Exit;
  324. end;
  325. if (I > 1) then fputs(TAB, stdout);
  326. fputs(S, stdout);
  327. lua_pop(L, 1); (* pop result *)
  328. end;
  329. fputs(NL, stdout);
  330. Result := 0;
  331. end;
  332. function lua_io_writeex(L: Plua_State): Integer; cdecl;
  333. function pushresult(L: Plua_State; I: Boolean; FileName: PChar): Integer;
  334. begin
  335. lua_pushboolean(L, 1);
  336. Result := 1;
  337. end;
  338. const
  339. F = 0;
  340. var
  341. NArgs: Integer;
  342. Status: Boolean;
  343. Arg: Integer;
  344. Len: Integer;
  345. S: PChar;
  346. Debug: lua_Debug;
  347. AR: Plua_Debug;
  348. begin
  349. AR := @Debug;
  350. lua_getstack(L, 1, AR); {* stack informations *}
  351. lua_getinfo(L, 'Snlu', AR); {* debug informations *}
  352. Arg := 1;
  353. NArgs := lua_gettop(L);
  354. Status := True;
  355. while (NArgs > 0) do
  356. begin
  357. Dec(NArgs);
  358. if (lua_type(L, Arg) = LUA_TNUMBER) then
  359. begin
  360. (* optimization: could be done exactly as for strings *)
  361. Status := Status and
  362. (fputsex(AR.source, Format(LUA_NUMBER_FMT, [lua_tonumber(L, Arg)]), AR.currentline, 0) > 0);
  363. end else
  364. begin
  365. S := luaL_checklstring(L, Arg, @Len);
  366. Status := Status and (fwriteex(AR.source, S, SizeOf(Char), Len, AR.currentline, F) = Len);
  367. end;
  368. Inc(Arg);
  369. end;
  370. Result := pushresult(L, Status, nil);
  371. end;
  372. function lua_io_write(L: Plua_State): Integer; cdecl;
  373. function pushresult(L: Plua_State; I: Boolean; FileName: PChar): Integer;
  374. begin
  375. lua_pushboolean(L, 1);
  376. Result := 1;
  377. end;
  378. const
  379. F = 0;
  380. var
  381. NArgs: Integer;
  382. Status: Boolean;
  383. Arg: Integer;
  384. Len: Integer;
  385. S: PChar;
  386. begin
  387. Arg := 1;
  388. NArgs := lua_gettop(L);
  389. Status := True;
  390. while (NArgs > 0) do
  391. begin
  392. Dec(NArgs);
  393. if (lua_type(L, Arg) = LUA_TNUMBER) then
  394. begin
  395. (* optimization: could be done exactly as for strings *)
  396. Status := Status and
  397. (fputs(Format(LUA_NUMBER_FMT, [lua_tonumber(L, Arg)]), 0) > 0);
  398. end else
  399. begin
  400. S := luaL_checklstring(L, Arg, @Len);
  401. Status := Status and (fwrite(S, SizeOf(Char), Len, F) = Len);
  402. end;
  403. Inc(Arg);
  404. end;
  405. Result := pushresult(L, Status, nil);
  406. end;
  407. function LuaToBoolean(L: PLua_State; Index: Integer): Boolean;
  408. begin
  409. Result := (lua_toboolean(L, Index) <> 0);
  410. end;
  411. procedure LuaPushBoolean(L: PLua_State; B: Boolean);
  412. begin
  413. lua_pushboolean(L, Integer(B));
  414. end;
  415. function LuaToInteger(L: PLua_State; Index: Integer): Integer;
  416. begin
  417. Result := Trunc(lua_tonumber(L, Index)); //Round(lua_tonumber(L, Index));
  418. end;
  419. procedure LuaPushInteger(L: PLua_State; N: Integer);
  420. begin
  421. lua_pushnumber(L, N);
  422. end;
  423. function LuaToVariant(L: Plua_State; Index: Integer): Variant;
  424. Var
  425. dataType :Integer;
  426. dataNum :Double;
  427. begin
  428. dataType :=lua_type(L, Index);
  429. Case dataType of
  430. LUA_TSTRING : Result := VarAsType(LuaToString(L, Index), varString);
  431. LUA_TUSERDATA,
  432. LUA_TLIGHTUSERDATA : Result := VarAsType(Integer(lua_touserdata(L, Index)), varInteger);
  433. LUA_TNONE,
  434. LUA_TNIL : Result := varNull;
  435. LUA_TBOOLEAN : Result := VarAsType(LuaToBoolean(L, Index), varBoolean);
  436. LUA_TNUMBER : begin
  437. dataNum :=lua_tonumber(L, Index);
  438. if (Abs(dataNum)>MAXINT)
  439. then Result :=VarAsType(dataNum, varDouble)
  440. else begin
  441. if (Frac(dataNum)<>0)
  442. then Result :=VarAsType(dataNum, varDouble)
  443. else Result :=VarAsType(dataNum, varInteger)
  444. end;
  445. end;
  446. end;
  447. end;
  448. procedure LuaPushVariant(L: Plua_State; N: Variant);
  449. begin
  450. case VarType(N) of
  451. varEmpty,
  452. varNull :lua_pushnil(L);
  453. varBoolean :LuaPushBoolean(L, N);
  454. varStrArg,
  455. varOleStr,
  456. varString :LuaPushString(L, N);
  457. varDate :LuaPushString(L, DateTimeToStr(VarToDateTime(N)));
  458. else lua_pushnumber(L, N);
  459. end;
  460. end;
  461. function LuaToString(L: PLua_State; Index: Integer): string;
  462. var
  463. Size: Integer;
  464. begin
  465. Size := lua_strlen(L, Index);
  466. SetLength(Result, Size);
  467. if (Size > 0) then
  468. Move(lua_tostring(L, Index)^, Result[1], Size);
  469. end;
  470. procedure LuaPushString(L: PLua_State; const S: string);
  471. begin
  472. lua_pushstring(L, PChar(S));
  473. end;
  474. function LuaIncIndex(L: Plua_State; Index: Integer): Integer;
  475. // 相対インデックス -1 ~ -N へ変換
  476. begin
  477. if ((Index = LUA_GLOBALSINDEX) or (Index = LUA_REGISTRYINDEX)) then
  478. begin
  479. Result := Index;
  480. Exit;
  481. end;
  482. Result := LuaAbsIndex(L, Index) - lua_gettop(L) - 1;
  483. end;
  484. function LuaAbsIndex(L: Plua_State; Index: Integer): Integer;
  485. // 絶対インデックス 1 ~ N へ変換
  486. begin
  487. if ((Index = LUA_GLOBALSINDEX) or (Index = LUA_REGISTRYINDEX)) then
  488. begin
  489. Result := Index;
  490. Exit;
  491. end;
  492. if (Index < 0) then
  493. Result := Index + lua_gettop(L) + 1
  494. else
  495. Result := Index;
  496. end;
  497. procedure LuaPushKeyString(L: PLua_State; var Index: Integer; const Key: string);
  498. begin
  499. Index := LuaAbsIndex(L, Index);
  500. lua_pushstring(L, PChar(Key));
  501. end;
  502. procedure LuaGetTable(L: Plua_State; TableIndex: Integer; const Key: string);
  503. begin
  504. LuaPushKeyString(L, TableIndex, Key);
  505. lua_gettable(L, TableIndex);
  506. end;
  507. function LuaGetTableBoolean(L: Plua_State; TableIndex: Integer; const Key: string): Boolean;
  508. begin
  509. LuaGetTable(L, TableIndex, Key);
  510. Result := (lua_toboolean(L, -1) <> 0);
  511. lua_pop(L, 1);
  512. end;
  513. function LuaGetTableNumber(L: Plua_State; TableIndex: Integer; const Key: string): Double;
  514. begin
  515. LuaGetTable(L, TableIndex, Key);
  516. Result := lua_tonumber(L, -1);
  517. lua_pop(L, 1);
  518. end;
  519. function LuaGetTableInteger(L: Plua_State; TableIndex: Integer; const Key: string): Integer;
  520. begin
  521. LuaGetTable(L, TableIndex, Key);
  522. Result := LuaToInteger(L, -1);
  523. lua_pop(L, 1);
  524. end;
  525. function LuaGetTableString(L: Plua_State; TableIndex: Integer; const Key: string): string;
  526. begin
  527. LuaGetTable(L, TableIndex, Key);
  528. Result := lua_tostring(L, -1);
  529. lua_pop(L, 1);
  530. end;
  531. function LuaGetTableFunction(L: Plua_State; TableIndex: Integer; const Key: string): lua_CFunction;
  532. begin
  533. LuaGetTable(L, TableIndex, Key);
  534. Result := lua_tocfunction(L, -1);
  535. lua_pop(L, 1);
  536. end;
  537. function LuaGetTableLightUserData(L: Plua_State; TableIndex: Integer; const Key: string): Pointer;
  538. begin
  539. LuaGetTable(L, TableIndex, Key);
  540. Result := lua_touserdata(L, -1);
  541. lua_pop(L, 1);
  542. end;
  543. function LuaGetTableTMethod(L: Plua_State; TableIndex: Integer; const Key: string): TMethod;
  544. begin
  545. Result.Code :=LuaGetTableLightUserData(L, TableIndex, Key+'_Code'); //Code is the Method Pointer
  546. Result.Data :=LuaGetTableLightUserData(L, TableIndex, Key+'_Data'); //Data is the object Pointer
  547. end;
  548. procedure LuaRawGetTable(L: Plua_State; TableIndex: Integer; const Key: string);
  549. begin
  550. LuaPushKeyString(L, TableIndex, Key);
  551. lua_rawget(L, TableIndex);
  552. end;
  553. function LuaRawGetTableBoolean(L: Plua_State; TableIndex: Integer; const Key: string): Boolean;
  554. begin
  555. LuaRawGetTable(L, TableIndex, Key);
  556. Result := (lua_toboolean(L, -1) <> 0);
  557. lua_pop(L, 1);
  558. end;
  559. function LuaRawGetTableNumber(L: Plua_State; TableIndex: Integer; const Key: string): Double;
  560. begin
  561. LuaRawGetTable(L, TableIndex, Key);
  562. Result := lua_tonumber(L, -1);
  563. lua_pop(L, 1);
  564. end;
  565. function LuaRawGetTableString(L: Plua_State; TableIndex: Integer; const Key: string): string;
  566. begin
  567. LuaRawGetTable(L, TableIndex, Key);
  568. Result := lua_tostring(L, -1);
  569. lua_pop(L, 1);
  570. end;
  571. function LuaRawGetTableFunction(L: Plua_State; TableIndex: Integer; const Key: string): lua_CFunction;
  572. begin
  573. LuaRawGetTable(L, TableIndex, Key);
  574. Result := lua_tocfunction(L, -1);
  575. lua_pop(L, 1);
  576. end;
  577. function LuaRawGetTableLightUserData(L: Plua_State; TableIndex: Integer; const Key: string): Pointer;
  578. begin
  579. LuaRawGetTable(L, TableIndex, Key);
  580. Result := lua_touserdata(L, -1);
  581. lua_pop(L, 1);
  582. end;
  583. procedure LuaSetTableValue(L: PLua_State; TableIndex: Integer; const Key: string; ValueIndex: Integer);
  584. begin
  585. TableIndex := LuaAbsIndex(L, TableIndex);
  586. ValueIndex := LuaAbsIndex(L, ValueIndex);
  587. lua_pushstring(L, PChar(Key));
  588. lua_pushvalue(L, ValueIndex);
  589. lua_settable(L, TableIndex);
  590. end;
  591. procedure LuaSetTableNil(L: Plua_State; TableIndex: Integer; const Key: string);
  592. begin
  593. LuaPushKeyString(L, TableIndex, Key);
  594. lua_pushnil(L);
  595. lua_settable(L, TableIndex);
  596. end;
  597. procedure LuaSetTableBoolean(L: Plua_State; TableIndex: Integer; const Key: string; B: Boolean);
  598. begin
  599. LuaPushKeyString(L, TableIndex, Key);
  600. lua_pushboolean(L, Integer(B));
  601. lua_settable(L, TableIndex);
  602. end;
  603. procedure LuaSetTableNumber(L: Plua_State; TableIndex: Integer; const Key: string; N: Double);
  604. begin
  605. LuaPushKeyString(L, TableIndex, Key);
  606. lua_pushnumber(L, N);
  607. lua_settable(L, TableIndex);
  608. end;
  609. procedure LuaSetTableString(L: Plua_State; TableIndex: Integer; const Key: string; S: string);
  610. begin
  611. LuaPushKeyString(L, TableIndex, Key);
  612. lua_pushstring(L, PChar(S));
  613. lua_settable(L, TableIndex);
  614. end;
  615. procedure LuaSetTableFunction(L: Plua_State; TableIndex: Integer; const Key: string; F: lua_CFunction);
  616. begin
  617. LuaPushKeyString(L, TableIndex, Key);
  618. lua_pushcfunction(L, F);
  619. lua_settable(L, TableIndex);
  620. end;
  621. procedure LuaSetTableLightUserData(L: Plua_State; TableIndex: Integer; const Key: string; P: Pointer);
  622. begin
  623. LuaPushKeyString(L, TableIndex, Key);
  624. lua_pushlightuserdata(L, P);
  625. lua_settable(L, TableIndex);
  626. end;
  627. procedure LuaSetTableTMethod(L: Plua_State; TableIndex: Integer; const Key: string; M: TMethod);
  628. begin
  629. LuaSetTableLightUserData(L, TableIndex, Key+'_Code', M.Code);
  630. LuaSetTableLightUserData(L, TableIndex, Key+'_Data', M.Data);
  631. end;
  632. procedure LuaSetTableClear(L: Plua_State; TableIndex: Integer);
  633. begin
  634. TableIndex := LuaAbsIndex(L, TableIndex);
  635. lua_pushnil(L);
  636. while (lua_next(L, TableIndex) <> 0) do
  637. begin
  638. lua_pushnil(L);
  639. lua_replace(L, -1 - 1);
  640. lua_settable(L, TableIndex);
  641. lua_pushnil(L);
  642. end;
  643. end;
  644. procedure LuaSetTablePropertyFuncs(L: PLua_State; TableIndex: Integer;
  645. ReadFunc: lua_CFunction;
  646. WriteFunc: lua_CFunction =nil);
  647. begin
  648. if assigned(ReadFunc)
  649. then LuaSetMetaFunction(L, TableIndex, '__index', ReadFunc);
  650. if assigned(WriteFunc)
  651. then LuaSetMetaFunction(L, TableIndex, '__newindex', WriteFunc);
  652. end;
  653. procedure LuaRawSetTableValue(L: PLua_State; TableIndex: Integer; const Key: string; ValueIndex: Integer);
  654. begin
  655. TableIndex := LuaAbsIndex(L, TableIndex);
  656. ValueIndex := LuaAbsIndex(L, ValueIndex);
  657. lua_pushstring(L, PChar(Key));
  658. lua_pushvalue(L, ValueIndex);
  659. lua_rawset(L, TableIndex);
  660. end;
  661. procedure LuaRawSetTableNil(L: Plua_State; TableIndex: Integer; const Key: string);
  662. begin
  663. LuaPushKeyString(L, TableIndex, Key);
  664. lua_pushnil(L);
  665. lua_rawset(L, TableIndex);
  666. end;
  667. procedure LuaRawSetTableBoolean(L: Plua_State; TableIndex: Integer; const Key: string; B: Boolean);
  668. begin
  669. LuaPushKeyString(L, TableIndex, Key);
  670. lua_pushboolean(L, Integer(B));
  671. lua_rawset(L, TableIndex);
  672. end;
  673. procedure LuaRawSetTableNumber(L: Plua_State; TableIndex: Integer; const Key: string; N: Double);
  674. begin
  675. LuaPushKeyString(L, TableIndex, Key);
  676. lua_pushnumber(L, N);
  677. lua_rawset(L, TableIndex);
  678. end;
  679. procedure LuaRawSetTableString(L: Plua_State; TableIndex: Integer; const Key: string; S: string);
  680. begin
  681. LuaPushKeyString(L, TableIndex, Key);
  682. lua_pushstring(L, PChar(S));
  683. lua_rawset(L, TableIndex);
  684. end;
  685. procedure LuaRawSetTableFunction(L: Plua_State; TableIndex: Integer; const Key: string; F: lua_CFunction);
  686. begin
  687. LuaPushKeyString(L, TableIndex, Key);
  688. lua_pushcfunction(L, F);
  689. lua_rawset(L, TableIndex);
  690. end;
  691. procedure LuaRawSetTableLightUserData(L: Plua_State; TableIndex: Integer; const Key: string; P: Pointer);
  692. begin
  693. LuaPushKeyString(L, TableIndex, Key);
  694. lua_pushlightuserdata(L, P);
  695. lua_rawset(L, TableIndex);
  696. end;
  697. procedure LuaRawSetTableClear(L: Plua_State; TableIndex: Integer);
  698. begin
  699. TableIndex := LuaAbsIndex(L, TableIndex);
  700. lua_pushnil(L);
  701. while (lua_next(L, TableIndex) <> 0) do
  702. begin
  703. lua_pushnil(L);
  704. lua_replace(L, -1 - 1);
  705. lua_rawset(L, TableIndex);
  706. lua_pushnil(L);
  707. end;
  708. end;
  709. function LuaGetMetaFunction(L: Plua_State; Index: Integer; Key: string): lua_CFunction;
  710. // メタ関数の取得
  711. begin
  712. Result := nil;
  713. Index := LuaAbsIndex(L, Index);
  714. if (lua_getmetatable(L, Index) = 0) then
  715. Exit;
  716. LuaGetTable(L, -1, Key);
  717. if (lua_iscfunction(L, -1) <> 0) then
  718. Result := lua_tocfunction(L, -1);
  719. lua_pop(L, 2);
  720. end;
  721. procedure LuaSetMetaFunction(L: Plua_State; Index: Integer; Key: string; F: lua_CFunction);
  722. // メタ関数の設定
  723. // Key = __add, __sub, __mul, __div, __pow, __unm, __concat,
  724. // __eq, __lt, __le, __index, __newindex, __call
  725. // [メモ]
  726. // __newindex は 新規代入時しか呼ばれないので注意
  727. // table をグローバル変数とするとこうなる。
  728. //
  729. // a=1 -- (a=nilなので)メタ関数呼び出される
  730. // a=2 -- メタ関数は呼び出されない
  731. // a=3 -- メタ関数は呼び出されない
  732. // a=nil
  733. // a=4 -- (a=nilなので)メタ関数呼び出される
  734. //
  735. // lua 付属の trace-globals では__newindex と __index をセットで上書きして
  736. // グローバル変数へのアクセスをローカル変数へのアクセスに切り替えてグロー
  737. // バル変数の実体は常に table[key] = nil を保たせて __newindex イベントを
  738. // 発生させている。
  739. begin
  740. Index := LuaAbsIndex(L, Index);
  741. if (lua_getmetatable(L, Index) = 0) then
  742. lua_newtable(L);
  743. LuaRawSetTableFunction(L, -1, Key, F);
  744. lua_setmetatable(L, Index);
  745. end;
  746. // Convert the last item at 'Index' from the stack to a string
  747. // nil : nil
  748. // Number : FloatToStr
  749. // Boolean: True/False
  750. // stirng : "..."
  751. // Table : { Key1=Value Key2=Value }
  752. function LuaStackToStr(L: Plua_State; Index: Integer; MaxTable: Integer; SubTableMax: Integer): string;
  753. var
  754. pGLobalsIndexPtr: Pointer;
  755. function TableToStr(Index: Integer): string;
  756. var
  757. Key, Value: string;
  758. Count: Integer;
  759. begin
  760. Result := '{ ';
  761. Count := 0;
  762. lua_pushnil(L);
  763. // Go through the current table
  764. while (lua_next(L, Index) <> 0) do
  765. begin
  766. Inc(Count);
  767. if (Count > MaxTable) then
  768. begin
  769. Result := Result + '... ';
  770. lua_pop(L, 2);
  771. Break;
  772. end;
  773. // Key to string
  774. if lua_type(L, -2) = LUA_TNUMBER then
  775. Key := '[' + Dequote(LuaStackToStr(L, -2, MaxTable, SubTableMax)) + ']'
  776. else
  777. Key := Dequote(LuaStackToStr(L, -2, MaxTable, SubTableMax));
  778. // Value to string...
  779. if ((Key = '_G') or (lua_topointer(L, -1) = pGLobalsIndexPtr)) then
  780. Value := LuaGlobalVariableStr
  781. else
  782. Value := LuaStackToStr(L, -1, MaxTable, SubTableMax);
  783. if lua_type(L, -1) = LUA_TFUNCTION then
  784. begin
  785. if lua_iscfunction(L, -1) then
  786. Result := Result + Format('%s=CFUNC:%p ', [Key, lua_topointer(L, -1)])
  787. else
  788. Result := Result + Format('%s=FUNC:%p ', [Key, lua_topointer(L, -1)]);
  789. end
  790. else if lua_type(L, -1) = LUA_TUSERDATA then
  791. Result := Result + Format('%s=USERDATA:%p', [Key, lua_touserdata(L, -1)])
  792. else if lua_type(L, -1) = LUA_TLIGHTUSERDATA then
  793. Result := Result + Format('%s=LIGHTUSERDATA:%p', [Key, lua_touserdata(L, -1)])
  794. else if lua_type(L, -1) = LUA_TTHREAD then
  795. Result := Result + Format('%s=THREAD:%p', [Key, lua_tothread(L, -1)])
  796. else
  797. Result := Result + Format('%s=%s ', [Key, Value]);
  798. // Pop current value from stack leaving current key on top of the stack for lua_next
  799. lua_pop(L, 1);
  800. end;
  801. Result := Result + '}';
  802. end;
  803. begin
  804. if (MaxTable < 0) then
  805. MaxTable := DefaultMaxTable;
  806. pGLobalsIndexPtr := lua_topointer(L, LUA_GLOBALSINDEX); // Retrieve globals index poiner for later conditions
  807. lua_checkstack(L, SubTableMax * 3); // Ensure there is enough space on stack to work with according to user's setting
  808. Index := LuaAbsIndex(L, Index);
  809. case (lua_type(L, Index)) of
  810. LUA_TNIL:
  811. Result := 'nil';
  812. LUA_TNUMBER:
  813. Result := Format('%g', [lua_tonumber(L, Index)]);
  814. LUA_TBOOLEAN:
  815. Result := BoolToStr(lua_toboolean(L, Index) <> 0, True);
  816. LUA_TSTRING:
  817. Result := '"'+lua_tostring(L, Index)+'"';
  818. LUA_TTABLE:
  819. begin
  820. if SubTableCount < SubTableMax then
  821. begin
  822. SubTableCount := SubTableCount + 1;
  823. Result := TableToStr(Index);
  824. SubTableCount := SubTableCount - 1;
  825. end
  826. else
  827. Result := '[SUB_TABLE_MAX_LEVEL_HAS_BEEN_REACHED]';
  828. end;
  829. LUA_TFUNCTION:
  830. if (lua_iscfunction(L, Index) <> 0) then
  831. Result := Format('CFUNC:%p', [Pointer(lua_tocfunction(L, Index))])
  832. else
  833. Result := Format('FUNC:%p', [lua_topointer(L, Index)]);
  834. LUA_TUSERDATA:
  835. Result := Format('USERDATA:%p', [lua_touserdata(L, Index)]);
  836. LUA_TLIGHTUSERDATA:
  837. Result := Format('LIGHTUSERDATA:%p', [lua_touserdata(L, Index)]);
  838. LUA_TTHREAD:
  839. Result := Format('THREAD:%p', [lua_tothread(L, Index)]);
  840. else
  841. Assert(False);
  842. end;
  843. end;
  844. procedure LuaShowStack(L: Plua_State; Caption: string);
  845. var
  846. I, N: Integer;
  847. S: string;
  848. begin
  849. N := lua_gettop(L);
  850. S := '[' + Caption + ']';
  851. for I := N downto 1 do
  852. begin
  853. S := S + CRLF + Format('%3d,%3d:%s', [LuaAbsIndex(L, I), LuaIncIndex(L, I),
  854. LuaStackToStr(L, I, -1)]);
  855. end;
  856. ShowMessage(S);
  857. end;
  858. procedure LuaProcessTableName(L: Plua_State; const Name: PChar;
  859. var LastName: string; var TableIndex, Count: Integer);
  860. // Name のテーブル要素をスタックに積んで、
  861. // スタックに積んだ数と Name の最終要素の名前とその親テーブルのインデックスを返す
  862. // テーブルが無い場合は作成する
  863. // LuaProcessTableName(L, 'print', S, TI, Count) → S = print, TI = LUA_GLOBALSINDEX, Count = 0
  864. // LuaProcessTableName(L, 'io.write', S, TI, Count) → S = write, TI -> io, Count = 1
  865. // LuaProcessTableName(L, 'a.b.c.func', S, TI, Count) → S = func, TI -> a.b.c, Count = 3
  866. var
  867. S: string;
  868. function GetToken: string;
  869. var
  870. Index: Integer;
  871. begin
  872. Index := Pos('.', S);
  873. if (Index = 0) then
  874. begin
  875. Result := S;
  876. S := '';
  877. Exit;
  878. end;
  879. Result := Copy(S, 1, Index - 1);
  880. S := Copy(S, Index + 1, Length(S));
  881. end;
  882. begin
  883. S := Name;
  884. Count := 0;
  885. LastName := GetToken;
  886. while (S <> '') do
  887. begin
  888. Inc(Count);
  889. TableIndex := LuaAbsIndex(L, TableIndex);
  890. LuaGetTable(L, TableIndex, LastName);
  891. if (lua_type(L, -1) <> LUA_TTABLE) then
  892. begin
  893. lua_pop(L, 1);
  894. lua_pushstring(L, PChar(LastName));
  895. lua_newtable(L);
  896. lua_rawset(L, TableIndex);
  897. LuaGetTable(L, TableIndex, LastName);
  898. end;
  899. TableIndex := -1;
  900. LastName := GetToken;
  901. end;
  902. end;
  903. procedure LuaRegisterInPackage(L: PLua_State; const Package: PChar; const lr: PLuaL_Reg);
  904. begin
  905. luaL_register(L, Package, lr);
  906. end;
  907. procedure LuaRegisterCustom(L: PLua_State; TableIndex: Integer; const Name: PChar; F: lua_CFunction);
  908. var
  909. Count: Integer;
  910. S: string;
  911. begin
  912. LuaProcessTableName(L, Name, S, TableIndex, Count);
  913. LuaRawSetTableFunction(L, TableIndex, S, F);
  914. lua_pop(L, Count);
  915. end;
  916. procedure LuaRegister(L: Plua_State; const Name: PChar; F: lua_CFunction);
  917. // 関数の登録
  918. // LuaRegister(L, 'print', lua_print);
  919. // LuaRegister(L, 'io.write', lua_io_write); // テーブル io が無い場合は作成
  920. // LuaRegister(L, 'a.b.c.func', a_b_c_func); // テーブル a.b.c が無い場合は作成
  921. begin
  922. LuaRegisterCustom(L, LUA_GLOBALSINDEX, Name, F);
  923. end;
  924. procedure LuaRegisterMetatable(L: Plua_State; const Name: PChar; F: lua_CFunction);
  925. begin
  926. LuaRegisterCustom(L, LUA_REGISTRYINDEX, Name, F);
  927. end;
  928. procedure LuaRegisterProperty(L: PLua_State; const Name: PChar; ReadFunc, WriteFunc: lua_CFunction);
  929. var
  930. Count: Integer;
  931. TI: Integer;
  932. S: string;
  933. begin
  934. TI := LUA_GLOBALSINDEX;
  935. LuaProcessTableName(L, Name, S, TI, Count);
  936. TI := LuaAbsIndex(L, TI);
  937. LuaGetTable(L, TI, S);
  938. if (lua_type(L, -1) <> LUA_TTABLE) then
  939. begin
  940. lua_pop(L, 1);
  941. lua_pushstring(L, PChar(S));
  942. lua_newtable(L);
  943. lua_settable(L, TI);
  944. LuaGetTable(L, TI, S);
  945. end;
  946. if (Assigned(ReadFunc)) then
  947. LuaSetMetaFunction(L, -1, '__index', ReadFunc);
  948. if (Assigned(WriteFunc)) then
  949. LuaSetMetaFunction(L, -1, '__newindex', WriteFunc);
  950. lua_pop(L, Count + 1);
  951. end;
  952. procedure LuaStackToStrings(L: Plua_State; Lines: TStrings; MaxTable: Integer = -1; SubTableMax: Integer = 99);
  953. var
  954. I: Integer;
  955. begin
  956. Lines.Clear;
  957. for I := lua_gettop(L) downto 1 do
  958. Lines.Add(LuaStackToStr(L, I, MaxTable, SubTableMax));
  959. end;
  960. procedure LuaLocalToStrings(L: Plua_State; Lines: TStrings; MaxTable: Integer; Level: Integer; SubTableMax: Integer);
  961. var
  962. Name: PChar;
  963. Index: Integer;
  964. Debug: lua_Debug;
  965. AR: Plua_Debug;
  966. begin
  967. AR := @Debug;
  968. Lines.Clear;
  969. Index := 1;
  970. if (lua_getstack(L, Level, AR) = 0) then
  971. Exit;
  972. Name := lua_getlocal(L, AR, Index);
  973. while (Name <> nil) do
  974. begin
  975. Lines.Values[Name] := LuaStackToStr(L, -1, MaxTable, SubTableMax);
  976. lua_pop(L, 1);
  977. Inc(Index);
  978. Name := lua_getlocal(L, AR, Index);
  979. end;
  980. end;
  981. procedure LuaLocalToVariables(L: Plua_State; Locals: TList; MaxTable: Integer; Level: Integer; SubTableMax: Integer; CheckCyclicReferencing: Boolean);
  982. var
  983. Variable: TLuaVariable;
  984. Name: PChar;
  985. Index: Integer;
  986. Debug: lua_Debug;
  987. AR: Plua_Debug;
  988. begin
  989. AR := @Debug;
  990. Locals.Clear();
  991. Index := 1;
  992. if (lua_getstack(L, Level, AR) = 0) then
  993. Exit;
  994. Name := lua_getlocal(L, AR, Index);
  995. while (Name <> nil) do
  996. begin
  997. Variable := TLuaVariable.Create(Name, LuaStackToStr(L, -1, MaxTable, SubTableMax, CheckCyclicReferencing));
  998. Locals.Add(Variable);
  999. lua_pop(L, 1);
  1000. Inc(Index);
  1001. Name := lua_getlocal(L, AR, Index);
  1002. end;
  1003. end;
  1004. procedure LuaGlobalToVariables(L: PLua_State; Globals: TLuaTable; MaxTable: Integer; SubTableMax: Integer; CheckCyclicReferencing: Boolean);
  1005. begin
  1006. lua_pushvalue(L, LUA_GLOBALSINDEX);
  1007. LuaTableToVariables(L, -1, Globals, MaxTable, SubTableMax);
  1008. lua_pop(L, 1);
  1009. end;
  1010. procedure LuaGlobalToStrings(L: PLua_State; Lines: TStrings; MaxTable: Integer; SubTableMax: Integer; CheckCyclicReferencing: Boolean);
  1011. begin
  1012. lua_pushvalue(L, LUA_GLOBALSINDEX);
  1013. LuaTableToStrings(L, -1, Lines, MaxTable, SubTableMax);
  1014. lua_pop(L, 1);
  1015. end;
  1016. procedure LuaTableToVariables(L: Plua_State; Index: Integer; Table: TLuaTable; MaxTable: Integer; SubTableMax: Integer; CheckCyclicReferencing: Boolean);
  1017. var
  1018. Variable: TLuaVariable;
  1019. StrKey, Value: string;
  1020. IntKey: Integer;
  1021. begin
  1022. Index := LuaAbsIndex(L, Index);
  1023. Table.Clear();
  1024. lua_pushnil(L);
  1025. while (lua_next(L, Index) <> 0) do
  1026. begin
  1027. Value := LuaStackToStr(L, -1, MaxTable, SubTableMax, CheckCyclicReferencing);
  1028. if lua_type(L, -2) = LUA_TNUMBER then
  1029. begin
  1030. IntKey := lua_tointeger(L, -2);
  1031. Variable := TLuaVariable.Create(IntToStr(IntKey), Value);
  1032. Table.InsertAt(IntKey, Variable);
  1033. end
  1034. else
  1035. begin
  1036. StrKey := Dequote(LuaStackToStr(L, -2, MaxTable, SubTableMax, CheckCyclicReferencing));
  1037. Variable := TLuaVariable.Create(StrKey, Value);
  1038. Table.InsertAt(StrKey, Variable);
  1039. end;
  1040. lua_pop(L, 1);
  1041. end;
  1042. end;
  1043. procedure LuaTableToStrings(L: Plua_State; Index: Integer; Lines: TStrings; MaxTable: Integer; SubTableMax: Integer; CheckCyclicReferencing: Boolean);
  1044. var
  1045. Key, Value: string;
  1046. begin
  1047. Index := LuaAbsIndex(L, Index);
  1048. Lines.Clear;
  1049. lua_pushnil(L);
  1050. while (lua_next(L, Index) <> 0) do
  1051. begin
  1052. Key := Dequote(LuaStackToStr(L, -2, MaxTable, SubTableMax));
  1053. Value := LuaStackToStr(L, -1, MaxTable, SubTableMax);
  1054. Lines.Values[Key] := Value;
  1055. lua_pop(L, 1);
  1056. end;
  1057. end;
  1058. procedure LuaTableToTreeView(L: Plua_State; Index: Integer; TV: TTreeView; MaxTable: Integer; SubTableMax: Integer);
  1059. var
  1060. pGLobalsIndexPtr: Pointer;
  1061. // Go through all child of current table and create nodes
  1062. procedure ParseTreeNode(TreeNode: TTreeNode; Index: Integer);
  1063. var
  1064. Key: string;
  1065. begin
  1066. Index := LuaAbsIndex(L, Index);
  1067. lua_pushnil(L);
  1068. while (lua_next(L, Index) <> 0) do
  1069. begin
  1070. Key := Dequote(LuaStackToStr(L, -2, MaxTable, SubTableMax));
  1071. if (lua_type(L, -1) <> LUA_TTABLE) then
  1072. TV.Items.AddChild(TreeNode, Key + '=' + LuaStackToStr(L, -1, MaxTable, SubTableMax))
  1073. else
  1074. begin
  1075. if ((Key = '_G') or (lua_topointer(L, -1) = pGLobalsIndexPtr)) then
  1076. begin
  1077. TV.Items.AddChild(TreeNode, Key + '=[LUA_GLOBALSINDEX]')
  1078. end
  1079. else
  1080. begin
  1081. if SubTableCount < SubTableMax then
  1082. begin
  1083. SubTableCount := SubTableCount + 1;
  1084. ParseTreeNode(TV.Items.AddChild(TreeNode, Key), -1);
  1085. SubTableCount := SubTableCount - 1;
  1086. end;
  1087. end;
  1088. end;
  1089. lua_pop(L, 1);
  1090. end;
  1091. end;
  1092. begin
  1093. Assert(lua_type(L, Index) = LUA_TTABLE);
  1094. TV.Items.BeginUpdate;
  1095. TV.Items.Clear;
  1096. try
  1097. ParseTreeNode(nil, Index);
  1098. finally
  1099. TV.Items.EndUpdate;
  1100. end;
  1101. end;
  1102. function LuaGetIdentValue(L: Plua_State; Ident: string; MaxTable: Integer): string;
  1103. const
  1104. DebugValue = '___DEBUG_VALUE___';
  1105. var
  1106. Local: TStrings;
  1107. Code: string;
  1108. Hook: lua_Hook;
  1109. Mask: Integer;
  1110. Count: Integer;
  1111. begin
  1112. if (Ident = '') then
  1113. begin
  1114. Result := '';
  1115. Exit;
  1116. end;
  1117. Local := TStringList.Create;
  1118. try
  1119. LuaLocalToStrings(L, Local, MaxTable);
  1120. Result := Local.Values[Ident];
  1121. if (Result <> '') then
  1122. Exit;
  1123. finally
  1124. Local.Free;
  1125. end;
  1126. Code := DebugValue + '=' + Ident;
  1127. luaL_loadbuffer(L, PChar(Code), Length(Code), 'debug');
  1128. Hook := lua_gethook(L);
  1129. Mask := lua_gethookmask(L);
  1130. Count := lua_gethookcount(L);
  1131. lua_sethook(L, Hook, 0, Count);
  1132. if (lua_pcall(L, 0, 0, 0) = 0) then
  1133. LuaRawGetTable(L, LUA_GLOBALSINDEX, DebugValue);
  1134. Result := LuaStackToStr(L, -1, MaxTable);
  1135. lua_remove(L, -1);
  1136. lua_dostring(L, DebugValue + '=nil');
  1137. lua_sethook(L, Hook, Mask, Count);
  1138. end;
  1139. procedure LuaSetIdentValue(L: Plua_State; Ident, Value: string; MaxTable: Integer);
  1140. var
  1141. Local: TStrings;
  1142. Code: string;
  1143. Index: Integer;
  1144. Debug: lua_Debug;
  1145. AR: Plua_Debug;
  1146. begin
  1147. Local := TStringList.Create;
  1148. try
  1149. AR := @Debug;
  1150. LuaLocalToStrings(L, Local, MaxTable);
  1151. Index := Local.IndexOf(Ident);
  1152. if (Index >= 0) then
  1153. begin
  1154. try
  1155. lua_pushnumber(L, StrToFloat(Value));
  1156. except
  1157. lua_pushstring(L, PChar(Dequote(Value)));
  1158. end;
  1159. lua_getstack(L, 0, AR);
  1160. lua_getinfo(L, 'Snlu', AR);
  1161. lua_setlocal(L, AR, Index + 1);
  1162. end else
  1163. begin
  1164. Code := Ident + '=' + Value;
  1165. luaL_loadbuffer(L, PChar(Code), Length(Code), 'debug');
  1166. if (lua_pcall(L, 0, 0, 0) <> 0) then
  1167. lua_remove(L, -1);
  1168. end;
  1169. finally
  1170. Local.Free;
  1171. end;
  1172. end;
  1173. procedure LuaProcessErrorMessage(const ErrMsg: string; var Title: string; var Line: Integer; var Msg: string);
  1174. const
  1175. Term = #$00;
  1176. function S(Index: Integer): Char;
  1177. begin
  1178. if (Index <= Length(ErrMsg)) then
  1179. Result := ErrMsg[Index]
  1180. else
  1181. Result := Term;
  1182. end;
  1183. function IsDigit(C: Char): Boolean;
  1184. begin
  1185. Result := ('0' <= C) and (C <= '9');
  1186. end;
  1187. function PP(var Index: Integer): Integer;
  1188. begin
  1189. Inc(Index);
  1190. Result := Index;
  1191. end;
  1192. var
  1193. I, Start, Stop: Integer;
  1194. LS: string;
  1195. Find: Boolean;
  1196. begin
  1197. // ErrMsg = Title:Line:Message
  1198. Title := '';
  1199. Line := 0;
  1200. Msg := ErrMsg;
  1201. Find := False;
  1202. I := 1 - 1;
  1203. Stop := 0;
  1204. // :数値: を探す
  1205. repeat
  1206. while (S(PP(I)) <> ':') do
  1207. if (S(I) = Term) then
  1208. Exit;
  1209. Start := I;
  1210. if (not IsDigit(S(PP(I)))) then
  1211. Continue;
  1212. while (IsDigit(S(PP(I)))) do
  1213. if (S(I - 1) = Term) then
  1214. Exit;
  1215. Stop := I;
  1216. if (S(I) = ':') then
  1217. Find := True;
  1218. until (Find);
  1219. Title := Copy(ErrMsg, 1, Start - 1);
  1220. LS := Copy(ErrMsg, Start + 1, Stop - Start - 1);
  1221. Line := StrToIntDef(LS, 0);
  1222. Msg := Copy(ErrMsg, Stop + 1, Length(ErrMsg));
  1223. end;
  1224. procedure LuaLoadBuffer(L: Plua_State; const Code: string; const Name: string);
  1225. var
  1226. Title, Msg: string;
  1227. Line: Integer;
  1228. begin
  1229. if (luaL_loadbuffer(L, PChar(Code), Length(Code), PChar(Name)) = 0) then
  1230. Exit;
  1231. LuaProcessErrorMessage(LuaStackToStr(L, -1, -1), Title, Line, Msg);
  1232. raise ELuaException.Create(Title, Line, Msg);
  1233. end;
  1234. procedure LuaLoadBufferFromFile(L: Plua_State; const Filename: string; const Name: string);
  1235. Var
  1236. xCode :String;
  1237. xFile :TStringList;
  1238. begin
  1239. xFile := TStringList.Create;
  1240. xFile.LoadFromFile(FileName);
  1241. xCode := xFile.Text;
  1242. xFile.Free;
  1243. LuaLoadBuffer(L, xCode, Name);
  1244. end;
  1245. procedure LuaPCall(L: Plua_State; NArgs, NResults, ErrFunc: Integer);
  1246. var
  1247. Title, Msg: string;
  1248. Line: Integer;
  1249. begin
  1250. if (lua_pcall(L, NArgs, NResults, ErrFunc) = 0) then
  1251. Exit;
  1252. LuaProcessErrorMessage(Dequote(LuaStackToStr(L, -1, -1)),
  1253. Title, Line, Msg);
  1254. raise ELuaException.Create(Title, Line, Msg);
  1255. end;
  1256. function LuaPCallFunction(L: Plua_State; FunctionName :String;
  1257. const Args: array of Variant;
  1258. Results : PVariantArray;
  1259. ErrFunc: Integer=0;
  1260. NResults :Integer=LUA_MULTRET):Integer;
  1261. var
  1262. NArgs, i: Integer;
  1263. begin
  1264. //Put Function To Call on the Stack
  1265. luaPushString(L, FunctionName);
  1266. lua_gettable(L, LUA_GLOBALSINDEX);
  1267. //Put Parameters on the Stack
  1268. NArgs := High(Args)+1;
  1269. for i:=0 to (NArgs-1) do
  1270. LuaPushVariant(L, Args[i]);
  1271. //Call the Function
  1272. LuaPcall(L, NArgs, NResults, ErrFunc);
  1273. Result :=lua_gettop(L); //Get Number of Results
  1274. if (Results<>Nil)
  1275. then begin
  1276. //Get Results in the right order
  1277. SetLength(Results^, Result);
  1278. for i:=0 to Result-1 do
  1279. begin
  1280. Results^[Result-(i+1)] :=LuaToVariant(L, -(i+1));
  1281. end;
  1282. end;
  1283. end;
  1284. procedure LuaError(L: Plua_State; const Msg: string);
  1285. begin
  1286. luaL_error(L, PChar(Msg));
  1287. end;
  1288. procedure LuaErrorFmt(L: Plua_State; const Fmt: string; const Args: array of Const);
  1289. begin
  1290. LuaError(L, Format(Fmt, Args));
  1291. end;
  1292. { ELuaException }
  1293. constructor ELuaException.Create(Title: string; Line: Integer;
  1294. Msg: string);
  1295. var
  1296. LS: string;
  1297. begin
  1298. if (Line > 0) then
  1299. LS := Format('(%d)', [Line])
  1300. else
  1301. LS := '';
  1302. inherited Create(Title + LS + Msg);
  1303. Self.Title := Title;
  1304. Self.Line := Line;
  1305. Self.Msg := Msg;
  1306. end;
  1307. function LuaDataStrToStrings(const TableStr: string; Strings: TStrings): string;
  1308. (*
  1309. LuaStackToStr 形式から Strings.Values[Name] 構造へ変換
  1310. TableStr
  1311. { Name = "Lua" Version = 5.0 }
  1312. Strings
  1313. Name="Lua"
  1314. Version=5.0
  1315. DataList : Data DataList
  1316. |
  1317. Data : Table
  1318. | {グローバル変数}
  1319. | Ident ( )
  1320. | Ident = Value
  1321. | Ident
  1322. |
  1323. Table : { DataList }
  1324. |
  1325. Value : "..."
  1326. | Data
  1327. *)
  1328. const
  1329. EOF = #$00;
  1330. var
  1331. Index: Integer;
  1332. Text: string;
  1333. Token: Char;
  1334. function S(Index: Integer): Char;
  1335. begin
  1336. if (Index <= Length(TableStr)) then
  1337. Result := TableStr[Index]
  1338. else
  1339. Result := EOF;
  1340. end;
  1341. function GetString: string;
  1342. var
  1343. SI: Integer;
  1344. begin
  1345. Dec(Index);
  1346. Result := '';
  1347. repeat
  1348. Assert(S(Index) = '"');
  1349. SI := Index;
  1350. Inc(Index);
  1351. while (S(Index) <> '"') do
  1352. Inc(Index);
  1353. Result := Result + Copy(TableStr, SI, Index - SI + 1);
  1354. Inc(Index);
  1355. until (S(Index) <> '"');
  1356. end;
  1357. function GetValue: string;
  1358. function IsIdent(C: Char): Boolean;
  1359. const
  1360. S = ' =(){}' + CR + LF;
  1361. begin
  1362. Result := (Pos(C, S) = 0);
  1363. end;
  1364. var
  1365. SI: Integer;
  1366. begin
  1367. Dec(Index);
  1368. SI := Index;
  1369. while (IsIdent(S(Index))) do
  1370. Inc(Index);
  1371. Result := Copy(TableStr, SI, Index - SI);
  1372. end;
  1373. function GetToken: Char;
  1374. function SkipSpace(var Index: Integer): Integer;
  1375. const
  1376. TAB = #$09;
  1377. CR = #$0D;
  1378. LF = #$0A;
  1379. begin
  1380. while (S(Index) in [' ', TAB, CR, LF]) do
  1381. Inc(Index);
  1382. Result := Index;
  1383. end;
  1384. begin
  1385. SkipSpace(Index);
  1386. Token := S(Index);
  1387. Inc(Index);
  1388. Text := Token;
  1389. case (Token) of
  1390. EOF: ;
  1391. '"': Text := GetString;
  1392. '{':
  1393. if (Copy(TableStr, Index - 1, Length(LuaGlobalVariableStr)) = LuaGlobalVariableStr) then
  1394. begin
  1395. Token := 'G';
  1396. Text := LuaGlobalVariableStr;
  1397. Inc(Index, Length(LuaGlobalVariableStr) - 1);
  1398. end;
  1399. '}': ;
  1400. '(': ;
  1401. ')': ;
  1402. '=': ;
  1403. else Text := GetValue
  1404. end;
  1405. Result := Token;
  1406. end;
  1407. procedure Check(S: string);
  1408. begin
  1409. if (Pos(Token, S) = -1) then
  1410. raise Exception.CreateFmt('Error %s is required :%s', [Copy(TableStr, Index - 1, Length(TableStr))]);
  1411. end;
  1412. function CheckGetToken(S: string): Char;
  1413. begin
  1414. Result := GetToken;
  1415. Check(S);
  1416. end;
  1417. function ParseData: string; forward;
  1418. function ParseTable: string; forward;
  1419. function ParseValue: string; forward;
  1420. function ParseDataList: string;
  1421. begin
  1422. with (TStringList.Create) do
  1423. try
  1424. while not (Token in [EOF, '}']) do
  1425. Add(ParseData);
  1426. Result := Text;
  1427. finally
  1428. Free;
  1429. end;
  1430. end;
  1431. function ParseData: string;
  1432. begin
  1433. if (Token = EOF) then
  1434. begin
  1435. Result := '';
  1436. Exit;
  1437. end;
  1438. case (Token) of
  1439. '{': Result := ParseTable;
  1440. 'G':
  1441. begin
  1442. Result := Text;
  1443. GetToken;
  1444. end;
  1445. else
  1446. begin
  1447. Result := Text;
  1448. case (GetToken) of
  1449. '(':
  1450. begin
  1451. CheckGetToken(')');
  1452. Result := Format('%s=()', [Result]);
  1453. GetToken;
  1454. end;
  1455. '=':
  1456. begin
  1457. GetToken;
  1458. Result := Format('%s=%s', [Result, ParseValue]);
  1459. end;
  1460. end;
  1461. end;
  1462. end;
  1463. end;
  1464. function ParseTable: string;
  1465. begin
  1466. if (Token in [EOF]) then
  1467. begin
  1468. Result := '';
  1469. Exit;
  1470. end;
  1471. Check('{');
  1472. GetToken;
  1473. with (TStringList.Create) do
  1474. try
  1475. Text := ParseDataList;
  1476. Result := CommaText;
  1477. finally
  1478. Free;
  1479. end;
  1480. Check('}');
  1481. GetToken;
  1482. end;
  1483. function ParseValue: string;
  1484. begin
  1485. if (Token = EOF) then
  1486. begin
  1487. Result := '';
  1488. Exit;
  1489. end;
  1490. case (Token) of
  1491. '"':
  1492. begin
  1493. Result := Text;
  1494. GetToken;
  1495. end;
  1496. else
  1497. Result := ParseData;
  1498. end;
  1499. end;
  1500. begin
  1501. Index := 1;
  1502. GetToken;
  1503. Strings.Text := ParseDataList;
  1504. end;
  1505. function LuaDoFile(L: Plua_State): Integer; cdecl;
  1506. // dofile 引数(arg)戻り値付き
  1507. // Lua: DoFile(FileName, Args...)
  1508. const
  1509. ArgIdent = 'arg';
  1510. var
  1511. FileName: PChar;
  1512. I, N, R: Integer;
  1513. ArgTable, ArgBackup: Integer;
  1514. begin
  1515. N := lua_gettop(L);
  1516. // arg, result の保存
  1517. lua_getglobal(L, ArgIdent);
  1518. ArgBackup := lua_gettop(L);
  1519. FileName := luaL_checkstring(L, 1);
  1520. lua_newtable(L);
  1521. ArgTable := lua_gettop(L);
  1522. for I := 2 to N do
  1523. begin
  1524. lua_pushvalue(L, I);
  1525. lua_rawseti(L, ArgTable, I - 1);
  1526. end;
  1527. lua_setglobal(L, ArgIdent);
  1528. Result := lua_gettop(L);
  1529. luaL_loadfile(L, PChar(FileName));
  1530. R := lua_pcall(L, 0, LUA_MULTRET, 0);
  1531. Result := lua_gettop(L) - Result;
  1532. LuaRawSetTableValue(L, LUA_GLOBALSINDEX, ArgIdent, ArgBackup);
  1533. lua_remove(L, ArgBackup);
  1534. if (R <> 0) then
  1535. lua_error(L);
  1536. end;
  1537. function LuaGetCurrentFuncName(L: Plua_State) :String;
  1538. var
  1539. ar :lua_Debug;
  1540. begin
  1541. FillChar(ar, sizeof(ar), 0);
  1542. Result :='';
  1543. if (lua_getStack(L, 0, @ar) = 1)
  1544. then begin
  1545. lua_getinfo(L, 'n', @ar);
  1546. Result :=ar.name;
  1547. end;
  1548. end;
  1549. function Lua_VoidFunc(L: Plua_State): Integer; cdecl;
  1550. begin
  1551. Result := 0;
  1552. end;
  1553. initialization
  1554. DefaultMaxTable := 256;
  1555. end.