├── src ├── Lua.inc ├── LuaProject.inc_ ├── pLuaMin.pas ├── pLuaExceptWrapper.pas ├── LuaJIT.pas ├── pLuaTable.pas ├── uWordList.pas ├── LuaObject.pas ├── LuaWrapper.pas ├── pLuaRecord.pas ├── pLuaObject.pas └── pLua.pas ├── demos ├── ConfigApp │ ├── ConfigApp.res │ ├── config.lua │ ├── ConfigApp.dpr │ ├── MainForm.dfm │ ├── luaConfig.pas │ └── MainForm.pas ├── LuaObjects │ ├── LuaObjects.res │ ├── script.lua │ ├── LuaObjects.dpr │ ├── MainForm.dfm │ ├── MainForm.pas │ └── LuaButton.pas ├── pLuaObjects │ ├── pLuaObjects.res │ ├── script.lua │ ├── pLuaObjects.dpr │ ├── MainForm.dfm │ ├── MainForm.pas │ └── LuaButton.pas ├── pLuaRecords │ ├── pLuaRecords.res │ ├── pLuaRecords.dpr │ ├── MainForm.dfm │ ├── script.lua │ ├── MainForm.pas │ └── RecTest.pas ├── pLuaObjects2 │ ├── pLuaObjects.res │ ├── pLuaObjects.dpr │ ├── script.lua │ ├── MainForm.dfm │ ├── MainForm.pas │ └── LuaButton.pas └── AssociativeArray │ ├── AssociativeArrayDemo.res │ ├── script.lua │ ├── AssociativeArrayDemo.dpr │ ├── MainForm.dfm │ ├── MainForm.pas │ ├── luaAssociativeArray.pas │ └── uAssociativeArray.pas ├── .gitignore ├── LICENSE └── README.md /src/Lua.inc: -------------------------------------------------------------------------------- 1 | // user defines 2 | {$I LuaProject.inc} 3 | -------------------------------------------------------------------------------- /demos/ConfigApp/ConfigApp.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForwardDelphi/pLua-XE/HEAD/demos/ConfigApp/ConfigApp.res -------------------------------------------------------------------------------- /demos/LuaObjects/LuaObjects.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForwardDelphi/pLua-XE/HEAD/demos/LuaObjects/LuaObjects.res -------------------------------------------------------------------------------- /demos/pLuaObjects/pLuaObjects.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForwardDelphi/pLua-XE/HEAD/demos/pLuaObjects/pLuaObjects.res -------------------------------------------------------------------------------- /demos/pLuaRecords/pLuaRecords.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForwardDelphi/pLua-XE/HEAD/demos/pLuaRecords/pLuaRecords.res -------------------------------------------------------------------------------- /demos/pLuaObjects2/pLuaObjects.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForwardDelphi/pLua-XE/HEAD/demos/pLuaObjects2/pLuaObjects.res -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | __history/ 2 | *.dcu 3 | *.exe 4 | *.bat 5 | *.dll 6 | *.~* 7 | *.dproj 8 | *.local 9 | *.dproj.local 10 | *.identcache 11 | Thumbs.db -------------------------------------------------------------------------------- /demos/AssociativeArray/AssociativeArrayDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForwardDelphi/pLua-XE/HEAD/demos/AssociativeArray/AssociativeArrayDemo.res -------------------------------------------------------------------------------- /demos/AssociativeArray/script.lua: -------------------------------------------------------------------------------- 1 | ar.dog = 'The dog goes woof!'; 2 | ar.cat = 'The cat says meow!'; 3 | ar['bird'] = "The bird is in the cat's stomache!"; 4 | -------------------------------------------------------------------------------- /src/LuaProject.inc_: -------------------------------------------------------------------------------- 1 | // user defines 2 | // you must add this file with extension renamed to your project directory 3 | 4 | {$DEFINE LUA51} 5 | //{$DEFINE LUAJIT} 6 | -------------------------------------------------------------------------------- /demos/LuaObjects/script.lua: -------------------------------------------------------------------------------- 1 | btn = TButton:new() 2 | btn.Caption = 'Click ME!' 3 | btn.Left = 20 4 | btn.Top = 20 5 | function btn:OnClick () 6 | ShowMessage('You clicked the button!') 7 | end 8 | btn.Visible = true 9 | -------------------------------------------------------------------------------- /demos/pLuaObjects/script.lua: -------------------------------------------------------------------------------- 1 | btn = TButton:new() 2 | btn.Caption = 'Click ME!' 3 | btn.Left = 20 4 | btn.Top = 20 5 | function btn:OnClick () 6 | ShowMessage('You clicked the button!') 7 | end 8 | btn.Visible = true 9 | -------------------------------------------------------------------------------- /demos/ConfigApp/config.lua: -------------------------------------------------------------------------------- 1 | --Config.Caption = 'Caption set from config.lua' 2 | --Config.Color = HexToInt('00FF00') 3 | aConfig = { 4 | Caption = 'Caption set inside a table!', 5 | Color = HexToInt('FF0000') 6 | } 7 | 8 | SetConfig(aConfig) 9 | -------------------------------------------------------------------------------- /demos/ConfigApp/ConfigApp.dpr: -------------------------------------------------------------------------------- 1 | program ConfigApp; 2 | 3 | uses 4 | Forms, 5 | MainForm in 'MainForm.pas' {frmMain}, 6 | luaConfig; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | 16 | -------------------------------------------------------------------------------- /demos/pLuaRecords/pLuaRecords.dpr: -------------------------------------------------------------------------------- 1 | program pLuaRecords; 2 | 3 | uses 4 | Forms, 5 | MainForm in 'MainForm.pas' {Form1}, 6 | RecTest; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | 16 | -------------------------------------------------------------------------------- /demos/LuaObjects/LuaObjects.dpr: -------------------------------------------------------------------------------- 1 | program LuaObjects; 2 | 3 | uses 4 | Forms, 5 | MainForm in 'MainForm.pas' {frmMain}, 6 | LuaButton; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | 16 | -------------------------------------------------------------------------------- /demos/pLuaObjects/pLuaObjects.dpr: -------------------------------------------------------------------------------- 1 | program pLuaObjects; 2 | 3 | uses 4 | Forms, 5 | MainForm in 'MainForm.pas' {frmMain}, 6 | LuaButton; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | 16 | -------------------------------------------------------------------------------- /demos/pLuaObjects2/pLuaObjects.dpr: -------------------------------------------------------------------------------- 1 | program pLuaObjects; 2 | 3 | uses 4 | Forms, 5 | MainForm in 'MainForm.pas' {frmMain}, 6 | LuaButton; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | 16 | -------------------------------------------------------------------------------- /demos/pLuaObjects2/script.lua: -------------------------------------------------------------------------------- 1 | -- Change the caption of the existing button 2 | btn.Caption = 'Click ME!' 3 | -- Set its position 4 | btn.Left = 20 5 | btn.Top = 20 6 | -- Add an event handler 7 | function btn:OnClick () 8 | ShowMessage('You clicked the button!') 9 | end 10 | -- Make it visible 11 | btn.Visible = true 12 | -------------------------------------------------------------------------------- /demos/AssociativeArray/AssociativeArrayDemo.dpr: -------------------------------------------------------------------------------- 1 | program AssociativeArrayDemo; 2 | 3 | uses 4 | Forms, 5 | MainForm in 'MainForm.pas' {frmMain}, 6 | uAssociativeArray, 7 | luaAssociativeArray; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.CreateForm(TfrmMain, frmMain); 14 | Application.Run; 15 | end. 16 | 17 | -------------------------------------------------------------------------------- /demos/ConfigApp/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 288 3 | Top = 149 4 | Caption = 'Application Configuration Demo' 5 | ClientHeight = 271 6 | ClientWidth = 392 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = True 14 | OnCreate = FormCreate 15 | OnShow = FormShow 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | end 19 | -------------------------------------------------------------------------------- /demos/LuaObjects/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 290 3 | Top = 149 4 | Caption = 'frmMain' 5 | ClientHeight = 271 6 | ClientWidth = 392 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = True 14 | OnCloseQuery = FormCloseQuery 15 | OnCreate = FormCreate 16 | OnShow = FormShow 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | end 20 | -------------------------------------------------------------------------------- /demos/pLuaObjects/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 290 3 | Top = 149 4 | Caption = 'frmMain' 5 | ClientHeight = 271 6 | ClientWidth = 392 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = True 14 | OnCloseQuery = FormCloseQuery 15 | OnCreate = FormCreate 16 | OnShow = FormShow 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | end 20 | -------------------------------------------------------------------------------- /demos/pLuaObjects2/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 290 3 | Top = 149 4 | ActiveControl = btn 5 | Caption = 'frmMain' 6 | ClientHeight = 300 7 | ClientWidth = 400 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = True 15 | OnCreate = FormCreate 16 | OnShow = FormShow 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object btn: TButton 20 | Left = 104 21 | Top = 160 22 | Width = 75 23 | Height = 25 24 | Caption = 'btn' 25 | TabOrder = 0 26 | end 27 | end 28 | -------------------------------------------------------------------------------- /demos/pLuaRecords/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 290 3 | Top = 149 4 | ActiveControl = Button1 5 | Caption = 'Form1' 6 | ClientHeight = 300 7 | ClientWidth = 400 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = True 15 | OnCreate = FormCreate 16 | OnShow = FormShow 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Button1: TButton 20 | Left = 37 21 | Top = 24 22 | Width = 75 23 | Height = 25 24 | Caption = 'Run' 25 | TabOrder = 0 26 | OnClick = Button1Click 27 | end 28 | end 29 | -------------------------------------------------------------------------------- /demos/pLuaRecords/script.lua: -------------------------------------------------------------------------------- 1 | r.AString = 'Test' -- r is created and registered in the application 2 | r.Int = 123 3 | r.Num = 1.23 4 | 5 | r2 = MyRecord:new() 6 | r2.AString = 'Test2' 7 | r2.Int = 345 8 | r2.Num = 6.78 9 | 10 | function serialize(o, pre) 11 | if pre == nil then 12 | pre = '' 13 | end 14 | if type(o)~='table' then 15 | if type(o) == 'string' then 16 | return '"' .. o .. '"' 17 | elseif type(o) ~= 'function' then 18 | return o 19 | else 20 | return 'function () end' 21 | end 22 | else 23 | local res = '{\n' 24 | for k, v in pairs(o) do 25 | res = res .. pre .. " ['" .. tostring(k) .. "']=" .. serialize(v, pre..' ') .. ',\n' 26 | end 27 | res = res .. pre .. '}' 28 | return res 29 | end 30 | end 31 | 32 | ShowMessage('MyRecord='..serialize(MyRecord)..'\nr.AString='..r.AString..'\nr.Int='..r.Int..'\nr.Num='..r.Num..'\nr2.AString='..r2.AString..'\nr2.Int='..r2.Int..'\nr2.Num='..r2.Num) 33 | r2:release() -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2007 Jeremy Darling 4 | Portions Copyright (c) 2006 Geo Massar 5 | Modifications copyright (c) 2009-2017 Denis Golovan 6 | Modifications copyright (c) 2010-2020 Felipe Daragon 7 | 8 | Permission is hereby granted, free of charge, to any person obtaining a copy of 9 | this software and associated documentation files (the "Software"), to deal in 10 | the Software without restriction, including without limitation the rights to 11 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 12 | the Software, and to permit persons to whom the Software is furnished to do so, 13 | subject to the following conditions: 14 | 15 | The above copyright notice and this permission notice shall be included in all 16 | copies or substantial portions of the Software. 17 | 18 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 20 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 21 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 22 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 23 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /demos/pLuaObjects2/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LuaWrapper, 7 | StdCtrls; 8 | 9 | type 10 | { TfrmMain } 11 | TfrmMain = class(TForm) 12 | btn: TButton; 13 | procedure FormCreate(Sender: TObject); 14 | procedure FormShow(Sender: TObject); 15 | private 16 | { private declarations } 17 | public 18 | { public declarations } 19 | Lua : TLua; 20 | end; 21 | 22 | var 23 | frmMain: TfrmMain; 24 | 25 | implementation 26 | 27 | uses 28 | lua, plua, LuaButton, pLuaObject; 29 | 30 | {$R *.dfm} 31 | 32 | function lua_ShowMessage(l : PLua_State) : integer; cdecl; 33 | var 34 | n, i : Integer; 35 | msg : String; 36 | begin 37 | result := 0; 38 | n := lua_gettop(l); 39 | if n > 0 then 40 | begin 41 | msg := ''; 42 | for i := 1 to n do 43 | msg := msg + lua_tostring(L, i); 44 | ShowMessage(msg); 45 | end; 46 | end; 47 | 48 | { TfrmMain } 49 | 50 | procedure TfrmMain.FormCreate(Sender: TObject); 51 | begin 52 | Lua := TLua.Create(self); 53 | Lua.RegisterLuaMethod('ShowMessage', @lua_ShowMessage); 54 | RegisterLuaButton(Lua.LuaState); 55 | end; 56 | 57 | procedure TfrmMain.FormShow(Sender: TObject); 58 | begin 59 | RegisterExistingButton(Lua.LuaState, 'btn', btn); 60 | if FileExists('script.lua') then 61 | begin 62 | Lua.LoadFile('script.lua'); 63 | Lua.Execute; 64 | end; 65 | end; 66 | 67 | end. 68 | 69 | -------------------------------------------------------------------------------- /demos/AssociativeArray/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 291 3 | Top = 162 4 | Caption = 'Associative Array Demo' 5 | ClientHeight = 103 6 | ClientWidth = 314 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = True 14 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object lblName: TLabel 19 | Left = 9 20 | Top = 8 21 | Width = 31 22 | Height = 13 23 | Caption = 'Name:' 24 | Color = clBtnFace 25 | ParentColor = False 26 | end 27 | object lblValue: TLabel 28 | Left = 9 29 | Top = 48 30 | Width = 30 31 | Height = 13 32 | Caption = 'Value:' 33 | Color = clBtnFace 34 | ParentColor = False 35 | end 36 | object edName: TEdit 37 | Left = 15 38 | Top = 24 39 | Width = 217 40 | Height = 23 41 | TabOrder = 0 42 | end 43 | object edValue: TEdit 44 | Left = 15 45 | Top = 64 46 | Width = 217 47 | Height = 23 48 | TabOrder = 2 49 | end 50 | object btnRead: TButton 51 | Left = 232 52 | Top = 22 53 | Width = 75 54 | Height = 25 55 | Caption = 'Read' 56 | TabOrder = 1 57 | OnClick = btnReadClick 58 | end 59 | object btnWrite: TButton 60 | Left = 232 61 | Top = 62 62 | Width = 75 63 | Height = 25 64 | Caption = 'Write' 65 | TabOrder = 3 66 | OnClick = btnWriteClick 67 | end 68 | end 69 | -------------------------------------------------------------------------------- /demos/LuaObjects/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LuaWrapper; 7 | 8 | type 9 | { TfrmMain } 10 | TfrmMain = class(TForm) 11 | procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); 12 | procedure FormCreate(Sender: TObject); 13 | procedure FormShow(Sender: TObject); 14 | private 15 | { private declarations } 16 | public 17 | { public declarations } 18 | Lua : TLua; 19 | end; 20 | 21 | var 22 | frmMain: TfrmMain; 23 | 24 | implementation 25 | 26 | uses 27 | lua, plua, LuaButton, LuaObject; 28 | 29 | {$R *.dfm} 30 | 31 | function lua_ShowMessage(l : PLua_State) : integer; cdecl; 32 | var 33 | n, i : Integer; 34 | msg : String; 35 | begin 36 | result := 0; 37 | n := lua_gettop(l); 38 | if n > 0 then 39 | begin 40 | msg := ''; 41 | for i := 1 to n do 42 | msg := msg + lua_tostring(L, i); 43 | ShowMessage(msg); 44 | end; 45 | end; 46 | 47 | { TfrmMain } 48 | 49 | procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean); 50 | begin 51 | ClearObjects; 52 | end; 53 | 54 | procedure TfrmMain.FormCreate(Sender: TObject); 55 | begin 56 | Lua := TLua.Create(self); 57 | Lua.RegisterLuaMethod('ShowMessage', @lua_ShowMessage); 58 | RegisterLuaButton(Lua.LuaState); 59 | end; 60 | 61 | procedure TfrmMain.FormShow(Sender: TObject); 62 | begin 63 | if FileExists('script.lua') then 64 | begin 65 | Lua.LoadFile('script.lua'); 66 | Lua.Execute; 67 | end; 68 | end; 69 | 70 | end. 71 | 72 | -------------------------------------------------------------------------------- /demos/pLuaObjects/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LuaWrapper; 7 | 8 | type 9 | { TfrmMain } 10 | TfrmMain = class(TForm) 11 | procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); 12 | procedure FormCreate(Sender: TObject); 13 | procedure FormShow(Sender: TObject); 14 | private 15 | { private declarations } 16 | public 17 | { public declarations } 18 | Lua : TLua; 19 | end; 20 | 21 | var 22 | frmMain: TfrmMain; 23 | 24 | implementation 25 | 26 | uses 27 | lua, plua, LuaButton, LuaObject; 28 | 29 | {$R *.dfm} 30 | 31 | function lua_ShowMessage(l : PLua_State) : integer; cdecl; 32 | var 33 | n, i : Integer; 34 | msg : String; 35 | begin 36 | result := 0; 37 | n := lua_gettop(l); 38 | if n > 0 then 39 | begin 40 | msg := ''; 41 | for i := 1 to n do 42 | msg := msg + lua_tostring(L, i); 43 | ShowMessage(msg); 44 | end; 45 | end; 46 | 47 | { TfrmMain } 48 | 49 | procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean); 50 | begin 51 | ClearObjects; 52 | end; 53 | 54 | procedure TfrmMain.FormCreate(Sender: TObject); 55 | begin 56 | Lua := TLua.Create(self); 57 | Lua.RegisterLuaMethod('ShowMessage', @lua_ShowMessage); 58 | RegisterLuaButton(Lua.LuaState); 59 | end; 60 | 61 | procedure TfrmMain.FormShow(Sender: TObject); 62 | begin 63 | if FileExists('script.lua') then 64 | begin 65 | Lua.LoadFile('script.lua'); 66 | Lua.Execute; 67 | end; 68 | end; 69 | 70 | end. 71 | 72 | -------------------------------------------------------------------------------- /demos/ConfigApp/luaConfig.pas: -------------------------------------------------------------------------------- 1 | unit luaConfig; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, lua, pLua, pLuaRecord; 7 | 8 | implementation 9 | 10 | uses 11 | MainForm; 12 | 13 | function GetCaption(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 14 | begin 15 | // Get the value of the caption and put it on the stack 16 | lua_pushstring(l, frmMain.Caption); 17 | result := 1; 18 | end; 19 | 20 | function SetCaption(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 21 | begin 22 | // Get the new caption from the stack and set frmMain.Caption to it 23 | frmMain.Caption := lua_tostring(L, paramidxstart); 24 | result := 0; 25 | end; 26 | 27 | function GetColor(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 28 | begin 29 | // Get the value of the Color and put it on the stack 30 | lua_pushinteger(l, frmMain.Color); 31 | result := 1; 32 | end; 33 | 34 | function SetColor(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 35 | begin 36 | // Get the new Color from the stack and set frmMain.Color to it 37 | frmMain.Color := lua_tointeger(L, paramidxstart); 38 | result := 0; 39 | end; 40 | 41 | procedure Init; 42 | var 43 | ri : PLuaRecordInfo; 44 | begin 45 | // Create a virtual "Config" global variable (record) that will allow 46 | // the lua script to access application properties. 47 | ri := RecordTypesList.Add('TConfig'); 48 | plua_AddRecordProperty(ri^, 'Caption', @GetCaption, @SetCaption); 49 | plua_AddRecordProperty(ri^, 'Color', @GetColor, @SetColor); 50 | end; 51 | 52 | initialization 53 | 54 | Init; 55 | 56 | finalization 57 | 58 | end. 59 | 60 | -------------------------------------------------------------------------------- /demos/ConfigApp/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, lua, pLua, 7 | LuaWrapper; 8 | 9 | type 10 | { TfrmMain } 11 | TfrmMain = class(TForm) 12 | procedure FormCreate(Sender: TObject); 13 | procedure FormShow(Sender: TObject); 14 | private 15 | { private declarations } 16 | public 17 | { public declarations } 18 | Lua : TLua; 19 | end; 20 | 21 | var 22 | frmMain: TfrmMain; 23 | 24 | implementation 25 | 26 | uses 27 | luaConfig, pluaRecord; 28 | 29 | {$R *.dfm} 30 | 31 | function lua_HexToInt(L : PLua_State) : integer; cdecl; 32 | begin 33 | result := 1; 34 | lua_pushinteger(L, StrToInt('$'+lua_tostring(L, 1))); 35 | end; 36 | 37 | function lua_SetConfig(L : PLua_State) : integer; cdecl; 38 | begin 39 | result := 0; 40 | lua_pushliteral(L, 'Caption'); 41 | lua_gettable(L, -2); 42 | if not lua_isnil(L, -1) then 43 | frmMain.Caption := lua_tostring(L, -1); 44 | lua_pop(L, 1); 45 | lua_pushliteral(L, 'Color'); 46 | lua_gettable(L, -2); 47 | if not lua_isnil(L, -1) then 48 | frmMain.Color := lua_tointeger(L, -1); 49 | lua_pop(L, 1); 50 | end; 51 | 52 | { TfrmMain } 53 | 54 | procedure TfrmMain.FormCreate(Sender: TObject); 55 | begin 56 | Lua := TLua.Create(self); 57 | Lua.LoadFile('config.lua'); 58 | Lua.RegisterLuaMethod('HexToInt', @lua_HexToInt); 59 | Lua.RegisterLuaMethod('SetConfig', @lua_SetConfig); 60 | // Create a "new" version of our virtual record type and register it to the lua 61 | // global name of "Config" 62 | plua_registerExistingRecord(Lua.LuaState, 'Config', nil, RecordTypesList['TConfig']); 63 | end; 64 | 65 | procedure TfrmMain.FormShow(Sender: TObject); 66 | begin 67 | Lua.Execute; 68 | end; 69 | 70 | end. 71 | 72 | -------------------------------------------------------------------------------- /demos/pLuaRecords/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LuaWrapper, 7 | pLuaRecord, StdCtrls; 8 | 9 | type 10 | { TForm1 } 11 | TForm1 = class(TForm) 12 | Button1: TButton; 13 | procedure Button1Click(Sender: TObject); 14 | procedure FormCreate(Sender: TObject); 15 | procedure FormShow(Sender: TObject); 16 | private 17 | { private declarations } 18 | public 19 | { public declarations } 20 | Lua : TLua; 21 | end; 22 | 23 | var 24 | Form1: TForm1; 25 | 26 | implementation 27 | 28 | uses 29 | lua, plua, RecTest; 30 | 31 | {$R *.dfm} 32 | 33 | var 34 | r : TMyRecord; 35 | 36 | function lua_ShowMessage(l : PLua_State) : integer; cdecl; 37 | var 38 | n, i : Integer; 39 | msg : String; 40 | begin 41 | result := 0; 42 | n := lua_gettop(l); 43 | if n > 0 then 44 | begin 45 | msg := ''; 46 | for i := 1 to n do 47 | msg := msg + lua_tostring(L, i); 48 | ShowMessage(msg); 49 | end; 50 | end; 51 | 52 | { TForm1 } 53 | 54 | procedure TForm1.FormCreate(Sender: TObject); 55 | begin 56 | Lua := TLua.Create(self); 57 | Lua.RegisterLuaMethod('ShowMessage', @lua_ShowMessage); 58 | RegisterMyRecordType(Lua.LuaState); 59 | RegisterExistingMyRecord(Lua.LuaState, 'r', @r); 60 | end; 61 | 62 | procedure TForm1.Button1Click(Sender: TObject); 63 | begin 64 | if FileExists('script.lua') then 65 | Lua.Execute; 66 | end; 67 | 68 | procedure TForm1.FormShow(Sender: TObject); 69 | begin 70 | if FileExists('script.lua') then 71 | begin 72 | try 73 | Lua.LoadFile('script.lua'); 74 | Lua.Execute; 75 | except 76 | on e : Exception do 77 | Caption := e.message; 78 | end; 79 | end 80 | else 81 | Caption := 'No script.lua file found in path.'; 82 | end; 83 | 84 | end. 85 | 86 | -------------------------------------------------------------------------------- /src/pLuaMin.pas: -------------------------------------------------------------------------------- 1 | unit pLuaMin; 2 | 3 | { 4 | Minimal version of pLua.pas with most used functions only 5 | 6 | Copyright (c) 2007 Jeremy Darling 7 | Modifications copyright (c) 2010-2018 Felipe Daragon 8 | 9 | License: MIT (http://opensource.org/licenses/mit-license.php) 10 | Same as the original code by Jeremy Darling. 11 | 12 | } 13 | 14 | interface 15 | 16 | {$I Lua.inc} 17 | 18 | uses 19 | Lua; 20 | 21 | 22 | procedure plua_dostring(L: PLua_State; AString: String); 23 | procedure plua_pushansistring(L: PLua_State; AString : AnsiString); 24 | procedure plua_RegisterLuaTable(L: PLua_State; Name: string; 25 | Reader: lua_CFunction = nil; Writer: lua_CFunction = nil; 26 | TableIndex: Integer = LUA_GLOBALSINDEX); 27 | 28 | implementation 29 | 30 | procedure plua_dostring(L: PLua_State; AString: String); 31 | begin 32 | luaL_loadbuffer(L, PAnsiChar(ansistring(AString)), Length(ansistring(AString) 33 | ), PAnsiChar(ansistring(''))); 34 | lua_pcall(L, 0, 0, 0); 35 | end; 36 | 37 | procedure plua_pushansistring(L: PLua_State; AString: AnsiString); 38 | begin 39 | lua_pushstring(l, pansichar(AString)); 40 | end; 41 | 42 | procedure plua_RegisterLuaTable(L: PLua_State; Name: string; 43 | Reader: lua_CFunction; Writer: lua_CFunction; TableIndex: Integer); 44 | var 45 | tidx, midx: Integer; 46 | begin 47 | lua_gettable(L, TableIndex); 48 | if (lua_type(L, -1) <> LUA_TTABLE) then 49 | begin 50 | lua_pushliteral(L, Name); 51 | lua_newtable(L); 52 | tidx := lua_gettop(L); 53 | 54 | lua_newtable(L); 55 | midx := lua_gettop(L); 56 | 57 | lua_pushstring(L, '__index'); 58 | lua_pushcfunction(L, Reader); 59 | lua_rawset(L, midx); 60 | lua_pushstring(L, '__newindex'); 61 | lua_pushcfunction(L, Writer); 62 | lua_rawset(L, midx); 63 | lua_setmetatable(L, tidx); 64 | lua_settable(L, TableIndex); 65 | end; 66 | end; 67 | 68 | end. 69 | 70 | -------------------------------------------------------------------------------- /demos/AssociativeArray/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, 7 | uAssociativeArray, luaAssociativeArray, LuaWrapper, Variants; 8 | 9 | type 10 | { TfrmMain } 11 | TfrmMain = class(TForm) 12 | btnRead: TButton; 13 | btnWrite: TButton; 14 | edName: TEdit; 15 | edValue: TEdit; 16 | lblName: TLabel; 17 | lblValue: TLabel; 18 | procedure btnReadClick(Sender: TObject); 19 | procedure btnWriteClick(Sender: TObject); 20 | procedure FormCreate(Sender: TObject); 21 | procedure FormDestroy(Sender: TObject); 22 | private 23 | { private declarations } 24 | public 25 | { public declarations } 26 | ar : TAssociativeArray; 27 | lua: TLua; 28 | end; 29 | 30 | var 31 | frmMain: TfrmMain; 32 | 33 | implementation 34 | 35 | {$R *.dfm} 36 | 37 | { TfrmMain } 38 | 39 | procedure TfrmMain.FormCreate(Sender: TObject); 40 | begin 41 | ar := TAssociativeArray.Create; 42 | lua := TLua.Create(self); 43 | if FileExists(ExtractFilePath(ParamStr(0))+'script.lua') then 44 | begin 45 | RegisterAssociativeArray(Lua.LuaState); 46 | RegisterExistingAssociativeArray(lua.LuaState, ar, 'ar'); 47 | lua.LoadFile(ExtractFilePath(ParamStr(0))+'script.lua'); 48 | lua.Execute; 49 | end; 50 | end; 51 | 52 | procedure TfrmMain.FormDestroy(Sender: TObject); 53 | begin 54 | ar.Free; 55 | end; 56 | 57 | procedure TfrmMain.btnReadClick(Sender: TObject); 58 | var 59 | v : Variant; 60 | begin 61 | if trim(edName.Text) = '' then 62 | exit; 63 | v := ar.Values[edName.Text]; 64 | if v <> NULL then 65 | edValue.Text := String(v) 66 | else 67 | edValue.Text := ''; 68 | end; 69 | 70 | procedure TfrmMain.btnWriteClick(Sender: TObject); 71 | begin 72 | if trim(edName.Text) = '' then 73 | exit; 74 | ar.Values[edName.Text] := edValue.Text; 75 | end; 76 | 77 | end. 78 | 79 | -------------------------------------------------------------------------------- /demos/AssociativeArray/luaAssociativeArray.pas: -------------------------------------------------------------------------------- 1 | unit luaAssociativeArray; 2 | 3 | interface 4 | 5 | uses 6 | Lua, Classes, SysUtils, uAssociativeArray; 7 | 8 | procedure RegisterAssociativeArray(L : Plua_State); 9 | procedure RegisterExistingAssociativeArray(L : Plua_State; ar : TAssociativeArray; instanceName : String); 10 | 11 | implementation 12 | 13 | uses 14 | pLua, pLuaObject; 15 | 16 | var 17 | AssociativeArrayInfo : TLuaClassInfo; 18 | 19 | function newAssociativeArray(l : PLua_State; paramidxstart, paramcount : Integer; InstanceInfo : PLuaInstanceInfo) : TObject; 20 | begin 21 | result := TAssociativeArray.Create; 22 | end; 23 | 24 | function _indexAssociativeArray(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 25 | var 26 | vName : String; 27 | begin 28 | vName := lua_tostring(l, paramidxstart-1); 29 | plua_pushvariant(l, TAssociativeArray(target).Values[vName]); 30 | result := 1; 31 | end; 32 | 33 | function _newindexAssociativeArray(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 34 | var 35 | vName : String; 36 | vValue: Variant; 37 | begin 38 | vName := lua_tostring(l, paramidxstart-1); 39 | vValue := plua_tovariant(l, paramidxstart); 40 | TAssociativeArray(target).Values[vName] := vValue; 41 | result := 0; 42 | end; 43 | 44 | procedure RegisterAssociativeArray(L: Plua_State); 45 | begin 46 | plua_registerclass(L, AssociativeArrayInfo); 47 | end; 48 | 49 | procedure RegisterExistingAssociativeArray(L: Plua_State; 50 | ar: TAssociativeArray; instanceName: String); 51 | begin 52 | plua_registerExisting(l, instanceName, ar, @AssociativeArrayInfo, false); 53 | end; 54 | 55 | function setAssociativeArrayInfo : TLuaClassInfo; 56 | begin 57 | plua_initClassInfo(result); 58 | result.ClassName := 'TAssociativeArray'; 59 | result.New := @newAssociativeArray; 60 | result.UnhandledReader := @_indexAssociativeArray; 61 | result.UnhandledWriter := @_newindexAssociativeArray; 62 | end; 63 | 64 | initialization 65 | AssociativeArrayInfo := setAssociativeArrayInfo; 66 | 67 | end. 68 | 69 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | A fork of the pLua project, created by Jeremy Darling (@jdarling) and originally hosted at eonclash.com. 2 | 3 | This modification includes many additions and fixes and has been updated for Delphi XE2 or higher. It still compiles and works with the older, non-Unicode Delphi releases. 4 | 5 | It has been mostly tested with Lua 5.1.4 (64-bit and 32-bit). 6 | 7 | pLua is a long term effort to build a set of methods (functions and procedures), objects, and types to aid Pascal Developers (FPC, Lazarus, and Delphi at the moment) in the implementation of Lua in their projects. 8 | 9 | ## What is Lua # 10 | 11 | Lua is an extension programming language designed to support general procedural programming with data description facilities. It also offers good support for object-oriented programming, functional programming, and data-driven programming. Lua is intended to be used as a powerful, light-weight scripting language for any program that needs one. Lua is implemented as a library, written in clean C (that is, in the common subset of ANSI C and C++). 12 | 13 | Being an extension language, Lua has no notion of a "main" program: it only works embedded in a host client, called the embedding program or simply the host. This host program can invoke functions to execute a piece of Lua code, can write and read Lua variables, and can register C functions to be called by Lua code. Through the use of C functions, Lua can be augmented to cope with a wide range of different domains, thus creating customized programming languages sharing a syntactical framework. The Lua distribution includes a sample host program called lua, which uses the Lua library to offer a complete, stand-alone Lua interpreter. 14 | 15 | Lua is free software, and is provided as usual with no guarantees, as stated in its license. 16 | 17 | For a discussion of the decisions behind the design of Lua, see the technical papers available at [Lua's web site](http://www.lua.org). For a detailed introduction to programming in Lua, see Roberto's book, Programming in Lua (Second Edition). 18 | 19 | ## License # 20 | 21 | pLua-XE is licensed under the MIT license. See [the LICENSE](https://github.com/felipedaragon/pLua-XE/blob/master/LICENSE) file for details. 22 | 23 | The original, unmodified code can be found [here](https://github.com/MageSlayer/pLua/tree/master). 24 | 25 | ## See Also # 26 | 27 | * [pLua+](https://github.com/MageSlayer/pLua) - another pLua fork with LuaJIT support. -------------------------------------------------------------------------------- /demos/AssociativeArray/uAssociativeArray.pas: -------------------------------------------------------------------------------- 1 | unit uAssociativeArray; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, Variants; 7 | 8 | type 9 | PAssocArrayItem = ^TAssocArrayItem; 10 | TAssocArrayItem = packed record 11 | Name : String; 12 | Value: Variant; 13 | Next : PAssocArrayItem; 14 | end; 15 | 16 | { TAssociativeArray } 17 | 18 | TAssociativeArray = class 19 | private 20 | ffirst : PAssocArrayItem; 21 | function GetItem(S: String): Variant; 22 | procedure SetItem(S: String; V: Variant); 23 | public 24 | constructor Create; 25 | destructor Destroy; override; 26 | 27 | property Values[Index: String]: Variant read GetItem write SetItem; default; 28 | end; 29 | 30 | implementation 31 | 32 | { TAssociativeArray } 33 | 34 | function TAssociativeArray.GetItem(S: String): Variant; 35 | var 36 | itm : PAssocArrayItem; 37 | begin 38 | result := NULL; 39 | itm := ffirst; 40 | while (result = NULL) and (assigned(itm)) do 41 | begin 42 | if AnsiCompareText(S, itm^.Name) = 0 then 43 | result := itm^.Value; 44 | itm := itm^.Next; 45 | end; 46 | end; 47 | 48 | procedure TAssociativeArray.SetItem(S: String; V: Variant); 49 | var 50 | workingitm, 51 | itm : PAssocArrayItem; 52 | begin 53 | itm := nil; 54 | workingitm := ffirst; 55 | while (assigned(workingitm)) do 56 | begin 57 | itm := workingitm; 58 | if AnsiCompareText(S, workingitm^.Name) = 0 then 59 | begin 60 | workingitm^.Value := V; 61 | exit; 62 | end; 63 | workingitm := workingitm^.Next; 64 | end; 65 | 66 | // if itm isn't assigned we can't have a first pointer yet, so create it 67 | if not assigned(itm) then 68 | begin 69 | new(ffirst); 70 | ffirst^.Next := nil; 71 | itm := ffirst; 72 | end 73 | else 74 | begin 75 | new(itm^.Next); // create a new working node 76 | itm := itm^.Next; 77 | itm^.Next := nil; 78 | end; 79 | itm^.Name := S; 80 | itm^.Value := V; 81 | end; 82 | 83 | constructor TAssociativeArray.Create; 84 | begin 85 | ffirst := nil; 86 | end; 87 | 88 | destructor TAssociativeArray.Destroy; 89 | var 90 | itm : PAssocArrayItem; 91 | begin 92 | while assigned(ffirst) do 93 | begin 94 | itm := ffirst; 95 | ffirst := ffirst^.Next; 96 | Freemem(itm); 97 | end; 98 | inherited Destroy; 99 | end; 100 | 101 | end. 102 | 103 | -------------------------------------------------------------------------------- /demos/pLuaRecords/RecTest.pas: -------------------------------------------------------------------------------- 1 | unit RecTest; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, pLuaRecord, lua, plua; 7 | 8 | type 9 | PMyRecord = ^TMyRecord; 10 | TMyRecord = record 11 | AString : String; 12 | Int : Integer; 13 | Num : Double; 14 | end; 15 | 16 | procedure RegisterMyRecordType( L : Plua_State ); 17 | procedure RegisterExistingMyRecord( L : Plua_State; InstanceName : String; RecordPointer : Pointer); 18 | 19 | var 20 | MyRecordInfo : TLuaRecordInfo; 21 | 22 | implementation 23 | 24 | function getAString(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 25 | begin 26 | lua_pushstring(L, PMyRecord(RecordPointer)^.AString); 27 | result := 1; 28 | end; 29 | 30 | function setAString(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 31 | begin 32 | PMyRecord(RecordPointer)^.AString := lua_tostring(l, paramidxstart); 33 | result := 0; 34 | end; 35 | 36 | function getInt(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 37 | begin 38 | lua_pushinteger(L, PMyRecord(RecordPointer)^.Int); 39 | result := 1; 40 | end; 41 | 42 | function setInt(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 43 | begin 44 | PMyRecord(RecordPointer)^.Int := lua_tointeger(l, paramidxstart); 45 | result := 0; 46 | end; 47 | 48 | function getnumber(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : integer; 49 | begin 50 | lua_pushnumber(L, PMyRecord(RecordPointer)^.Num); 51 | result := 1; 52 | end; 53 | 54 | function setnumber(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : integer; 55 | begin 56 | PMyRecord(RecordPointer)^.Num := lua_tonumber(l, paramidxstart); 57 | result := 0; 58 | end; 59 | 60 | function newMyRecord(l : Plua_State; paramidxstart, paramcount : integer; InstanceInfo : PLuaRecordInstanceInfo) : Pointer; 61 | var 62 | r : PMyRecord; 63 | begin 64 | new(r); 65 | result := r; 66 | end; 67 | 68 | procedure disposeMyRecord( RecordPointer : pointer; l : Plua_State ); 69 | begin 70 | Freemem(PMyRecord(RecordPointer)); 71 | end; 72 | 73 | function MyProcInfo : TLuaRecordInfo; 74 | begin 75 | plua_initRecordInfo(Result); 76 | result.RecordName := 'MyRecord'; 77 | result.New := @newMyRecord; 78 | result.Release := @disposeMyRecord; 79 | plua_AddRecordProperty(result, 'AString', @getAString, @setAString); 80 | plua_AddRecordProperty(result, 'Int', @getInt, @setInt); 81 | plua_AddRecordProperty(result, 'Num', @getnumber, @setnumber); 82 | end; 83 | 84 | procedure RegisterMyRecordType(L: Plua_State); 85 | begin 86 | plua_registerRecordType(l, MyRecordInfo); 87 | end; 88 | 89 | procedure RegisterExistingMyRecord(L: Plua_State; InstanceName: String; 90 | RecordPointer: Pointer); 91 | begin 92 | plua_registerExistingRecord(L, InstanceName, RecordPointer, @MyRecordInfo); 93 | end; 94 | 95 | initialization 96 | MyRecordInfo := MyProcInfo; 97 | 98 | finalization 99 | 100 | end. 101 | 102 | -------------------------------------------------------------------------------- /src/pLuaExceptWrapper.pas: -------------------------------------------------------------------------------- 1 | unit pLuaExceptWrapper; 2 | // TODO: Unfinished 3 | // Exception handling code by MageSlayer, worked as an include file 4 | // For better code maintainability, Need to have a way to work as unit and not 5 | // as include 6 | 7 | {$IFDEF FPC} 8 | {$mode objfpc}{$H+} 9 | {$ENDIF} 10 | 11 | {$I Lua.inc} 12 | 13 | {$IFDEF LUAJIT} 14 | //Currently only x64 exception natively by LuaJit itself 15 | //other platform need try/except on Pascal->Lua boundary 16 | {$IFDEF CPU64} 17 | {$DEFINE LUAJIT_EXCEPTION_SUPPORT} 18 | {$ENDIF} 19 | {$IFDEF CPUX64} 20 | {$DEFINE LUAJIT_EXCEPTION_SUPPORT} 21 | {$ENDIF} 22 | {$ENDIF} 23 | 24 | interface 25 | 26 | uses 27 | Lua; 28 | 29 | {$IFDEF LUAJIT_EXCEPTION_SUPPORT} 30 | function plua_call_except_wrapper(l : PLua_State) : integer; 31 | {$ELSE} 32 | function plua_call_except_wrapper(l : PLua_State; out exc_message:pchar; out exception_caught:boolean) : integer; 33 | {$ENDIF} 34 | 35 | implementation 36 | // Warning!!! 37 | // Expects pLuaExceptActual to point to the actual handler 38 | 39 | {$IFDEF LUAJIT_EXCEPTION_SUPPORT} 40 | function plua_call_except_wrapper(l : PLua_State) : integer; 41 | begin 42 | Result:=pLuaExceptActual(l); 43 | end; 44 | 45 | function plua_call_method(l : PLua_State) : integer; extdecl; 46 | begin 47 | try 48 | Result:=plua_call_except_wrapper(l); 49 | except 50 | Result:=0; 51 | plua_ClearStack(l); //remove both parameters and any non-complete return values. 52 | 53 | raise; 54 | end; 55 | end; 56 | {$ENDIF} 57 | 58 | {$IFNDEF LUAJIT_EXCEPTION_SUPPORT} 59 | function plua_call_except_wrapper(l : PLua_State; out exc_message:pchar; out exception_caught:boolean) : integer; 60 | begin 61 | exc_message:=nil; 62 | exception_caught:=False; 63 | 64 | try 65 | Result:=pLuaExceptActual(l); 66 | except 67 | on E:Exception do 68 | begin 69 | exception_caught:=True; 70 | exc_message:=StrToPChar(E.Message); 71 | end; 72 | end; 73 | end; 74 | 75 | {$IMPLICITEXCEPTIONS OFF} 76 | function plua_call_method(l : PLua_State) : integer; extdecl; 77 | var 78 | exc_message:PChar; 79 | exception_caught:boolean; 80 | begin 81 | { 82 | Using lua_error in functions having automatically-generated "finally" code causes access violations in 32-bit programs. 83 | So all exceptions are caught in plua_call_class_method_except_wrapper function and 84 | returned as a simple PChar strings to avoid any automatic release. 85 | This function forcibly lacks "finally" code - {$IMPLICITEXCEPTIONS OFF} 86 | } 87 | Result:=plua_call_except_wrapper(l, exc_message, exception_caught); 88 | 89 | if exception_caught then 90 | begin 91 | Result:=0; 92 | plua_ClearStack(l); //remove both parameters and any non-complete return values. 93 | 94 | if exc_message = nil then 95 | lua_pushstring(L, 'Unknown exception from native code') 96 | else 97 | begin 98 | lua_pushstring(L, exc_message); 99 | StrDispose(exc_message); 100 | end; 101 | 102 | lua_error(L); //does longjmp, almost the same as exception raising 103 | end; 104 | end; 105 | {$IMPLICITEXCEPTIONS ON} 106 | {$ENDIF} 107 | 108 | end. -------------------------------------------------------------------------------- /demos/LuaObjects/LuaButton.pas: -------------------------------------------------------------------------------- 1 | unit LuaButton; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, lua, LuaObject, Buttons, StdCtrls; 7 | 8 | type 9 | { TLuaButton } 10 | TLuaButton = class(TLuaObject) 11 | private 12 | procedure ButtonClickEvent(Sender: TObject); 13 | public 14 | btn : TButton; 15 | procedure CommonCreate(LuaState : PLua_State; AParent : TLuaObject = nil); override; 16 | function GetPropValue(propName : String): Variant; override; 17 | function SetPropValue(PropName : String; const AValue: Variant) : Boolean; override; 18 | destructor Destroy; override; 19 | procedure Click; 20 | end; 21 | 22 | procedure RegisterLuaButton(L : Plua_State); 23 | 24 | implementation 25 | 26 | uses 27 | MainForm; 28 | 29 | function Button_Click(l : PLua_State) : Integer; cdecl; 30 | var 31 | btn : TLuaButton; 32 | begin 33 | result := 0; 34 | if (lua_gettop(l) < 1) then 35 | exit; 36 | btn := TLuaButton(LuaToTLuaObject(l, 1)); 37 | btn.Click; 38 | end; 39 | 40 | function Button_new(L : PLua_State; AParent : TLuaObject=nil):TLuaObject; 41 | begin 42 | result := TLuaButton.Create(L, AParent); 43 | end; 44 | 45 | function new_Button(L : PLua_State) : Integer; cdecl; 46 | var 47 | p : TLuaObjectNewCallback; 48 | begin 49 | p := @Button_new; 50 | result := new_LuaObject(L, 'TButton', p); 51 | end; 52 | 53 | procedure methods_Button(L : Plua_State; classTable : Integer); 54 | begin 55 | RegisterMethod(L, 'Click', @Button_Click, classTable); 56 | end; 57 | 58 | procedure RegisterLuaButton(L: Plua_State); 59 | begin 60 | RegisterTLuaObject(L, 'TButton', @new_Button, @methods_Button); 61 | end; 62 | 63 | { TLuaButton } 64 | 65 | procedure TLuaButton.CommonCreate(LuaState: PLua_State; AParent: TLuaObject); 66 | begin 67 | inherited CommonCreate(LuaState, AParent); 68 | btn := TButton.Create(frmMain); 69 | btn.OnClick := ButtonClickEvent; 70 | btn.Parent := frmMain; 71 | end; 72 | 73 | procedure TLuaButton.ButtonClickEvent(Sender: TObject); 74 | begin 75 | CallEvent('OnClick'); 76 | end; 77 | 78 | function TLuaButton.GetPropValue(propName: String): Variant; 79 | begin 80 | if CompareText(propName, 'Caption') = 0 then 81 | result := btn.Caption 82 | else if CompareText(propName, 'Width') = 0 then 83 | result := btn.Width 84 | else if CompareText(propName, 'Height') = 0 then 85 | result := btn.Height 86 | else if CompareText(propName, 'Left') = 0 then 87 | result := btn.Left 88 | else if CompareText(propName, 'Top') = 0 then 89 | result := btn.Top 90 | else if CompareText(propName, 'Visible') = 0 then 91 | result := btn.Visible 92 | else if CompareText(propName, 'Enabled') = 0 then 93 | result := btn.Enabled 94 | else 95 | Result:=inherited GetPropValue(propName); 96 | end; 97 | 98 | function TLuaButton.SetPropValue(PropName: String; const AValue: Variant 99 | ): Boolean; 100 | begin 101 | result := true; 102 | if CompareText(propName, 'Caption') = 0 then 103 | btn.Caption := AValue 104 | else if CompareText(propName, 'Width') = 0 then 105 | btn.Width := AValue 106 | else if CompareText(propName, 'Height') = 0 then 107 | btn.Height := AValue 108 | else if CompareText(propName, 'Left') = 0 then 109 | btn.Left := AValue 110 | else if CompareText(propName, 'Top') = 0 then 111 | btn.Top := AValue 112 | else if CompareText(propName, 'Visible') = 0 then 113 | btn.Visible := AValue 114 | else if CompareText(propName, 'Enabled') = 0 then 115 | btn.Enabled := AValue 116 | else 117 | Result:=inherited SetPropValue(propName, AValue); 118 | end; 119 | 120 | destructor TLuaButton.Destroy; 121 | begin 122 | inherited Destroy; 123 | end; 124 | 125 | procedure TLuaButton.Click; 126 | begin 127 | btn.Click; 128 | end; 129 | 130 | end. 131 | 132 | -------------------------------------------------------------------------------- /src/LuaJIT.pas: -------------------------------------------------------------------------------- 1 | unit LuaJIT; 2 | { 3 | Lua JIT Extensions 4 | Modifications copyright (c) 2009-2017 Denis Golovan 5 | 6 | License: same as Lua 5.1 (license at the end of this file). 7 | } 8 | 9 | {$IFDEF FPC} 10 | {$mode objfpc}{$H+} 11 | {$ENDIF} 12 | 13 | interface 14 | 15 | {$I Lua.inc} 16 | 17 | uses 18 | Lua; 19 | 20 | {$IFDEF LUAJIT} 21 | // internal LuaJIT types/structs 22 | const 23 | LuaJIT_CTID_CTYPEID = 21; // see CTTYDEF in lj_ctypes.h 24 | LuaJIT_CTID_INVALID = $ffffffff; 25 | 26 | LuaJIT_CTYPEDID_INT64 = 11; // ctype for int64 27 | type 28 | LuaJIT_CTypeID = UInt32; 29 | PLuaJIT_CTypeID = ^LuaJIT_CTypeID; 30 | 31 | LuaJIT_CTypeID1 = UInt16; 32 | PLuaJIT_CTypeID1 = ^LuaJIT_CTypeID1; 33 | 34 | {$IFDEF FPC} 35 | {$push} 36 | {$packrecords C} // TODO: Delphi support 37 | {$ENDIF} 38 | LuaJIT_GCRef = record // see GCRef in lj_obj.h 39 | {$IFDEF LUAJIT_GC64} 40 | gcptr64: UInt64; // True 64 bit pointer. 41 | {$ELSE} 42 | gcptr32: UInt32; // Pseudo 32 bit pointer. 43 | {$ENDIF} 44 | end; 45 | 46 | LuaJIT_GCcdata = record // see GCcdata in lj_obj.h 47 | // record requires C packing!!! 48 | 49 | // gcheader : LuaJIT_GCHeader; // see GCHeader macro in lj_obj.h 50 | nextgc:LuaJIT_GCRef; 51 | marked:UInt8; 52 | gct:UInt8; 53 | // gcheader : LuaJIT_GCHeader; 54 | 55 | ctypeid : LuaJIT_CTypeID1; 56 | end; 57 | PLuaJIT_GCcdata = ^LuaJIT_GCcdata; 58 | 59 | {$IFDEF LUAJIT_GC64} 60 | {$IF sizeof(LuaJIT_GCcdata) <> 16} 61 | {$Fatal LuaJIT_GCcdata size invalid} 62 | {$ENDIF} 63 | {$ELSE} 64 | {$IF sizeof(LuaJIT_GCcdata) <> 8} 65 | {$Fatal LuaJIT_GCcdata size invalid} 66 | {$ENDIF} 67 | {$ENDIF} 68 | 69 | {$IFDEF FPC} 70 | {$pop} // restore packrecords setting 71 | {$ENDIF} 72 | {$ENDIF} 73 | 74 | {$IFDEF LUAJIT} 75 | // see LuaJIT_CTYPEDID_* constants for ctypeid standard types 76 | function luajit_tocdata(L : Plua_State; idx : Integer; out ctypeid : LuaJIT_CTypeID) : Pointer; 77 | function luajit_getctypeid(L : Plua_State; typename : PAnsiChar; out ctypeid : LuaJIT_CTypeID):boolean; 78 | {$ENDIF} 79 | 80 | {$IFDEF LUAJIT_DUMPX} 81 | function lua_dumpx(L : Plua_State; idx : Integer; writer : lua_Writer; data: Pointer; strip: Integer) : Integer; 82 | cdecl; external LuaDLL; 83 | {$ENDIF} 84 | 85 | implementation 86 | 87 | {$IFDEF LUAJIT} 88 | function luajit_tocdata(L : Plua_State; idx : Integer; out ctypeid : LuaJIT_CTypeID) : Pointer; 89 | var T:Integer; 90 | p : Pointer; 91 | cd : PLuaJIT_GCcdata; 92 | begin 93 | Result := nil; 94 | ctypeid:= LuaJIT_CTID_INVALID; 95 | 96 | T:=lua_type(l, idx); 97 | if T <> LUA_TCDATA then 98 | Exit; 99 | 100 | p := lua_topointer(l, idx); 101 | if p = nil then 102 | Exit; 103 | 104 | cd := PLuaJIT_GCcdata( PByte(p) - sizeof(LuaJIT_GCcdata) ); 105 | ctypeid:=cd^.ctypeid; 106 | 107 | Result := p; 108 | end; 109 | 110 | function luajit_getctypeid(L : Plua_State; typename : PAnsiChar; out ctypeid : LuaJIT_CTypeID):boolean; 111 | var idx : Integer; 112 | p : Pointer; 113 | typeof_success : boolean; 114 | begin 115 | Result := false; 116 | ctypeid := LuaJIT_CTID_INVALID; 117 | 118 | idx := lua_gettop(L); 119 | try 120 | // Get ref to ffi.typeof 121 | luaL_loadstring(L, 'return require("ffi").typeof'); 122 | 123 | // lua_call must be wrapped by try .. except 124 | typeof_success := false; 125 | try 126 | lua_call(L, 0, 1); 127 | if not lua_isfunction(L, -1) then 128 | Exit; 129 | // Push the first argument to ffi.typeof 130 | lua_pushstring(L, typename); 131 | // Call ffi.typeof() 132 | lua_call(L, 1, 1); 133 | typeof_success := true; 134 | except 135 | end; 136 | if not typeof_success then 137 | Exit; 138 | 139 | // Returned type should be LUA_TCDATA with CTID_CTYPEID 140 | p:=luajit_tocdata(L, -1, ctypeid); 141 | if (p = nil) or (ctypeid <> LuaJIT_CTID_CTYPEID) then 142 | Exit; 143 | 144 | ctypeid := PLuaJIT_CTypeID(p)^; 145 | Result := True; 146 | finally 147 | // balance Lua stack 148 | lua_settop(L, idx); 149 | end; 150 | end; 151 | {$ENDIF} 152 | 153 | end. -------------------------------------------------------------------------------- /demos/pLuaObjects/LuaButton.pas: -------------------------------------------------------------------------------- 1 | unit LuaButton; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, lua, pLuaObject, plua, Buttons, StdCtrls; 7 | 8 | procedure RegisterLuaButton(L : Plua_State); 9 | 10 | implementation 11 | 12 | uses 13 | MainForm; 14 | 15 | type 16 | 17 | { TButtonDelegate } 18 | 19 | TButtonDelegate = class(TLuaObjectEventDelegate) 20 | public 21 | constructor Create(InstanceInfo : PLuaInstanceInfo; obj : TObject); override; 22 | 23 | procedure ClickHandler(Sender : TObject); 24 | end; 25 | 26 | { TButtonDelegate } 27 | 28 | constructor TButtonDelegate.Create(InstanceInfo: PLuaInstanceInfo; obj : TObject); 29 | begin 30 | inherited Create(InstanceInfo, obj); 31 | TButton(obj).OnClick := ClickHandler; 32 | end; 33 | 34 | procedure TButtonDelegate.ClickHandler(Sender: TObject); 35 | begin 36 | CallEvent('OnClick'); 37 | end; 38 | 39 | var 40 | ButtonInfo : TLuaClassInfo; 41 | 42 | function newButton(l : PLua_State; paramidxstart, paramcount : Integer; InstanceInfo : PLuaInstanceInfo) : TObject; 43 | begin 44 | result := TButton.Create(frmMain); 45 | TButton(Result).Parent := frmMain; 46 | TButton(Result).Visible := true; 47 | TButtonDelegate.Create(InstanceInfo, result); 48 | end; 49 | 50 | 51 | function GetCaption(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 52 | var 53 | btn : TButton; 54 | begin 55 | btn := TButton(target); 56 | lua_pushstring(l, btn.Caption); 57 | result := 1; 58 | end; 59 | 60 | function SetCaption(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 61 | var 62 | btn : TButton; 63 | begin 64 | btn := TButton(target); 65 | btn.Caption := lua_tostring(l, paramidxstart); 66 | result := 0; 67 | end; 68 | 69 | function GetLeft(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 70 | var 71 | btn : TButton; 72 | begin 73 | btn := TButton(target); 74 | lua_pushinteger(l, btn.Left); 75 | result := 1; 76 | end; 77 | 78 | function SetLeft(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 79 | var 80 | btn : TButton; 81 | begin 82 | btn := TButton(target); 83 | btn.Left := lua_tointeger(l, paramidxstart); 84 | result := 0; 85 | end; 86 | 87 | function GetTop(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 88 | var 89 | btn : TButton; 90 | begin 91 | btn := TButton(target); 92 | lua_pushinteger(l, btn.Top); 93 | result := 1; 94 | end; 95 | 96 | function SetTop(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 97 | var 98 | btn : TButton; 99 | begin 100 | btn := TButton(target); 101 | btn.Top := lua_tointeger(l, paramidxstart); 102 | result := 0; 103 | end; 104 | 105 | function Click(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 106 | var 107 | btn : TButton; 108 | begin 109 | result := 0; 110 | btn := TButton(target); 111 | plua_CallObjectEvent(plua_GetObjectInfo(l, btn), 'OnClick', []); 112 | end; 113 | 114 | function GetHeight(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 115 | var 116 | btn : TButton; 117 | begin 118 | btn := TButton(target); 119 | lua_pushinteger(l, btn.Height); 120 | result := 1; 121 | end; 122 | 123 | function SetHeight(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 124 | var 125 | btn : TButton; 126 | begin 127 | btn := TButton(target); 128 | btn.Height := lua_tointeger(l, paramidxstart); 129 | result := 0; 130 | end; 131 | 132 | function GetWidth(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 133 | var 134 | btn : TButton; 135 | begin 136 | btn := TButton(target); 137 | lua_pushinteger(l, btn.Width); 138 | result := 1; 139 | end; 140 | 141 | function SetWidth(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 142 | var 143 | btn : TButton; 144 | begin 145 | btn := TButton(target); 146 | btn.Width := lua_tointeger(l, paramidxstart); 147 | result := 0; 148 | end; 149 | 150 | function GetVisible(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 151 | var 152 | btn : TButton; 153 | begin 154 | btn := TButton(target); 155 | lua_pushboolean(l, btn.Visible); 156 | result := 1; 157 | end; 158 | 159 | function SetVisible(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 160 | var 161 | btn : TButton; 162 | begin 163 | btn := TButton(target); 164 | btn.Visible := lua_toboolean(l, paramidxstart); 165 | result := 0; 166 | end; 167 | 168 | function GetEnabled(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 169 | var 170 | btn : TButton; 171 | begin 172 | btn := TButton(target); 173 | lua_pushboolean(l, btn.Enabled); 174 | result := 1; 175 | end; 176 | 177 | function SetEnabled(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 178 | var 179 | btn : TButton; 180 | begin 181 | btn := TButton(target); 182 | btn.Enabled := lua_toboolean(l, paramidxstart); 183 | result := 0; 184 | end; 185 | 186 | procedure RegisterLuaButton(L: Plua_State); 187 | begin 188 | plua_registerclass(L, ButtonInfo); 189 | end; 190 | 191 | function setButtonInfo : TLuaClassInfo; 192 | begin 193 | plua_initClassInfo(result); 194 | result.ClassName := 'TButton'; 195 | result.New := @newButton; 196 | plua_AddClassProperty(result, 'Caption', @GetCaption, @SetCaption); 197 | plua_AddClassProperty(result, 'Left', @GetLeft, @SetLeft); 198 | plua_AddClassProperty(result, 'Top', @GetTop, @SetTop); 199 | plua_AddClassProperty(result, 'Width', @GetWidth, @SetWidth); 200 | plua_AddClassProperty(result, 'Height', @GetHeight, @SetHeight); 201 | plua_AddClassProperty(result, 'Visible', @GetVisible, @SetVisible); 202 | plua_AddClassProperty(result, 'Enabled', @GetEnabled, @SetEnabled); 203 | plua_AddClassMethod(result, 'Click', @Click); 204 | end; 205 | 206 | initialization 207 | ButtonInfo := setButtonInfo; 208 | 209 | finalization 210 | 211 | end. 212 | 213 | -------------------------------------------------------------------------------- /demos/pLuaObjects2/LuaButton.pas: -------------------------------------------------------------------------------- 1 | unit LuaButton; 2 | 3 | interface 4 | 5 | uses 6 | Classes, SysUtils, lua, pLuaObject, plua, Buttons, StdCtrls; 7 | 8 | procedure RegisterLuaButton(L : Plua_State); 9 | procedure RegisterExistingButton(L : Plua_State; InstanceName : String; Instance : TButton); 10 | 11 | implementation 12 | 13 | uses 14 | MainForm; 15 | 16 | type 17 | 18 | { TButtonDelegate } 19 | 20 | TButtonDelegate = class(TLuaObjectEventDelegate) 21 | public 22 | constructor Create(InstanceInfo : PLuaInstanceInfo; obj : TObject); override; 23 | destructor Destroy; override; 24 | 25 | procedure ClickHandler(Sender : TObject); 26 | end; 27 | 28 | { TButtonDelegate } 29 | 30 | constructor TButtonDelegate.Create(InstanceInfo: PLuaInstanceInfo; obj : TObject); 31 | begin 32 | inherited Create(InstanceInfo, obj); 33 | TButton(obj).OnClick := ClickHandler; 34 | end; 35 | 36 | destructor TButtonDelegate.Destroy; 37 | begin 38 | TButton(fobj).OnClick := nil; 39 | inherited Destroy; 40 | end; 41 | 42 | procedure TButtonDelegate.ClickHandler(Sender: TObject); 43 | begin 44 | CallEvent('OnClick'); 45 | end; 46 | 47 | var 48 | ButtonInfo : TLuaClassInfo; 49 | 50 | function newButton(l : PLua_State; paramidxstart, paramcount : Integer; InstanceInfo : PLuaInstanceInfo) : TObject; 51 | begin 52 | result := TButton.Create(frmMain); 53 | TButton(Result).Parent := frmMain; 54 | TButton(Result).Visible := true; 55 | TButtonDelegate.Create(InstanceInfo, result); 56 | end; 57 | 58 | 59 | function GetCaption(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 60 | var 61 | btn : TButton; 62 | begin 63 | btn := TButton(target); 64 | lua_pushstring(l, btn.Caption); 65 | result := 1; 66 | end; 67 | 68 | function SetCaption(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 69 | var 70 | btn : TButton; 71 | begin 72 | btn := TButton(target); 73 | btn.Caption := lua_tostring(l, paramidxstart); 74 | result := 0; 75 | end; 76 | 77 | function GetLeft(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 78 | var 79 | btn : TButton; 80 | begin 81 | btn := TButton(target); 82 | lua_pushinteger(l, btn.Left); 83 | result := 1; 84 | end; 85 | 86 | function SetLeft(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 87 | var 88 | btn : TButton; 89 | begin 90 | btn := TButton(target); 91 | btn.Left := lua_tointeger(l, paramidxstart); 92 | result := 0; 93 | end; 94 | 95 | function GetTop(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 96 | var 97 | btn : TButton; 98 | begin 99 | btn := TButton(target); 100 | lua_pushinteger(l, btn.Top); 101 | result := 1; 102 | end; 103 | 104 | function SetTop(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 105 | var 106 | btn : TButton; 107 | begin 108 | btn := TButton(target); 109 | btn.Top := lua_tointeger(l, paramidxstart); 110 | result := 0; 111 | end; 112 | 113 | function Click(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 114 | var 115 | btn : TButton; 116 | begin 117 | result := 0; 118 | btn := TButton(target); 119 | plua_CallObjectEvent(plua_GetObjectInfo(l, btn), 'OnClick', []); 120 | end; 121 | 122 | function GetHeight(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 123 | var 124 | btn : TButton; 125 | begin 126 | btn := TButton(target); 127 | lua_pushinteger(l, btn.Height); 128 | result := 1; 129 | end; 130 | 131 | function SetHeight(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 132 | var 133 | btn : TButton; 134 | begin 135 | btn := TButton(target); 136 | btn.Height := lua_tointeger(l, paramidxstart); 137 | result := 0; 138 | end; 139 | 140 | function GetWidth(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 141 | var 142 | btn : TButton; 143 | begin 144 | btn := TButton(target); 145 | lua_pushinteger(l, btn.Width); 146 | result := 1; 147 | end; 148 | 149 | function SetWidth(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 150 | var 151 | btn : TButton; 152 | begin 153 | btn := TButton(target); 154 | btn.Width := lua_tointeger(l, paramidxstart); 155 | result := 0; 156 | end; 157 | 158 | function GetVisible(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 159 | var 160 | btn : TButton; 161 | begin 162 | btn := TButton(target); 163 | lua_pushboolean(l, btn.Visible); 164 | result := 1; 165 | end; 166 | 167 | function SetVisible(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 168 | var 169 | btn : TButton; 170 | begin 171 | btn := TButton(target); 172 | btn.Visible := lua_toboolean(l, paramidxstart); 173 | result := 0; 174 | end; 175 | 176 | function GetEnabled(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 177 | var 178 | btn : TButton; 179 | begin 180 | btn := TButton(target); 181 | lua_pushboolean(l, btn.Enabled); 182 | result := 1; 183 | end; 184 | 185 | function SetEnabled(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 186 | var 187 | btn : TButton; 188 | begin 189 | btn := TButton(target); 190 | btn.Enabled := lua_toboolean(l, paramidxstart); 191 | result := 0; 192 | end; 193 | 194 | procedure RegisterLuaButton(L: Plua_State); 195 | begin 196 | plua_registerclass(L, ButtonInfo); 197 | end; 198 | 199 | procedure RegisterExistingButton(L: Plua_State; InstanceName : String; Instance: TButton); 200 | begin 201 | TButtonDelegate.Create(plua_registerExisting(L, InstanceName, Instance, @ButtonInfo), Instance); 202 | end; 203 | 204 | function setButtonInfo : TLuaClassInfo; 205 | begin 206 | plua_initClassInfo(result); 207 | result.ClassName := 'TButton'; 208 | result.New := @newButton; 209 | plua_AddClassProperty(result, 'Caption', @GetCaption, @SetCaption); 210 | plua_AddClassProperty(result, 'Left', @GetLeft, @SetLeft); 211 | plua_AddClassProperty(result, 'Top', @GetTop, @SetTop); 212 | plua_AddClassProperty(result, 'Width', @GetWidth, @SetWidth); 213 | plua_AddClassProperty(result, 'Height', @GetHeight, @SetHeight); 214 | plua_AddClassProperty(result, 'Visible', @GetVisible, @SetVisible); 215 | plua_AddClassProperty(result, 'Enabled', @GetEnabled, @SetEnabled); 216 | plua_AddClassMethod(result, 'Click', @Click); 217 | end; 218 | 219 | initialization 220 | ButtonInfo := setButtonInfo; 221 | 222 | finalization 223 | 224 | end. 225 | 226 | -------------------------------------------------------------------------------- /src/pLuaTable.pas: -------------------------------------------------------------------------------- 1 | { 2 | Useful functions for getting/setting the value of Lua table fields 3 | 4 | Copyright (c) 2003-2020 Felipe Daragon 5 | License: MIT (http://opensource.org/licenses/mit-license.php) 6 | } 7 | 8 | unit pLuaTable; 9 | 10 | interface 11 | 12 | {$I Lua.inc} 13 | 14 | uses 15 | Classes, Lua, pLua; 16 | 17 | type 18 | TLuaTable = class 19 | private 20 | fLuaState: PLua_State; 21 | fTableIndex: integer; 22 | public 23 | function ReadString(FieldName: string; ADefaultValue: string = ''): string; 24 | function ReadInteger(FieldName: string; ADefaultValue: integer): integer; 25 | function ReadBool(FieldName: string; ADefaultValue: boolean): boolean; 26 | function ReadVariant(FieldName: string; ADefaultValue: Variant): Variant; 27 | procedure GetIndexFromTop; 28 | constructor Create(L: PLua_State; GetIdxFromTop: boolean = false); 29 | destructor Destroy; override; 30 | property TableIndex: integer read fTableIndex; 31 | end; 32 | 33 | // Gets the value of a table field 34 | function plua_GetFieldValueStr(L: PLua_State; idx: integer; FieldName: string; 35 | ADefaultValue: string = ''): string; 36 | function plua_GetFieldValueInt(L: PLua_State; idx: integer; FieldName: string; 37 | ADefaultValue: integer): integer; 38 | function plua_GetFieldValueBool(L: PLua_State; idx: integer; FieldName: string; 39 | ADefaultValue: boolean): boolean; 40 | function plua_GetFieldValueType(L: PLua_State; idx: integer; FieldName: string): 41 | integer; 42 | function plua_GetFieldValueVariant(L: PLua_State; idx: integer; 43 | FieldName: string; ADefaultValue: Variant): Variant; 44 | 45 | // Sets the value of a table field 46 | procedure plua_SetFieldValue(L: PLua_State; FieldName: string; 47 | AValue: string); overload; 48 | procedure plua_SetFieldValue(L: PLua_State; FieldName: string; 49 | AValue: integer); overload; 50 | procedure plua_SetFieldValue(L: PLua_State; FieldName: string; 51 | AValue: boolean); overload; 52 | procedure plua_SetFieldValue(L: PLua_State; FieldName: string; 53 | ATable: plual_reg); overload; 54 | procedure plua_SetFieldValueV(L: PLua_State; FieldName: string; 55 | AValue: Variant); 56 | 57 | // Sets a reader and writer C function as a table field 58 | procedure plua_SetFieldValueRW(L: PLua_State; Name: string; Reader: lua_CFunction; 59 | Writer: lua_CFunction; Tag:integer=0); 60 | // Sets a C function as a table field 61 | procedure plua_SetFieldValueCF(L: PLua_State; Name: string; 62 | Func: lua_CFunction; Tag:integer=0); 63 | // If tag is different than 0 than it is pushed as an upvalue of the function 64 | 65 | implementation 66 | 67 | procedure plua_SetFieldValue(L: PLua_State; FieldName: string; 68 | AValue: string); overload; 69 | begin 70 | lua_pushstring(L, AValue); 71 | lua_setfield(L, -2, FieldName); 72 | end; 73 | 74 | procedure plua_SetFieldValue(L: PLua_State; FieldName: string; 75 | AValue: integer); overload; 76 | begin 77 | plua_pushintnumber(L, AValue); 78 | lua_setfield(L, -2, FieldName); 79 | end; 80 | 81 | procedure plua_SetFieldValue(L: PLua_State; FieldName: string; 82 | AValue: boolean); overload; 83 | begin 84 | lua_pushboolean(L, AValue); 85 | lua_setfield(L, -2, FieldName); 86 | end; 87 | 88 | procedure plua_SetFieldValue(L: PLua_State; FieldName: string; 89 | ATable: plual_reg); overload; 90 | begin 91 | lua_newtable(L); 92 | lual_register(L, nil, ATable); 93 | lua_setfield(L, -2, FieldName); 94 | end; 95 | 96 | procedure plua_SetFieldValueV(L: PLua_State; FieldName: string; 97 | AValue: Variant); 98 | begin 99 | plua_pushvariant(L, AValue); 100 | lua_setfield(L, -2, FieldName); 101 | end; 102 | 103 | function plua_GetFieldValueStr(L: PLua_State; idx: integer; FieldName: string; 104 | ADefaultValue: string = ''): string; 105 | begin 106 | lua_pushstring(L, FieldName); 107 | lua_gettable(L, idx); 108 | if lua_isnil(L, -1) then 109 | Result := ADefaultValue 110 | else 111 | Result := lua_tostring(L, -1); 112 | end; 113 | 114 | function plua_GetFieldValueInt(L: PLua_State; idx: integer; FieldName: string; 115 | ADefaultValue: integer): integer; 116 | begin 117 | lua_pushstring(L, FieldName); 118 | lua_gettable(L, idx); 119 | if lua_isnil(L, -1) then 120 | Result := ADefaultValue 121 | else 122 | Result := lua_tointeger(L, -1); 123 | end; 124 | 125 | function plua_GetFieldValueBool(L: PLua_State; idx: integer; FieldName: string; 126 | ADefaultValue: boolean): boolean; 127 | begin 128 | lua_pushstring(L, FieldName); 129 | lua_gettable(L, idx); 130 | if lua_isnil(L, -1) then 131 | Result := ADefaultValue 132 | else 133 | Result := lua_toboolean(L, -1); 134 | end; 135 | 136 | function plua_GetFieldValueType(L: PLua_State; idx: integer; FieldName: string) 137 | : integer; 138 | begin 139 | lua_pushstring(L, FieldName); 140 | lua_gettable(L, idx); 141 | result := lua_type(L, -1); 142 | end; 143 | 144 | function plua_GetFieldValueVariant(L: PLua_State; idx: integer; 145 | FieldName: string; ADefaultValue: Variant): Variant; 146 | begin 147 | lua_pushstring(L, FieldName); 148 | lua_gettable(L, idx); 149 | if lua_isnil(L, -1) then 150 | Result := ADefaultValue 151 | else 152 | Result := plua_tovariant(L, -1); 153 | end; 154 | 155 | procedure plua_SetFieldValueCF(L: PLua_State; Name: string; 156 | Func: lua_CFunction; Tag:integer=0); 157 | begin 158 | if tag = 0 then 159 | lua_pushcfunction(L, Func) 160 | else begin 161 | lua_pushnumber(L, tag); 162 | lua_pushcclosure(L, func, 1); 163 | end; 164 | lua_setfield(L, -2, Name); 165 | end; 166 | 167 | procedure plua_SetFieldValueRW(L: PLua_State; Name: string; Reader: lua_CFunction; 168 | Writer: lua_CFunction; Tag:integer=0); 169 | var 170 | tidx, midx: integer; 171 | begin 172 | lua_newtable(L); 173 | tidx := lua_gettop(L); 174 | 175 | lua_newtable(L); 176 | midx := lua_gettop(L); 177 | 178 | lua_pushstring(L, '__index'); 179 | if Tag = 0 then 180 | lua_pushcfunction(L, Reader) else begin 181 | lua_pushnumber(L, tag); 182 | lua_pushcclosure(L, Reader, 1); 183 | end; 184 | lua_rawset(L, midx); 185 | lua_pushstring(L, '__newindex'); 186 | if Tag = 0 then 187 | lua_pushcfunction(L, Writer) else begin 188 | lua_pushnumber(L, tag); 189 | lua_pushcclosure(L, Writer, 1); 190 | end; 191 | lua_rawset(L, midx); 192 | lua_setmetatable(L, tidx); 193 | lua_setfield(L, -2, Name); 194 | end; 195 | 196 | { TLuaTable } 197 | 198 | function TLuaTable.ReadString(FieldName: string; 199 | ADefaultValue: string = ''): string; 200 | begin 201 | Result := plua_GetFieldValueStr(fLuaState, fTableIndex, FieldName, 202 | ADefaultValue); 203 | end; 204 | 205 | function TLuaTable.ReadInteger(FieldName: string; 206 | ADefaultValue: integer): integer; 207 | begin 208 | Result := plua_GetFieldValueInt(fLuaState, fTableIndex, FieldName, 209 | ADefaultValue); 210 | end; 211 | 212 | function TLuaTable.ReadBool(FieldName: string; ADefaultValue: boolean): boolean; 213 | begin 214 | Result := plua_GetFieldValueBool(fLuaState, fTableIndex, FieldName, 215 | ADefaultValue); 216 | end; 217 | 218 | function TLuaTable.ReadVariant(FieldName: string; 219 | ADefaultValue: Variant): Variant; 220 | begin 221 | Result := plua_GetFieldValueVariant(fLuaState, fTableIndex, FieldName, 222 | ADefaultValue); 223 | end; 224 | 225 | procedure TLuaTable.GetIndexFromTop; 226 | begin 227 | fTableIndex := lua_gettop(fLuaState); 228 | end; 229 | 230 | constructor TLuaTable.Create(L: PLua_State; GetIdxFromTop: boolean = false); 231 | begin 232 | fLuaState := L; 233 | if GetIdxFromTop then 234 | GetIndexFromTop; 235 | end; 236 | 237 | destructor TLuaTable.Destroy; 238 | begin 239 | inherited; 240 | end; 241 | 242 | end. 243 | -------------------------------------------------------------------------------- /src/uWordList.pas: -------------------------------------------------------------------------------- 1 | unit uWordList; 2 | 3 | { 4 | Copyright (c) 2007 Jeremy Darling 5 | Modifications copyright (c) 2010-2014 Felipe Daragon 6 | 7 | This unit contains a TWordList class that implements a basic DAWG 8 | (Directed Acyclic Word Graph). While this class was not created 9 | explicitly for use with pLua it provides a fast word searching ability 10 | that we really need within a scripting engine. One of the advantages 11 | of this implementation are that it allows for data to be attached to a 12 | word or a letter within a word. 13 | 14 | License: MIT (http://opensource.org/licenses/mit-license.php) 15 | } 16 | 17 | {$IFDEF FPC} 18 | {$mode objfpc}{$H+} 19 | {$ENDIF} 20 | 21 | interface 22 | 23 | {$I Lua.inc} 24 | 25 | uses 26 | Classes, SysUtils; 27 | 28 | type 29 | {$IFDEF UNICODE} 30 | lwCha_r = AnsiChar; 31 | {$ELSE} 32 | lwCha_r = Char; 33 | {$ENDIF} 34 | 35 | type 36 | PWordListSymbol = ^TWordListSymbol; 37 | PWordListSymbolArray=^TWordListSymbolArray; 38 | TWordListSymbolArray = Array of PWordListSymbol; 39 | TWordListReleaseWordData = procedure(DataPointer : Pointer) of object; 40 | TWordListSymbol = packed record 41 | c : lwCha_r; // What character is this? 42 | eow : boolean; // Is this the last character of a word? 43 | data : Pointer; // Anything 44 | below : TWordListSymbolArray; // Next characters in words. 45 | end; 46 | TLoadProgress = procedure(pos, count : Integer; loadingWord : AnsiString) of object; 47 | 48 | { TWordListInfo } 49 | 50 | TWordListInfo=class 51 | private 52 | fData : TWordListSymbol; 53 | fSize: Integer; 54 | function GetData: PWordListSymbol; 55 | procedure Sort(WhatNode : PWordListSymbol; Start : Integer = -1; Stop : Integer = -1); 56 | public 57 | constructor Create; 58 | destructor Destroy; override; 59 | function Add(WhatChar : lwCha_r; ParentNode : PWordListSymbol; IsEnd : Boolean) : PWordListSymbol; 60 | function Exists(WhatChar : lwCha_r; ParentNode : PWordListSymbol; out IsEnd : Boolean) : Boolean; overload; 61 | function Exists(WhatChar : lwCha_r; ParentNode : PWordListSymbol) : PWordListSymbol; overload; 62 | procedure Clear(OnReleaseWordData : TWordListReleaseWordData = nil); 63 | property Size : Integer read fSize; 64 | property Data : PWordListSymbol read GetData; 65 | end; 66 | 67 | { TWordList } 68 | 69 | TWordList = class 70 | private 71 | FLoadProgress: TLoadProgress; 72 | fDict : TWordListInfo; 73 | FOnReleaseWordData: TWordListReleaseWordData; 74 | function GetData: PWordListSymbol; 75 | function GetWordData(AWord: AnsiString): Pointer; 76 | function GetWordSymbol(AWord: AnsiString): PWordListSymbol; 77 | function InternalAddWord(WhatWord : AnsiString) : PWordListSymbol; 78 | procedure SetLoadProgress(const AValue: TLoadProgress); 79 | procedure DoLoadProgress(pos, count : Integer; loadingWord : AnsiString); 80 | procedure SetOnReleaseWordData(const AValue: TWordListReleaseWordData); 81 | procedure SetWordData(AWord: AnsiString; const AValue: Pointer); 82 | function WordValid(WhatWord : AnsiString) : Boolean; 83 | public 84 | constructor Create; 85 | destructor Destroy; override; 86 | 87 | procedure LoadFromStream(const aStream : TStream); 88 | procedure SaveToStream(const aStream : TStream); 89 | procedure LoadFromFile(const WhatFile : AnsiString); 90 | procedure SaveToFile(const WhatFile : AnsiString); 91 | 92 | procedure ListWordsFromLetters( WhatLetters : AnsiString; List : TStrings; MinCharacters : Integer = -1; 93 | MaxCharacters : Integer = -1 ); 94 | 95 | procedure ListWords(const AList : TStrings); 96 | 97 | procedure Clear; 98 | procedure FlushList; 99 | function AddWord(const WhatWord : AnsiString) : PWordListSymbol; 100 | function WordExists(const WhatWord : AnsiString; AllowPartial : Boolean = false) : Boolean; 101 | property LoadProgress: TLoadProgress read FLoadProgress write SetLoadProgress; 102 | property Data : PWordListSymbol read GetData; 103 | property WordData[AWord:AnsiString] : Pointer read GetWordData write SetWordData; 104 | property WordSymbol[AWord:AnsiString] : PWordListSymbol read GetWordSymbol; 105 | property OnReleaseWordData : TWordListReleaseWordData read FOnReleaseWordData write SetOnReleaseWordData; 106 | end; 107 | 108 | implementation 109 | 110 | const 111 | WordListBufferSize = 26; 112 | 113 | { TWordList } 114 | 115 | function TWordList.InternalAddWord(WhatWord : AnsiString) : PWordListSymbol; 116 | var 117 | n : PWordListSymbol; 118 | pc : PAnsiChar; 119 | begin 120 | pc := PAnsiChar(WhatWord+#0); 121 | n := fDict.Data; 122 | while pc^<>#0 do 123 | begin 124 | n := fDict.Add(pc^, n, (pc+1)^=#0); 125 | inc(pc); 126 | end; 127 | result := n; 128 | end; 129 | 130 | function TWordList.GetData: PWordListSymbol; 131 | begin 132 | result := fDict.Data; 133 | end; 134 | 135 | function TWordList.GetWordData(AWord: AnsiString): Pointer; 136 | var 137 | n : PWordListSymbol; 138 | pc : PAnsiChar; 139 | begin 140 | result := nil; 141 | n := fDict.Data; 142 | pc := PAnsiChar(AWord+#0); 143 | while (pc^<>#0) and assigned(n) do 144 | begin 145 | n := fDict.Exists(pc^, n); 146 | inc(pc); 147 | end; 148 | if assigned(n) then 149 | result := n^.data; 150 | end; 151 | 152 | function TWordList.GetWordSymbol(AWord: AnsiString): PWordListSymbol; 153 | var 154 | n : PWordListSymbol; 155 | pc : PAnsiChar; 156 | begin 157 | result := nil; 158 | n := fDict.Data; 159 | pc := PAnsiChar(AWord+#0); 160 | while (pc^<>#0) and assigned(n) do 161 | begin 162 | n := fDict.Exists(pc^, n); 163 | inc(pc); 164 | end; 165 | if assigned(n) then 166 | result := n; 167 | end; 168 | 169 | procedure TWordList.SetLoadProgress(const AValue: TLoadProgress); 170 | begin 171 | if (@FLoadProgress = @AValue) then exit; // FD: 16/05/2010, AValue to @AValue 172 | FLoadProgress:=AValue; 173 | end; 174 | 175 | procedure TWordList.DoLoadProgress(pos, count: Integer; loadingWord : AnsiString); 176 | begin 177 | if assigned(fLoadProgress) then 178 | fLoadProgress(pos, count, loadingWord); 179 | end; 180 | 181 | procedure TWordList.SetOnReleaseWordData(const AValue: TWordListReleaseWordData 182 | ); 183 | begin 184 | if @FOnReleaseWordData=@AValue then exit; // FD: 16/05/2010 185 | FOnReleaseWordData:=AValue; 186 | end; 187 | 188 | procedure TWordList.SetWordData(AWord: AnsiString; const AValue: Pointer); 189 | var 190 | n : PWordListSymbol; 191 | pc : PAnsiChar; 192 | begin 193 | n := fDict.Data; 194 | pc := PAnsiChar(AWord+#0); 195 | while (pc^<>#0) and assigned(n) do 196 | begin 197 | n := fDict.Exists(pc^, n); 198 | inc(pc); 199 | end; 200 | if assigned(n) then 201 | n^.data := AValue 202 | else 203 | InternalAddWord(AWord)^.data := AValue; 204 | end; 205 | 206 | function TWordList.WordValid(WhatWord: AnsiString): Boolean; 207 | var 208 | pc : PAnsiChar; 209 | begin 210 | result := false; 211 | if length(trim(string(WhatWord))) > 0 then 212 | begin 213 | result := true; 214 | pc := PAnsiChar(WhatWord+#0); 215 | while pc^<>#0 do 216 | begin 217 | if not(pc^ in ['a'..'z', 'A'..'Z']{, '0'..'9', '_', '-']}) then 218 | begin 219 | result := false; 220 | exit; 221 | end; 222 | inc(pc); 223 | end; 224 | end; 225 | end; 226 | 227 | constructor TWordList.Create; 228 | begin 229 | fDict := TWordListInfo.Create; 230 | end; 231 | 232 | destructor TWordList.Destroy; 233 | begin 234 | FlushList; 235 | fDict.Free; 236 | inherited Destroy; 237 | end; 238 | 239 | procedure TWordList.LoadFromStream(const aStream: TStream); 240 | var 241 | aPos : Integer; 242 | Word : AnsiString; 243 | c : lwCha_r; 244 | begin 245 | FlushList; 246 | aPos := aStream.Position; 247 | Word := ''; 248 | c := #0; 249 | while aStream.Position < aStream.Size do 250 | begin 251 | aStream.Read(c, sizeof(c)); 252 | case c of 253 | #13 : begin // end of word 254 | if (Word <> '') and WordValid(Word) then 255 | begin 256 | DoLoadProgress(aStream.Position-aPos, aStream.Size-aPos, Word); 257 | InternalAddWord(Word+#0); 258 | end; 259 | Word := ''; 260 | end; 261 | #0..#8, 262 | #10 : ; // eat it 263 | else 264 | Word := Word + UpCase(c); 265 | end; 266 | end; 267 | end; 268 | 269 | procedure TWordList.SaveToStream(const aStream: TStream); 270 | procedure GetWords(b : AnsiString; aNode : PWordListSymbol); 271 | var 272 | i : Integer; 273 | s : AnsiString; 274 | begin 275 | if aNode^.eow then 276 | begin 277 | s := b + #13#10; 278 | aStream.Write(s[1], length(s[1])); 279 | end; 280 | for i := 0 to length(aNode^.below)-1 do 281 | GetWords(b + aNode^.below[i]^.c, aNode^.below[i]); 282 | end; 283 | begin 284 | GetWords('', fDict.Data); 285 | raise Exception.Create('TWordList.SaveToStream not yet implemented!') 286 | end; 287 | 288 | procedure TWordList.LoadFromFile(const WhatFile: AnsiString); 289 | var 290 | fs : TFileStream; 291 | begin 292 | fs := TFileStream.Create(string(WhatFile), fmOpenRead); 293 | try 294 | LoadFromStream(fs); 295 | finally 296 | fs.Free; 297 | end; 298 | end; 299 | 300 | procedure TWordList.SaveToFile(const WhatFile: AnsiString); 301 | var 302 | fs : TFileStream; 303 | begin 304 | fs := TFileStream.Create(string(WhatFile), fmCreate); 305 | try 306 | SaveToStream(fs); 307 | finally 308 | fs.Free; 309 | end; 310 | end; 311 | 312 | procedure TWordList.ListWordsFromLetters(WhatLetters: AnsiString; List : TStrings; 313 | MinCharacters: Integer; MaxCharacters: Integer); 314 | var 315 | s : AnsiString; 316 | i, 317 | c : Integer; 318 | n : PWordListSymbol; 319 | procedure CheckAdd(WhatStr : AnsiString); 320 | var 321 | bAdd : Boolean; 322 | begin 323 | bAdd := true; 324 | if (MinCharacters > -1) then 325 | bAdd := length(WhatStr) >= MinCharacters; 326 | if (MaxCharacters > -1) then 327 | bAdd := bAdd and (length(WhatStr) <= MaxCharacters); 328 | if bAdd and (List.IndexOf(string(WhatStr))=-1) then 329 | List.Add(string(WhatStr)); 330 | end; 331 | procedure TestThis(Base, Letters : AnsiString; Node : PWordListSymbol); 332 | var 333 | j : Integer; 334 | tn : PWordListSymbol; 335 | ts : AnsiString; 336 | begin 337 | j := 1; 338 | while j <= Length(Letters) do 339 | begin 340 | tn := fDict.Exists(Letters[j], Node); 341 | if assigned(tn) then 342 | begin 343 | if tn^.eow then 344 | CheckAdd(base + letters[j]); 345 | ts := Letters; 346 | delete(ts, j, 1); 347 | TestThis(base + letters[j], ts, tn); 348 | end; 349 | inc(j); 350 | end; 351 | end; 352 | begin 353 | i := 1; 354 | c := Length(WhatLetters); 355 | while i <= c do 356 | begin 357 | n := fDict.Exists(WhatLetters[i], fDict.Data); 358 | if n <> nil then 359 | begin 360 | s := WhatLetters; 361 | delete(s, i, 1); 362 | if n^.eow then 363 | CheckAdd(WhatLetters[i]); 364 | TestThis(WhatLetters[i], s, n); 365 | end; 366 | inc(i); 367 | end; 368 | end; 369 | 370 | procedure TWordList.ListWords(const AList: TStrings); 371 | var 372 | ms : TMemoryStream; 373 | begin 374 | ms := TMemoryStream.Create; 375 | try 376 | SaveToStream(ms); 377 | AList.LoadFromStream(ms); 378 | finally 379 | ms.Free; 380 | end; 381 | end; 382 | 383 | procedure TWordList.Clear; 384 | begin 385 | FlushList; 386 | end; 387 | 388 | procedure TWordList.FlushList; 389 | begin 390 | fDict.Clear(FOnReleaseWordData); 391 | end; 392 | 393 | function TWordList.AddWord(const WhatWord: AnsiString) : PWordListSymbol; 394 | var 395 | aw : AnsiString; 396 | begin 397 | //result := nil; 398 | aw := ansistring(Trim(string(WhatWord)))+#0; 399 | {if not WordValid(aw) then 400 | exit; 401 | if not WordExists(aw) then} 402 | result := InternalAddWord(aw); 403 | end; 404 | 405 | function TWordList.WordExists(const WhatWord: AnsiString; AllowPartial : Boolean): Boolean; 406 | var 407 | n : PWordListSymbol; 408 | pc : PAnsiChar; 409 | begin 410 | n := fDict.Data; 411 | pc := PAnsiChar(WhatWord+#0); 412 | while (pc^<>#0) and assigned(n) do 413 | begin 414 | n := fDict.Exists(pc^, n); 415 | inc(pc); 416 | end; 417 | result := assigned(n) and (n^.eow or AllowPartial); 418 | end; 419 | 420 | { TWordListInfo } 421 | 422 | function TWordListInfo.GetData: PWordListSymbol; 423 | begin 424 | result := @fData; 425 | end; 426 | 427 | procedure TWordListInfo.Sort(WhatNode: PWordListSymbol; Start: Integer; 428 | Stop: Integer); 429 | procedure iSort(var r : TWordListSymbolArray; lo, up : integer ); 430 | var 431 | i, j : Integer; 432 | tempr: PWordListSymbol; 433 | begin 434 | while up>lo do 435 | begin 436 | i := lo; 437 | j := up; 438 | tempr := r[lo]; 439 | {*** Split file in two ***} 440 | while i tempr^.c do 443 | j := j-1; r[i] := r[j]; 444 | while (i 1 do 521 | begin 522 | j := (l+f) div 2; 523 | c := ParentNode^.below[j]^.c; 524 | if WhatChar <= c then 525 | l := j 526 | else 527 | f := j; 528 | end; 529 | c := ParentNode^.below[l]^.c; 530 | if c = WhatChar then 531 | result := ParentNode^.below[l] 532 | else if (l <> f) and (f>=0) then 533 | begin 534 | c := ParentNode^.below[f]^.c; 535 | if c = WhatChar then 536 | result := ParentNode^.below[f] 537 | end; 538 | end; 539 | 540 | procedure TWordListInfo.Clear(OnReleaseWordData : TWordListReleaseWordData = nil); 541 | var 542 | i : Integer; 543 | procedure ClearNode(WhatNode : PWordListSymbol); 544 | var 545 | c : Integer; 546 | begin 547 | if assigned(OnReleaseWordData) and WhatNode^.eow and assigned(WhatNode^.data) then 548 | OnReleaseWordData(WhatNode^.data); 549 | for c := length(WhatNode^.below)-1 downto 0 do 550 | ClearNode(WhatNode^.below[c]); 551 | SetLength(WhatNode^.below, 0); 552 | Freemem(WhatNode); 553 | end; 554 | begin 555 | if Length(fData.below) = 0 then 556 | exit; 557 | for i := 0 to Length(fData.below)-1 do 558 | ClearNode(fData.below[i]); 559 | SetLength(fData.below, 0); 560 | end; 561 | 562 | end. 563 | 564 | -------------------------------------------------------------------------------- /src/LuaObject.pas: -------------------------------------------------------------------------------- 1 | unit LuaObject; 2 | 3 | { 4 | TLuaObject 5 | Copyright (c) 2007 Jeremy Darling 6 | Modifications copyright (c) 2010-2020 Felipe Daragon 7 | 8 | This unit is provided to support the older version of pLua. The new 9 | features presented within pLuaObject give more flexability when 10 | wrapping existing object types. Though it still makes sense to use 11 | TLuaObject when building objects specifically for the Lua environment. 12 | 13 | License: MIT (http://opensource.org/licenses/mit-license.php) 14 | 15 | Changes: 16 | * 06.10.2020, FD - Changed PtrInt to PtrUint (same change applied in MageSlayer's pLua) 17 | * 26.09.2020, FD - Added RegisterTLuaObjectAlt, plua_LocateObjectInArray 18 | and plua_PushObjectFromArray methods 19 | * 20.11.2015, FD - Added LocateEvent method 20 | * 17.06.2014, FD - Changed to work with string instead of ansistring. 21 | } 22 | 23 | {$IFDEF FPC} 24 | {$mode objfpc}{$H+} 25 | {$ENDIF} 26 | 27 | interface 28 | 29 | {$I Lua.inc} 30 | 31 | uses 32 | Classes, SysUtils, Lua, Variants, pLuaObject, pLua; 33 | 34 | type 35 | TLuaObject = class; 36 | 37 | { TLuaObject } 38 | 39 | TLuaObject = class 40 | protected 41 | L : PLua_State; 42 | FLuaReference : integer; 43 | FParent : TLuaObject; 44 | FChildren : TList; 45 | 46 | function GetLuaProp(PropName : String): Variant; 47 | procedure SetLuaProp(PropName : String; const AValue: Variant); 48 | function GetPropValue(propName : String): Variant; virtual; 49 | function GetPropObject(propName: String) : Boolean; virtual; 50 | function SetPropValue(PropName : String; const AValue: Variant) : Boolean; virtual; 51 | function SetPropObject(propName: String) : Boolean; virtual; 52 | function PropIsObject(propName : String): Boolean; virtual; 53 | procedure CommonCreate(LuaState : PLua_State; AParent : TLuaObject = nil); virtual; 54 | public 55 | constructor Create(LuaState : PLua_State; AParent : TLuaObject = nil); overload; virtual; 56 | constructor Create(LuaState: PLua_State; LuaClassName, LuaName: String); overload; virtual; 57 | destructor Destroy; override; 58 | 59 | procedure PushSelf; 60 | 61 | procedure CallEvent(EventName : String); overload; 62 | function CallEvent(EventName : String; args : Array of Variant; Results: PVariantArray = nil) : Integer; overload; 63 | function EventExists(EventName: String): Boolean; 64 | function LocateEvent(EventName: String): Boolean; 65 | 66 | property LState : PLua_State read L; 67 | property LRef:integer read FLuaReference; 68 | 69 | property LuaProp[PropName : String] : Variant read GetLuaProp write SetLuaProp; 70 | end; 71 | 72 | TLuaObjectRegisterMethodsCallback = procedure(L : Plua_State; classTable : Integer); 73 | TLuaObjectNewCallback = function(L : PLua_State; AParent : TLuaObject=nil):TLuaObject; 74 | 75 | var 76 | LuaObjects : TList; 77 | 78 | procedure ClearObjects; 79 | procedure LuaCopyTable(L: Plua_State; IdxFrom, IdxTo, MtTo : Integer); 80 | function LuaToTLuaObject(L: Plua_State; Idx : Integer) : TLuaObject; 81 | procedure RegisterLuaObject(L: Plua_State); 82 | 83 | procedure RegisterTLuaObject(L : Plua_State; ObjectName : String; CreateFunc : lua_CFunction; MethodsCallback : TLuaObjectRegisterMethodsCallback = nil); 84 | procedure RegisterObjectInstance(L : Plua_State; aClassName, InstanceName : String; ObjectInstance : TLuaObject); 85 | procedure RegisterMethod(L : Plua_State; TheMethodName : String; TheMethodAddress : lua_CFunction; classTable : Integer); 86 | function new_LuaObject(L : PLua_State; aClassName : String; NewCallback : TLuaObjectNewCallback) : Integer; cdecl; 87 | 88 | procedure PushTLuaObject(L : PLua_State; ObjectInstance : TLuaObject); 89 | 90 | function new_TLuaObject(L : PLua_State) : Integer; cdecl; 91 | function index_TLuaObject(L : PLua_State) : Integer; cdecl; 92 | function newindex_TLuaObject(L : PLua_State) : Integer; cdecl; 93 | function gc_TLuaObject(L : PLua_State) : Integer; cdecl; 94 | procedure RegisterClassTLuaObject(L : Plua_State); 95 | 96 | { FD: Additions by Felipe Daragon } 97 | 98 | type 99 | TLuaObjectRegResult = record 100 | ObjectName: string; 101 | end; 102 | plua_RegObjectFunc = function(L : Plua_State):TLuaObjectRegResult; 103 | pluaObject_Reg = record 104 | name : string; 105 | proc : plua_RegObjectFunc; 106 | end; 107 | TLuaObjectSearchResult = record 108 | found : boolean; 109 | obj: pluaObject_Reg; 110 | end; 111 | 112 | function RegisterTLuaObjectAlt(L : Plua_State; ObjectName : String; 113 | CreateFunc : lua_CFunction; 114 | MethodsCallback : TLuaObjectRegisterMethodsCallback = nil):TLuaObjectRegResult; 115 | 116 | function plua_LocateObjectInArray(const name: string; 117 | table: array of pluaObject_Reg): TLuaObjectSearchResult; 118 | 119 | function plua_pushobjectFromArray(L: plua_State; const name: string; 120 | table: array of pluaObject_Reg):integer; 121 | 122 | implementation 123 | 124 | uses 125 | typinfo, types; 126 | 127 | const 128 | LuaTLuaObjectClassName = 'TLuaObject'; 129 | 130 | constructor TLuaObject.Create(LuaState : PLua_State; AParent : TLuaObject = nil); 131 | begin 132 | CommonCreate(LuaState, nil); 133 | // Create a reference to the object table, this way lua won't GC its version 134 | FLuaReference := luaL_ref(L, LUA_REGISTRYINDEX); 135 | lua_rawgeti (L, LUA_REGISTRYINDEX, FLuaReference); 136 | LuaObjects.Add(Self); 137 | end; 138 | 139 | constructor TLuaObject.Create(LuaState: PLua_State; LuaClassName, LuaName: String); 140 | begin 141 | CommonCreate(LuaState, nil); 142 | RegisterObjectInstance(LuaState, LuaClassName, LuaName, self); 143 | end; 144 | 145 | destructor TLuaObject.Destroy; 146 | var 147 | lo : TLuaObject; 148 | begin 149 | LuaObjects.Remove(Self); 150 | if assigned(FParent) then 151 | FParent.FChildren.Remove(Self); 152 | while FChildren.Count > 0 do 153 | begin 154 | lo := TLuaObject(FChildren[FChildren.Count-1]); 155 | FChildren.Delete(FChildren.Count-1); 156 | lo.Free; 157 | end; 158 | FChildren.Free; 159 | luaL_unref(L, LUA_REGISTRYINDEX, FLuaReference); 160 | inherited Destroy; 161 | end; 162 | 163 | procedure TLuaObject.PushSelf; 164 | begin 165 | lua_rawgeti(L, LUA_REGISTRYINDEX, FLuaReference); 166 | end; 167 | 168 | procedure TLuaObject.CallEvent(EventName: String); 169 | begin 170 | CallEvent(EventName, []); 171 | end; 172 | 173 | function TLuaObject.CallEvent(EventName : String; args: array of Variant; Results: PVariantArray) : Integer; 174 | begin 175 | result := -1; 176 | if not EventExists(EventName) then 177 | exit; 178 | PushSelf; 179 | result := plua_callfunction(L, EventName, args, results, lua_gettop(L)); 180 | end; 181 | 182 | function TLuaObject.EventExists(EventName: String): Boolean; 183 | begin 184 | PushSelf; 185 | result := plua_functionexists(L, EventName, lua_gettop(L), false); 186 | lua_pop(L, 1); 187 | end; 188 | 189 | function TLuaObject.LocateEvent(EventName: String): Boolean; 190 | var 191 | idx : Integer; 192 | begin 193 | result := EventExists(EventName); 194 | if result = true then begin 195 | PushSelf; 196 | idx := lua_gettop(L); 197 | lua_pushstring(L, EventName); 198 | lua_rawget(L, idx); 199 | end; 200 | end; 201 | 202 | function TLuaObject.GetLuaProp(PropName : String): Variant; 203 | var 204 | idx : Integer; 205 | begin 206 | lua_rawgeti (L, LUA_REGISTRYINDEX, FLuaReference); // Place our object on the stack 207 | idx := lua_gettop(L); 208 | lua_pushliteral(L, PropName); // Place the event name on the stack 209 | lua_gettable(L, idx); // try to get the item 210 | result := plua_tovariant(L, lua_gettop(L)); 211 | lua_pop(L, 2); 212 | end; 213 | 214 | procedure TLuaObject.SetLuaProp(PropName : String; const AValue: Variant); 215 | var 216 | idx : Integer; 217 | begin 218 | lua_rawgeti (L, LUA_REGISTRYINDEX, FLuaReference); // Place our object on the stack 219 | idx := lua_gettop(L); 220 | lua_pushstring(L, propName); 221 | plua_pushvariant(L, AValue); 222 | lua_rawset(L, idx); 223 | end; 224 | 225 | function TLuaObject.GetPropValue(propName: String): Variant; 226 | begin 227 | if IsPublishedProp(self, propName) then 228 | result := typinfo.GetPropValue(self, propName) 229 | else 230 | result := NULL; 231 | end; 232 | 233 | function TLuaObject.GetPropObject(propName: String) : Boolean; 234 | begin 235 | result := false; 236 | end; 237 | 238 | function TLuaObject.SetPropValue(PropName: String; const AValue: Variant) : Boolean; 239 | begin 240 | result := IsPublishedProp(self, propName); 241 | if result then 242 | typinfo.SetPropValue(self, propName, AValue); 243 | end; 244 | 245 | function TLuaObject.SetPropObject(propName: String) : Boolean; 246 | begin 247 | result := false; 248 | end; 249 | 250 | function TLuaObject.PropIsObject(propName: String): Boolean; 251 | begin 252 | result := false; 253 | end; 254 | 255 | procedure TLuaObject.CommonCreate(LuaState: PLua_State; AParent: TLuaObject); 256 | begin 257 | L := LuaState; 258 | FParent := AParent; 259 | if assigned(FParent) then 260 | FParent.FChildren.Add(Self); 261 | FChildren := TList.Create; 262 | end; 263 | 264 | { Global LUA Methods } 265 | 266 | procedure LuaCopyTable(L: Plua_State; IdxFrom, IdxTo, MtTo : Integer); 267 | var 268 | id:Integer; 269 | tbl : Integer; 270 | key, val : Variant; 271 | cf : lua_CFunction; 272 | begin 273 | lua_pushnil(L); 274 | while(lua_next(L, IdxFrom)<>0)do 275 | begin 276 | key := plua_tovariant(L, -2); 277 | if CompareText(key, '__') = 1 then 278 | tbl := MtTo 279 | else 280 | tbl := IdxTo; 281 | case lua_type(L, -1) of 282 | LUA_TFUNCTION : begin 283 | cf := lua_tocfunction(L, -1); 284 | plua_pushvariant(L, key); 285 | lua_pushcfunction(L, cf); 286 | lua_rawset(L, tbl); 287 | end; 288 | LUA_TTABLE : begin 289 | id := lua_gettop(L); 290 | LuaCopyTable(L, id, IdxTo, MtTo); 291 | end; 292 | else 293 | val := plua_tovariant(L, -1); 294 | plua_pushvariant(L, key); 295 | plua_pushvariant(L, val); 296 | lua_rawset(L, tbl); 297 | end; 298 | lua_pop(L, 1); 299 | end; 300 | end; 301 | 302 | function LuaToTLuaObject(L: Plua_State; Idx : Integer) : TLuaObject; 303 | begin 304 | result := nil; 305 | if lua_type(L, Idx) = LUA_TTABLE then 306 | begin 307 | Idx := plua_absindex(L, Idx); 308 | lua_pushstring(L, '_Self'); 309 | lua_gettable(L, Idx); 310 | result := TLuaObject(PtrUint(lua_tointeger(L, -1))); 311 | lua_pop(L, 1); 312 | end 313 | else 314 | luaL_error(L, PAnsiChar('Class table expected.')); 315 | end; 316 | 317 | procedure PushTLuaObject(L: PLua_State; ObjectInstance: TLuaObject); 318 | begin 319 | lua_rawgeti(L, LUA_REGISTRYINDEX, ObjectInstance.FLuaReference); 320 | end; 321 | 322 | function new_TLuaObject(L : PLua_State) : Integer; cdecl; 323 | var 324 | P, E : TLuaObject; 325 | n, idx, idx2, mt : Integer; 326 | begin 327 | n := lua_gettop(L); 328 | if lua_type(L, 1) <> LUA_TTABLE then 329 | lua_remove(L, 1); 330 | if n = 1 then 331 | P := LuaToTLuaObject(L, 1) 332 | else 333 | P := nil; 334 | 335 | lua_newtable(L); 336 | E := TLuaObject.Create(L, P); 337 | idx := lua_gettop(L); 338 | 339 | lua_pushliteral(L, '_Self'); 340 | lua_pushinteger(L, PtrUint(Pointer(E))); 341 | lua_rawset(L, idx); 342 | 343 | lua_newtable(L); 344 | mt := lua_gettop(L); 345 | 346 | lua_pushliteral(L, LuaTLuaObjectClassName); 347 | lua_gettable(L, LUA_GLOBALSINDEX); 348 | idx2 := lua_gettop(L); 349 | 350 | LuaCopyTable(L, idx2, idx, mt); 351 | lua_setmetatable(L, idx); 352 | 353 | lua_pop(L, 1); 354 | 355 | result := 1; 356 | end; 357 | 358 | function index_TLuaObject(L : PLua_State) : Integer; cdecl; 359 | var 360 | E : TLuaObject; 361 | propName : String; 362 | v : Variant; 363 | begin 364 | E := LuaToTLuaObject(L, 1); 365 | lua_remove(L, 1); 366 | if E = nil then 367 | begin 368 | result := 0; 369 | exit; 370 | end; 371 | propName := lua_tostring(L, 1); 372 | index_TLuaObject := 1; 373 | if E.PropIsObject(propName) then 374 | begin 375 | if not E.GetPropObject(propName) then 376 | index_TLuaObject := 0; 377 | end 378 | else 379 | begin 380 | v := E.GetPropValue(propName); 381 | if v = NULL then 382 | index_TLuaObject := 0 383 | else 384 | plua_pushvariant(L, v); 385 | end; 386 | end; 387 | 388 | function newindex_TLuaObject(L : PLua_State) : Integer; cdecl; 389 | var 390 | TableIndex, ValueIndex : Integer; 391 | E : TLuaObject; 392 | propName : String; 393 | begin 394 | result := 0; 395 | E := LuaToTLuaObject(L, 1); 396 | if E = nil then 397 | begin 398 | exit; 399 | end; 400 | propName := lua_tostring(L, 2); 401 | if E.PropIsObject(propName) and E.SetPropObject(propName) then 402 | else if not E.SetPropValue(propName, plua_tovariant(L, 3)) then 403 | begin 404 | // This is a standard handler, no value was found in the object instance 405 | // so we push the value into the Lua Object reference. 406 | TableIndex := plua_absindex(L, 1); 407 | ValueIndex := plua_absindex(L, 3); 408 | lua_pushstring(L, propName); 409 | lua_pushvalue(L, ValueIndex); 410 | lua_rawset(L, TableIndex); 411 | end; 412 | end; 413 | 414 | function gc_TLuaObject(L : PLua_State) : Integer; cdecl; 415 | var 416 | E : TLuaObject; 417 | begin 418 | E := LuaToTLuaObject(L, 1); 419 | // Release the object 420 | if assigned(E) then 421 | E.Free; 422 | result := 0; 423 | end; 424 | 425 | procedure RegisterObjectInstance(L: Plua_State; aClassName, InstanceName: String; ObjectInstance : TLuaObject); 426 | var 427 | idx, idx2, mt : Integer; 428 | begin 429 | lua_pushliteral(L, InstanceName); 430 | lua_newtable(L); 431 | 432 | ObjectInstance.FLuaReference := luaL_ref(L, LUA_REGISTRYINDEX); 433 | lua_rawgeti (L, LUA_REGISTRYINDEX, ObjectInstance.FLuaReference); 434 | LuaObjects.Add(ObjectInstance); 435 | idx := lua_gettop(L); 436 | 437 | lua_pushliteral(L, '_Self'); 438 | lua_pushinteger(L, PtrUint(Pointer(ObjectInstance))); 439 | lua_rawset(L, idx); 440 | 441 | lua_newtable(L); 442 | mt := lua_gettop(L); 443 | 444 | lua_pushliteral(L, aClassName); 445 | lua_gettable(L, LUA_GLOBALSINDEX); 446 | idx2 := lua_gettop(L); 447 | 448 | LuaCopyTable(L, idx2, idx, mt); 449 | lua_setmetatable(L, idx); 450 | 451 | lua_pop(L, 1); 452 | 453 | lua_settable(L, LUA_GLOBALSINDEX); 454 | end; 455 | 456 | procedure RegisterMethod(L : Plua_State; TheMethodName : String; TheMethodAddress : lua_CFunction; classTable : Integer); 457 | begin 458 | lua_pushliteral(L, TheMethodName); 459 | lua_pushcfunction(L, TheMethodAddress); 460 | lua_rawset(L, classTable); 461 | end; 462 | 463 | function new_LuaObject(L : PLua_State; aClassName : String; NewCallback : TLuaObjectNewCallback): Integer; cdecl; 464 | var 465 | P, E : TLuaObject; 466 | n, idx, idx2, mt : Integer; 467 | begin 468 | n := lua_gettop(L); 469 | if lua_type(L, 1) <> LUA_TTABLE then 470 | lua_remove(L, 1); 471 | if n > 1 then 472 | P := LuaToTLuaObject(L, 2) 473 | else 474 | P := nil; 475 | 476 | lua_newtable(L); 477 | E := NewCallback(L, P); 478 | idx := lua_gettop(L); 479 | 480 | lua_pushliteral(L, '_Self'); 481 | lua_pushinteger(L, PtrUint(Pointer(E))); 482 | lua_rawset(L, idx); 483 | 484 | lua_newtable(L); 485 | mt := lua_gettop(L); 486 | 487 | lua_pushliteral(L, aClassName); 488 | lua_gettable(L, LUA_GLOBALSINDEX); 489 | idx2 := lua_gettop(L); 490 | 491 | LuaCopyTable(L, idx2, idx, mt); 492 | lua_setmetatable(L, idx); 493 | 494 | lua_pop(L, 1); 495 | 496 | result := 1; 497 | end; 498 | 499 | procedure RegisterClassTLuaObject(L : Plua_State); 500 | var 501 | classTable : Integer; 502 | begin 503 | lua_pushstring(L, LuaTLuaObjectClassName); 504 | lua_newtable(L); 505 | classTable := lua_gettop(L); 506 | 507 | RegisterMethod(L, '__index', @index_TLuaObject, classTable); 508 | RegisterMethod(L, '__newindex', @newindex_TLuaObject, classTable); 509 | RegisterMethod(L, '__call', @new_TLuaObject, classTable); 510 | RegisterMethod(L, '__gc', @gc_TLuaObject, classTable); 511 | RegisterMethod(L, 'release', @gc_TLuaObject, classTable); 512 | RegisterMethod(L, 'new', @new_TLuaObject, classTable); 513 | 514 | lua_settable(L, LUA_GLOBALSINDEX); 515 | end; 516 | 517 | { Global Management Methods } 518 | 519 | procedure RegisterTLuaObject(L: Plua_State; ObjectName : String; 520 | CreateFunc : lua_CFunction; 521 | MethodsCallback: TLuaObjectRegisterMethodsCallback); 522 | var 523 | classTable : Integer; 524 | begin 525 | lua_pushstring(L, ObjectName); 526 | lua_newtable(L); 527 | classTable := lua_gettop(L); 528 | 529 | RegisterMethod(L, '__index', @index_TLuaObject, classTable); 530 | RegisterMethod(L, '__newindex', @newindex_TLuaObject, classTable); 531 | RegisterMethod(L, '__call', CreateFunc, classTable); 532 | RegisterMethod(L, '__gc', @gc_TLuaObject, classTable); 533 | RegisterMethod(L, 'release', @gc_TLuaObject, classTable); 534 | RegisterMethod(L, 'new', CreateFunc, classTable); 535 | 536 | if Assigned(MethodsCallback) then 537 | MethodsCallback(L, classTable); 538 | 539 | lua_settable(L, LUA_GLOBALSINDEX); 540 | end; 541 | 542 | procedure ClearObjects; 543 | begin 544 | while LuaObjects.Count > 0 do 545 | TLuaObject(LuaObjects[LuaObjects.Count-1]).Free; 546 | end; 547 | 548 | procedure RegisterLuaObject(L: Plua_State); 549 | begin 550 | RegisterClassTLuaObject(L); 551 | end; 552 | 553 | { FD: Additions by Felipe Daragon } 554 | 555 | // Alternative to RegisterTLuaObject(), registers the object only if a table 556 | // doesn't exist and returns the registration results in the form of a record 557 | function RegisterTLuaObjectAlt(L : Plua_State; ObjectName : String; 558 | CreateFunc : lua_CFunction; 559 | MethodsCallback : TLuaObjectRegisterMethodsCallback = nil):TLuaObjectRegResult; 560 | begin 561 | result.objectname := ObjectName; 562 | lua_pushstring(L, ObjectName); 563 | lua_rawget(L, LUA_GLOBALSINDEX); 564 | if lua_istable(L, -1) = false then 565 | RegisterTLuaObject(L, ObjectName, CreateFunc, MethodsCallback); 566 | end; 567 | 568 | function plua_LocateObjectInArray(const name: string; 569 | table: array of pluaObject_Reg): TLuaObjectSearchResult; 570 | var 571 | i: integer; 572 | begin 573 | result.found := false; 574 | for i := low(table) to high(table) do 575 | begin 576 | if name = table[i].name then begin 577 | result.found := true; 578 | result.obj := table[i]; 579 | break; 580 | end; 581 | end; 582 | end; 583 | 584 | function plua_PushObjectFromArray(L: plua_State; const name: string; 585 | table: array of pluaObject_Reg):integer; 586 | var 587 | src: TLuaObjectSearchResult; 588 | reg: TLuaObjectRegResult; 589 | begin 590 | result := 0; 591 | src := plua_LocateObjectInArray(name,table); 592 | if src.found then begin 593 | result := 1; 594 | reg := src.obj.proc(L); 595 | lua_pushstring(L, reg.objectname); 596 | lua_rawget(L, LUA_GLOBALSINDEX); 597 | end; 598 | end; 599 | 600 | initialization 601 | LuaObjects := TList.Create; 602 | 603 | finalization 604 | ClearObjects; 605 | LuaObjects.Free; 606 | 607 | end. 608 | -------------------------------------------------------------------------------- /src/LuaWrapper.pas: -------------------------------------------------------------------------------- 1 | unit LuaWrapper; 2 | 3 | { 4 | Copyright (c) 2007 Jeremy Darling 5 | Modifications copyright (c) 2010-2014 Felipe Daragon 6 | 7 | License: MIT (http://opensource.org/licenses/mit-license.php) 8 | 9 | Changes: 10 | * 19.06.2014, FD - Changed to work with string instead of ansistring. 11 | * 16.05.2010, FD - Added LocateCall & Push. 12 | * 06.05.2013, FD - Added support for Delphi XE2 or higher. 13 | * 19.05.2014, FD - Added backwards compatibility with non-unicode Delphi. 14 | } 15 | 16 | interface 17 | 18 | {$IFDEF FPC} 19 | {$mode objfpc}{$H+} 20 | {$ENDIF} 21 | 22 | {$I Lua.inc} 23 | 24 | {$DEFINE TLuaAsComponent} 25 | {$DEFINE TLuaHandlersAsIsObjectType} 26 | 27 | uses 28 | Classes, SysUtils, Variants, Types, Lua, pLua; 29 | 30 | type 31 | TLua = class; 32 | 33 | TLuaOnException = procedure( Title: string; Line: Integer; Msg: string; 34 | var handled : Boolean) {$IFDEF TLuaHandlersAsIsObjectType}of object{$ENDIF}; 35 | TLuaOnLoadLibs = procedure( LuaWrapper : TLua ) {$IFDEF TLuaHandlersAsIsObjectType}of object{$ENDIF}; 36 | 37 | { TLUA } 38 | TLUA=class{$IFDEF TLuaAsComponent}(TComponent){$ENDIF} 39 | private 40 | FOnException: TLuaOnException; 41 | FOnLoadLibs: TLuaOnLoadLibs; 42 | FUseDebug: Boolean; 43 | FScript: String; 44 | FLibFile: String; 45 | FLibName: String; 46 | FMethods : TStringList; 47 | L : Plua_State; 48 | function GetLuaCPath: String; 49 | function GetLuaPath: String; 50 | function GetValue(valName : String): Variant; 51 | procedure SetLibName(const Value: String); 52 | procedure SetLuaCPath(const AValue: String); 53 | procedure SetLuaPath(const AValue: String); 54 | procedure OpenLibs; 55 | procedure SetOnException(const AValue: TLuaOnException); 56 | procedure SetOnLoadLibs(const AValue: TLuaOnLoadLibs); 57 | procedure SetUseDebug(const AValue: Boolean); 58 | procedure ErrorTest(errCode : Integer); 59 | procedure HandleException(E : LuaException); 60 | procedure SetValue(valName : String; const AValue: Variant); 61 | public 62 | constructor Create{$IFDEF TLuaAsComponent}(anOwner : TComponent); override {$ENDIF}; 63 | //{$IFDEF TLuaAsComponent}constructor Create; {$ENDIF} 64 | destructor Destroy; override; 65 | 66 | procedure Close; 67 | procedure Open; 68 | 69 | procedure LoadScript(Script : String); 70 | procedure LoadFile(FileName: String); 71 | procedure Execute; 72 | procedure ExecuteCmd(Script:String); 73 | procedure ExecuteFile(FileName : String); 74 | procedure RegisterLuaMethod(aMethodName: String; Func: lua_CFunction); 75 | procedure RegisterLuaTable(PropName: String; reader: lua_CFunction; writer : lua_CFunction = nil); 76 | function FunctionExists(aMethodName: String) : Boolean; 77 | function CallFunction( FunctionName : String; const Args: array of Variant; 78 | Results : PVariantArray = nil):Integer; 79 | function TableFunctionExists(TableName, FunctionName : String; out tblidx : Integer) : Boolean; overload; 80 | function TableFunctionExists(TableName, FunctionName : String) : Boolean; overload; 81 | function CallTableFunction( TableName, FunctionName : String; 82 | const Args: array of Variant; 83 | Results : PVariantArray = nil):Integer; 84 | 85 | procedure LocateCall(const AMethod:String); 86 | procedure Push(AParam:Variant); 87 | 88 | property LibName : String read FLibName write SetLibName; 89 | property LuaState : Plua_State read L write L; // FD: 16/05/2010, added write 90 | property LuaPath : String read GetLuaPath write SetLuaPath; 91 | property LuaCPath : String read GetLuaCPath write SetLuaCPath; 92 | property UseDebug : Boolean read FUseDebug write SetUseDebug; 93 | property Value[valName : String] : Variant read GetValue write SetValue; default; 94 | property OnException : TLuaOnException read FOnException write SetOnException; 95 | property OnLoadLibs : TLuaOnLoadLibs read FOnLoadLibs write SetOnLoadLibs; 96 | end; 97 | 98 | { TLUAThread } 99 | TLUAThread=class 100 | private 101 | FMaster : TLUA; 102 | FMethodName: String; 103 | FTableName: String; 104 | L : PLua_State; 105 | FThreadName : String; 106 | function GetIsValid: Boolean; 107 | public 108 | constructor Create(LUAInstance: TLUA; ThreadName : String); 109 | destructor Destroy; override; 110 | 111 | function Start(TableName : String; AMethodName : String; const ArgNames: array of String; var ErrorString : String) : Boolean; 112 | function Resume(EllapsedTime : lua_Number; Args : array of Variant; var ErrorString : String) : Boolean; 113 | 114 | property LuaState : Plua_State read L; 115 | property IsValid : Boolean read GetIsValid; 116 | property ThreadName : String read FThreadName; 117 | //property MethodName : String read FMethodName; 118 | property TableName : String read FTableName; 119 | end; 120 | 121 | { TLUAThreadList } 122 | TLUAThreadList=class 123 | private 124 | FThreads : TList; 125 | FLUAInstance : TLUA; 126 | function GetCount: Integer; 127 | function GetThread(index: integer): TLUAThread; 128 | public 129 | constructor Create(LUAInstance: TLUA); 130 | destructor Destroy; override; 131 | 132 | procedure Process(EllapsedTime : lua_Number; Args : array of Variant; var ErrorString : String); 133 | 134 | function SpinUp(TableName, AMethodName, ThreadName : String; var ErrorString : String) : Boolean; 135 | function IndexOf(ThreadName : String): Integer; 136 | procedure Release(ThreadIndex : Integer); 137 | 138 | property Thread[index:integer]: TLUAThread read GetThread; 139 | property Count : Integer read GetCount; 140 | end; 141 | 142 | implementation 143 | 144 | uses 145 | pLuaObject, pLuaRecord; 146 | 147 | constructor TLUA.Create{$IFDEF TLuaAsComponent}(anOwner: TComponent){$ENDIF}; 148 | begin 149 | {$IFDEF TLuaAsComponent}inherited;{$ENDIF} 150 | FUseDebug := false; 151 | FMethods := TStringList.Create; 152 | Open; 153 | end; 154 | 155 | destructor TLUA.Destroy; 156 | begin 157 | Close; 158 | FMethods.Free; 159 | inherited; 160 | end; 161 | 162 | procedure TLUA.LocateCall(const AMethod:String); 163 | begin 164 | lua_getglobal(L,PAnsiChar(AnsiString(AMethod))); 165 | end; 166 | 167 | procedure TLUA.Push(AParam:Variant); 168 | var AText:String; 169 | begin 170 | case VarType(AParam) of 171 | varByte,varWord, 172 | varShortInt,varSmallInt, 173 | varInteger:lua_pushnumber(L,Integer(AParam)); 174 | varDouble:lua_pushnumber(L,Double(AParam)); 175 | varString:begin 176 | AText:=VarToStr(AParam); 177 | lua_pushstring(L,AText); 178 | end; 179 | varOLEStr:begin 180 | AText:=string(UTF8EnCode(VarToWideStr(AParam))); 181 | lua_pushstring(L,AText); 182 | end; 183 | varBoolean:lua_pushboolean(L,(AParam = True)); 184 | //else LastError:=letPush; // ToDo, restore later 185 | end; 186 | end; 187 | 188 | procedure TLUA.Execute; 189 | begin 190 | if L = nil then 191 | Open; 192 | if FScript <> EmptyStr then 193 | ErrorTest(luaL_loadbuffer(L, PAnsiChar(ansistring(FScript)), length(ansistring(FScript)), PAnsiChar(AnsiString(LibName)))) 194 | else 195 | if FLibFile <> EmptyStr then 196 | ErrorTest(luaL_loadfile(L, PAnsiChar(ansistring(FLibFile)))) 197 | else 198 | exit; 199 | ErrorTest(lua_pcall(L, 0, 0, 0)); 200 | end; 201 | 202 | procedure TLUA.ExecuteCmd(Script: String); 203 | begin 204 | if L= nil then 205 | Open; 206 | ErrorTest(luaL_loadbuffer(L, PAnsiChar(AnsiString(Script)), Length(AnsiString(Script)), PAnsiChar(AnsiString(LibName)))); 207 | ErrorTest(lua_pcall(L, 0, 0, 0)); 208 | end; 209 | 210 | procedure TLUA.ExecuteFile(FileName: String); 211 | //var 212 | // Script : String; 213 | // sl : TStringList; 214 | begin 215 | if L = nil then 216 | Open; 217 | 218 | ErrorTest(luaL_loadfile(L, PAnsiChar(AnsiString(FileName)))); 219 | { 220 | if L = nil then 221 | Open; 222 | sl := TStringList.Create; 223 | try 224 | sl.LoadFromFile(FileName); 225 | Script := sl.Text; 226 | finally 227 | sl.Free; 228 | end; 229 | ErrorTest(luaL_loadbuffer(L, PAnsiChar(AnsiString(Script)), Length(AnsiString(Script)), PAnsiChar(AnsiString(LibName)))); } 230 | ErrorTest(lua_pcall(L, 0, 0, 0)); 231 | end; 232 | 233 | procedure TLUA.SetLuaPath(const AValue: String); 234 | begin 235 | lua_pushstring(L, 'package'); 236 | lua_gettable(L, LUA_GLOBALSINDEX); 237 | lua_pushstring(L, 'path'); 238 | lua_pushstring(L, AValue); 239 | lua_settable(L, -3); 240 | end; 241 | 242 | procedure TLUA.LoadFile(FileName: String); 243 | begin 244 | if L = nil then 245 | Open; 246 | FLibFile := FileName; 247 | FScript := EmptyStr; 248 | luaL_loadfile(L, PAnsiChar(AnsiString(FileName))); 249 | end; 250 | 251 | procedure TLUA.LoadScript(Script: String); 252 | begin 253 | if FScript <> Script then 254 | Close; 255 | if L = nil then 256 | Open; 257 | FScript := Trim(Script); 258 | FLibFile := EmptyStr; 259 | if FScript <> EmptyStr then 260 | luaL_loadbuffer(L, PAnsiChar(AnsiString(Script)), length(AnsiString(Script)), PAnsiChar(AnsiString(LibName))); 261 | end; 262 | 263 | function TLUA.FunctionExists(aMethodName: String): Boolean; 264 | begin 265 | lua_pushstring(L, aMethodName); 266 | lua_rawget(L, LUA_GLOBALSINDEX); 267 | result := (not lua_isnil(L, -1)) and lua_isfunction(L, -1); 268 | lua_pop(L, 1); 269 | end; 270 | 271 | procedure TLUA.RegisterLUAMethod(aMethodName: String; Func: lua_CFunction); 272 | begin 273 | if L = nil then 274 | Open; 275 | lua_register(L, aMethodName, Func); 276 | if FMethods.IndexOf(aMethodName) = -1 then 277 | FMethods.AddObject(aMethodName, TObject(@Func)) 278 | else 279 | FMethods.Objects[FMethods.IndexOf(aMethodName)] := TObject(@Func); 280 | end; 281 | 282 | procedure TLUA.RegisterLuaTable(PropName: String; reader: lua_CFunction; 283 | writer: lua_CFunction); 284 | begin 285 | plua_RegisterLuaTable(l, PropName, reader, writer); 286 | end; 287 | 288 | procedure TLUA.SetLibName(const Value: String); 289 | begin 290 | FLibName := Value; 291 | end; 292 | 293 | procedure TLUA.SetLuaCPath(const AValue: String); 294 | begin 295 | lua_pushstring(L, 'package'); 296 | lua_gettable(L, LUA_GLOBALSINDEX); 297 | lua_pushstring(L, 'cpath'); 298 | lua_pushstring(L, AValue); 299 | lua_settable(L, -3); 300 | end; 301 | 302 | function TLUA.GetLuaPath: String; 303 | begin 304 | lua_pushstring(L, 'package'); 305 | lua_gettable(L, LUA_GLOBALSINDEX); 306 | lua_pushstring(L, 'path'); 307 | lua_rawget(L, -2); 308 | result := lua_tostring(L, -1); 309 | end; 310 | 311 | function TLUA.GetValue(valName : String): Variant; 312 | begin 313 | result := NULL; 314 | lua_pushstring(l, valName); 315 | lua_rawget(l, LUA_GLOBALSINDEX); 316 | try 317 | result := plua_tovariant(l, -1); 318 | finally 319 | lua_pop(l, 1); 320 | end; 321 | end; 322 | 323 | function TLUA.GetLuaCPath: String; 324 | begin 325 | lua_pushstring(L, 'package'); 326 | lua_gettable(L, LUA_GLOBALSINDEX); 327 | lua_pushstring(L, 'cpath'); 328 | lua_rawget(L, -2); 329 | result := lua_tostring(L, -1); 330 | end; 331 | 332 | function TLUA.CallFunction(FunctionName: String; 333 | const Args: array of Variant; Results: PVariantArray = nil): Integer; 334 | begin 335 | result := -1; 336 | try 337 | if FunctionExists(FunctionName) then 338 | result := plua_callfunction(L, FunctionName, Args, Results) 339 | else 340 | result := -1; 341 | except 342 | on E:LuaException do 343 | HandleException(E); 344 | end; 345 | end; 346 | 347 | procedure TLUA.Close; 348 | begin 349 | if L <> nil then 350 | begin 351 | plua_ClearObjects(L); 352 | plua_ClearRecords(L); 353 | lua_close(L); 354 | end; 355 | L := nil; 356 | end; 357 | 358 | procedure TLUA.Open; 359 | begin 360 | if L <> nil then 361 | Close; 362 | L := lua_open; 363 | OpenLibs; 364 | end; 365 | 366 | procedure TLUA.OpenLibs; 367 | var 368 | I : Integer; 369 | begin 370 | luaL_openlibs(L); 371 | if UseDebug then 372 | luaopen_debug(L); 373 | lua_settop(L, 0); 374 | 375 | for I := 0 to FMethods.Count -1 do 376 | RegisterLUAMethod(FMethods[I], lua_CFunction(Pointer(FMethods.Objects[I]))); 377 | 378 | RecordTypesList.RegisterTo(L); 379 | ClassTypesList.RegisterTo(L); 380 | 381 | if assigned(FOnLoadLibs) then 382 | FOnLoadLibs(self); 383 | end; 384 | 385 | procedure TLUA.SetOnException(const AValue: TLuaOnException); 386 | begin 387 | if @FOnException=@AValue then exit; // FD: 16/05/2010, changed to @AValue 388 | FOnException:=AValue; 389 | end; 390 | 391 | procedure TLUA.SetOnLoadLibs(const AValue: TLuaOnLoadLibs); 392 | begin 393 | if @FOnLoadLibs=@AValue then exit; // FD: 16/05/2010, changed to @AValue 394 | FOnLoadLibs:=AValue; 395 | //if (L <> nil) and (FOnLoadLibs <> nil) then 396 | if (L <> nil) and (assigned(FOnLoadLibs)) then 397 | FOnLoadLibs(self); 398 | end; 399 | 400 | procedure TLUA.SetUseDebug(const AValue: Boolean); 401 | begin 402 | if FUseDebug=AValue then exit; 403 | FUseDebug:=AValue; 404 | end; 405 | 406 | procedure TLUA.ErrorTest(errCode: Integer); 407 | var 408 | msg : String; 409 | begin 410 | if errCode <> 0 then 411 | begin 412 | msg := lua_tostring(l, -1); 413 | lua_pop(l, 1); 414 | HandleException(LuaException.Create(msg)); 415 | end; 416 | end; 417 | 418 | procedure TLUA.HandleException(E: LuaException); 419 | var 420 | title, msg : String; 421 | line : Integer; 422 | handled : Boolean; 423 | begin 424 | handled := false; 425 | if assigned(FOnException) then 426 | begin 427 | plua_spliterrormessage(e.Message, title, line, msg); 428 | FOnException(title, line, msg, handled); 429 | end; 430 | if not handled then 431 | raise E; 432 | end; 433 | 434 | procedure TLUA.SetValue(valName : String; const AValue: Variant); 435 | begin 436 | if VarIsType(AValue, varString) then 437 | begin 438 | lua_pushliteral(l, valName); 439 | lua_pushstring(l, String(AValue)); 440 | lua_settable(L, LUA_GLOBALSINDEX); 441 | end 442 | else 443 | begin 444 | lua_pushliteral(l, valName); 445 | plua_pushvariant(l, AValue); 446 | lua_settable(L, LUA_GLOBALSINDEX); 447 | end; 448 | end; 449 | 450 | function TLUA.CallTableFunction(TableName, FunctionName: String; 451 | const Args: array of Variant; Results: PVariantArray): Integer; 452 | var 453 | tblidx : integer; 454 | begin 455 | result := -1; 456 | try 457 | if TableFunctionExists(TableName, FunctionName, tblidx) then 458 | begin 459 | lua_pushvalue(l, tblidx); 460 | tblidx := lua_gettop(l); 461 | result := plua_callfunction(l, FunctionName, args, results, tblidx) 462 | end 463 | else 464 | result := -1; 465 | except 466 | on E: LuaException do 467 | HandleException(E); 468 | end; 469 | end; 470 | 471 | function TLUA.TableFunctionExists(TableName, 472 | FunctionName: String; out tblidx : Integer): Boolean; 473 | begin 474 | lua_pushstring(L, TableName); 475 | lua_rawget(L, LUA_GLOBALSINDEX); 476 | result := lua_istable(L, -1); 477 | if result then 478 | begin 479 | tblidx := lua_gettop(L); 480 | lua_pushstring(L, FunctionName); 481 | lua_rawget(L, -2); 482 | result := lua_isfunction(L, -1); 483 | lua_pop(L, 1); 484 | end 485 | else 486 | begin 487 | tblidx := -1; 488 | lua_pop(L, 1); 489 | end; 490 | end; 491 | 492 | function TLUA.TableFunctionExists(TableName, FunctionName: String 493 | ): Boolean; 494 | var 495 | tblidx : Integer; 496 | begin 497 | result := TableFunctionExists(TableName, FunctionName, tblidx); 498 | if result then 499 | lua_pop(L, 1); 500 | end; 501 | 502 | { TLUAThread } 503 | 504 | function TLUAThread.GetIsValid: Boolean; 505 | begin 506 | lua_getglobal(L, PAnsiChar(AnsiString(FThreadName))); 507 | result := not lua_isnil(L, 1); 508 | lua_pop(L, 1); 509 | end; 510 | 511 | constructor TLUAThread.Create(LUAInstance: TLUA; ThreadName: String); 512 | begin 513 | L := lua_newthread(LUAInstance.LuaState); 514 | FThreadName := ThreadName; 515 | lua_setglobal(LUAInstance.LuaState, PAnsiChar(AnsiString(ThreadName))); 516 | FMaster := LUAInstance; 517 | end; 518 | 519 | destructor TLUAThread.Destroy; 520 | begin 521 | lua_pushnil(FMaster.LuaState); 522 | lua_setglobal(FMaster.LuaState, PAnsiChar(AnsiString(FThreadName))); 523 | inherited; 524 | end; 525 | 526 | function luaResume(L : PLua_State; NArgs:Integer; out Res : Integer) : Boolean; 527 | begin 528 | Res := lua_resume(L, NArgs); 529 | result := Res <> 0; 530 | end; 531 | 532 | function TLUAThread.Start(TableName : String; AMethodName : String; const ArgNames: array of String; var ErrorString : String) : Boolean; 533 | var 534 | i, 535 | rres : Integer; 536 | begin 537 | FTableName := TableName; 538 | FMethodName := AMethodName; 539 | if TableName <> EmptyStr then 540 | begin 541 | lua_pushstring(L, TableName); 542 | lua_gettable(L, LUA_GLOBALSINDEX); 543 | lua_pushstring(L, AMethodName); 544 | lua_rawget(L, -2); 545 | end 546 | else 547 | lua_getglobal(L, PAnsiChar(AnsiString(AMethodName))); 548 | 549 | for i := 0 to Length(ArgNames)-1 do 550 | lua_getglobal(L, PAnsiChar(AnsiString(ArgNames[i]))); 551 | 552 | if luaResume(L, Length(ArgNames), rres) then 553 | begin 554 | ErrorString := lua_tostring(L, -1); 555 | result := false; 556 | exit; 557 | end 558 | else 559 | result := true; 560 | end; 561 | 562 | function TLUAThread.Resume(EllapsedTime : lua_Number; Args : array of Variant; var ErrorString : String) : Boolean; 563 | var 564 | rres, 565 | i : Integer; 566 | msg : String; 567 | begin 568 | lua_pushnumber(L, EllapsedTime); 569 | for i := 0 to Length(Args)-1 do 570 | plua_pushvariant(L, Args[i]); 571 | if luaResume(L, Length(Args)+1, rres) then 572 | begin 573 | ErrorString := lua_tostring(L, -1); 574 | msg := 'Error ('+IntToStr(rres)+'): '+ErrorString; 575 | result := false; 576 | if result=false then begin // hide weird H2077 compiler warning 577 | end; 578 | raise exception.Create(msg); 579 | end 580 | else 581 | result := true; 582 | end; 583 | 584 | { TLUAThreadList } 585 | 586 | function TLUAThreadList.GetCount: Integer; 587 | begin 588 | result := FThreads.Count; 589 | end; 590 | 591 | function TLUAThreadList.GetThread(index: integer): TLUAThread; 592 | begin 593 | result := TLUAThread(FThreads[index]); 594 | end; 595 | 596 | constructor TLUAThreadList.Create(LUAInstance: TLUA); 597 | begin 598 | FLUAInstance := LUAInstance; 599 | FThreads := TList.Create; 600 | end; 601 | 602 | destructor TLUAThreadList.Destroy; 603 | var 604 | T : TLUAThread; 605 | begin 606 | while FThreads.Count > 0 do 607 | begin 608 | T := TLUAThread(FThreads[FThreads.Count-1]); 609 | FThreads.Remove(T); 610 | T.Free; 611 | end; 612 | FThreads.Free; 613 | inherited; 614 | end; 615 | 616 | procedure TLUAThreadList.Process(EllapsedTime: lua_Number; Args : array of Variant; 617 | var ErrorString: String); 618 | var 619 | i : Integer; 620 | begin 621 | i := 0; 622 | while i < Count do 623 | begin 624 | if not TLUAThread(FThreads[I]).Resume(EllapsedTime, Args, ErrorString) then 625 | Release(i) 626 | else 627 | inc(i); 628 | end; 629 | end; 630 | 631 | function TLUAThreadList.SpinUp(TableName, AMethodName, ThreadName: String; var ErrorString : String) : Boolean; 632 | var 633 | T : TLUAThread; 634 | begin 635 | T := TLUAThread.Create(FLUAInstance, ThreadName); 636 | FThreads.Add(T); 637 | result := T.Start(TableName, AMethodName, [], ErrorString); 638 | end; 639 | 640 | function TLUAThreadList.IndexOf(ThreadName: String): Integer; 641 | var 642 | i : Integer; 643 | begin 644 | result := -1; 645 | i := 0; 646 | while (result = -1) and (i -1) then 659 | begin 660 | T := TLUAThread(FThreads[ThreadIndex]); 661 | FThreads.Delete(ThreadIndex); 662 | T.Free; 663 | end; 664 | end; 665 | 666 | initialization 667 | 668 | finalization 669 | 670 | end. 671 | -------------------------------------------------------------------------------- /src/pLuaRecord.pas: -------------------------------------------------------------------------------- 1 | unit pLuaRecord; 2 | 3 | { 4 | Copyright (c) 2007 Jeremy Darling 5 | Modifications copyright (c) 2010-2014 Felipe Daragon 6 | 7 | License: MIT (http://opensource.org/licenses/mit-license.php) 8 | 9 | Changes: 10 | * 26.06.2014, FD - Changed to work with string instead of ansistring. 11 | } 12 | 13 | {$IFDEF FPC} 14 | {$mode objfpc}{$H+} 15 | {$TYPEDADDRESS ON} 16 | {$ENDIF} 17 | 18 | interface 19 | 20 | {$I Lua.inc} 21 | 22 | uses 23 | Classes, SysUtils, Lua, pLua, uWordList, pLuaObject, Types; 24 | 25 | type 26 | PLuaRecordInfo = ^TLuaRecordInfo; 27 | PLuaRecordInstanceInfo = ^TLuaRecordInstanceInfo; 28 | 29 | plua_RecordMethodWrapper = function(RecordPointer : pointer; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 30 | plua_RecordPropertyReader = plua_RecordMethodWrapper; 31 | plua_RecordPropertyWriter = plua_RecordMethodWrapper; 32 | plua_RecordConstructor = function(l : Plua_State; paramidxstart, paramcount : integer; InstanceInfo : PLuaRecordInstanceInfo) : Pointer; 33 | plua_RecordDestructor = procedure( RecordPointer : pointer; l : Plua_State ); 34 | 35 | PLuaRecordProperty= ^TLuaRecordProperty; 36 | TLuaRecordProperty = record 37 | PropName : String; 38 | Reader : plua_RecordPropertyReader; 39 | Writer : plua_RecordPropertyWriter; 40 | end; 41 | 42 | TLuaRecordInfo = record 43 | Parent : PLuaRecordInfo; 44 | RecordName : String; 45 | PropHandlers: TWordList; 46 | New : plua_RecordConstructor; 47 | Release : plua_RecordDestructor; 48 | Properties : Array of TLuaRecordProperty; 49 | end; 50 | 51 | TLuaRecordInstanceInfo = record 52 | OwnsInstance : Boolean; 53 | LuaRef : Integer; 54 | RecordInfo : PLuaRecordInfo; 55 | l : PLua_state; 56 | RecordPointer: Pointer; 57 | end; 58 | 59 | { TLuaRecordList } 60 | 61 | TLuaRecordList = class 62 | fItems : TList; 63 | private 64 | function GetRecordInfo(index : integer): PLuaRecordInfo; 65 | function GetCount: integer; 66 | public 67 | constructor Create; 68 | destructor Destroy; override; 69 | 70 | function GetPropReader(aRecordInfo : PLuaRecordInfo; aPropertyName : String) : plua_RecordPropertyReader; 71 | function GetPropWriter(aRecordInfo : PLuaRecordInfo; aPropertyName : String; out ReadOnly : Boolean) : plua_RecordPropertyWriter; 72 | 73 | function GetInfo(l : PLua_State; RecordPointer: Pointer) : PLuaRecordInstanceInfo; 74 | 75 | function Add(aRecordInfo : TLuaRecordInfo) : Integer; 76 | procedure Remove(aRecordName : String); 77 | function IndexOf(aRecordName : String) : Integer; 78 | procedure Clear; 79 | property Count : integer read GetCount; 80 | property RecordInfo[index : integer]:PLuaRecordInfo read GetRecordInfo; default; 81 | end; 82 | 83 | { TLuaClassTypesList } 84 | 85 | TLuaRecordTypesList = class 86 | fItems : TWordList; 87 | fItemList : TList; 88 | private 89 | function GetCount: Integer; 90 | function GetIndexedItem(index : integer): PLuaRecordInfo; 91 | function GetItem(ItemName : String): PLuaRecordInfo; 92 | public 93 | constructor Create; 94 | destructor Destroy; override; 95 | 96 | function Add(ItemName : String; LuaParent : PLuaRecordInfo = nil) : PLuaRecordInfo; 97 | procedure Remove(ItemName : String); 98 | procedure Clear; 99 | 100 | procedure RegisterTo(L : PLua_State); 101 | 102 | property Item[ItemName : String] : PLuaRecordInfo read GetItem; default; 103 | property IndexedItem[index : integer] : PLuaRecordInfo read GetIndexedItem; 104 | property Count : Integer read GetCount; 105 | end; 106 | 107 | procedure plua_registerRecordType( l : PLua_State; RecordInfo : TLuaRecordInfo); 108 | procedure plua_newRecordInfo( var RecordInfoPointer : PLuaRecordInfo); 109 | procedure plua_initRecordInfo( var RecordInfo : TLuaRecordInfo); 110 | procedure plua_releaseRecordInfo( var RecordInfoPointer : PLuaRecordInfo); 111 | 112 | function plua_registerExistingRecord( l : PLua_State; InstanceName : String; 113 | RecordPointer: Pointer; 114 | RecordInfo : PLuaRecordInfo; 115 | FreeOnGC : Boolean = false) : PLuaRecordInstanceInfo; 116 | 117 | function plua_pushexisting( l : PLua_State; 118 | RecordPointer: Pointer; 119 | RecordInfo : PLuaRecordInfo; 120 | FreeOnGC : Boolean = false) : PLuaRecordInstanceInfo; 121 | 122 | procedure plua_AddRecordProperty( var RecordInfo : TLuaRecordInfo; 123 | propertyName : String; 124 | Reader : plua_RecordPropertyReader; 125 | Writer : plua_RecordPropertyWriter ); 126 | 127 | function plua_getRecord( l : PLua_State; idx : Integer) : Pointer; 128 | function plua_getRecordInfo( l : PLua_State; idx : Integer) : PLuaRecordInstanceInfo; overload; 129 | procedure plua_PushRecord(RecordInfo : PLuaRecordInstanceInfo); 130 | function plua_GetRecordInfo( l : PLua_State; RecordPointer : Pointer) : PLuaRecordInstanceInfo; overload; 131 | 132 | procedure plua_PushRecordToTable( L : PLua_State; RecordPointer : Pointer; 133 | RecordInfo : PLuaRecordInfo ); 134 | 135 | procedure plua_ClearRecords( L : PLua_State ); 136 | 137 | var 138 | LuaRecords : TLuaRecordList; 139 | RecordTypesList : TLuaRecordTypesList; 140 | 141 | implementation 142 | 143 | var 144 | intLuaRecords : TList; 145 | 146 | function plua_gc_record(l : PLua_State) : integer; cdecl; forward; 147 | 148 | function plua_index_record(l : PLua_State) : integer; cdecl; 149 | var 150 | propName : String; 151 | propValueStart : Integer; 152 | rec : pointer; 153 | rInfo : PLuaRecordInstanceInfo; 154 | reader : plua_RecordPropertyReader; 155 | pcount : Integer; 156 | begin 157 | result := 0; 158 | pcount := lua_gettop(l); 159 | if not lua_istable(l, 1) then 160 | exit; 161 | 162 | rInfo := plua_GetRecordInfo(l, 1); 163 | if not assigned(rInfo) then 164 | exit; 165 | rec := rInfo^.RecordPointer; 166 | 167 | propName := lua_tostring(l, 2); 168 | propValueStart := 3; 169 | reader := LuaRecords.GetPropReader(rInfo^.recordInfo, propName); 170 | if assigned(reader) then 171 | result := reader(rec, l, propValueStart, pcount); 172 | end; 173 | 174 | function plua_newindex_record(l : PLua_State) : integer; cdecl; 175 | var 176 | propName : String; 177 | propValueStart : Integer; 178 | rec : pointer; 179 | rInfo : PLuaRecordInstanceInfo; 180 | writer : plua_RecordPropertyWriter; 181 | bReadOnly: Boolean; 182 | pcount : Integer; 183 | begin 184 | result := 0; 185 | pcount := lua_gettop(l); 186 | if not lua_istable(l, 1) then 187 | exit; 188 | 189 | rInfo := plua_GetRecordInfo(l, 1); 190 | if not assigned(rInfo) then 191 | exit; 192 | rec := rInfo^.RecordPointer; 193 | 194 | propName := lua_tostring(l, 2); 195 | propValueStart := 3; 196 | writer := LuaRecords.GetPropWriter(rInfo^.recordInfo, propName, bReadOnly); 197 | if assigned(writer) then 198 | result := writer(rec, l, propValueStart, pcount) 199 | else 200 | begin 201 | if not bReadOnly then 202 | begin 203 | lua_pushstring(l, propName); 204 | lua_pushvalue(l, propValueStart); 205 | lua_rawset(l, 1); 206 | end; 207 | end; 208 | end; 209 | 210 | function plua_new_record(l : PLua_State) : integer; cdecl; 211 | var 212 | n, tidx, oidx : Integer; 213 | recordPTR: Pointer; 214 | rInfo : PLuarecordInfo; 215 | instance: PLuaRecordInstanceInfo; 216 | pcount : integer; 217 | begin 218 | result := 0; 219 | pcount := lua_gettop(l); 220 | n := lua_gettop(l); 221 | if (n < 1) or (not (lua_istable(l, 1))) then 222 | exit; 223 | 224 | tidx := 1; 225 | 226 | lua_pushstring(l, '__recordPTR'); 227 | lua_rawget(l, tidx); 228 | recordPTR := pointer(PtrInt(lua_tointeger(l, -1))); 229 | rInfo := PLuarecordInfo(recordPTR); 230 | lua_pop(l, 1); 231 | 232 | new(instance); 233 | instance^.OwnsInstance := true; 234 | instance^.recordInfo := rInfo; 235 | instance^.l := l; 236 | instance^.RecordPointer := rInfo^.New(l, 2, pcount, instance); 237 | intLuaRecords.Add(pointer(instance)); 238 | 239 | lua_newtable(L); 240 | instance^.LuaRef := luaL_ref(L, LUA_REGISTRYINDEX); 241 | lua_rawgeti(l, LUA_REGISTRYINDEX, instance^.LuaRef); 242 | oidx := lua_gettop(L); 243 | 244 | lua_pushliteral(L, '__instance'); 245 | lua_pushinteger(L, PtrInt(instance)); 246 | lua_rawset(l, oidx); 247 | 248 | lua_pushstring(L, 'release'); 249 | lua_pushcfunction(L, @plua_gc_record); 250 | lua_rawset(L, oidx); 251 | 252 | luaL_getmetatable(l, PAnsiChar(AnsiString(rInfo^.recordName)+'_mt')); 253 | lua_setmetatable(l, -2); 254 | 255 | result := 1; 256 | end; 257 | 258 | function plua_gc_record(l : PLua_State) : integer; cdecl; 259 | var 260 | nfo : PLuaRecordInstanceInfo; 261 | begin 262 | result := 0; 263 | nfo := plua_GetRecordInfo(l, 1); 264 | if not assigned(nfo) then 265 | exit; 266 | intLuaRecords.Remove(nfo); 267 | if nfo^.OwnsInstance then 268 | begin 269 | nfo^.RecordInfo^.Release(nfo^.RecordPointer, l); 270 | nfo^.RecordPointer := nil; 271 | end; 272 | luaL_unref(L, LUA_REGISTRYINDEX, nfo^.LuaRef); 273 | freemem(nfo); 274 | end; 275 | 276 | procedure plua_registerRecordType(l: PLua_State; RecordInfo: TLuaRecordInfo); 277 | var 278 | lidx, tidx, midx: integer; 279 | ci : PLuaRecordInfo; 280 | begin 281 | lidx := LuaRecords.Add(RecordInfo); 282 | 283 | lua_pushstring(l, RecordInfo.RecordName); 284 | lua_newtable(l); 285 | 286 | luaL_newmetatable(l, PAnsiChar(AnsiString(RecordInfo.RecordName)+'_mt')); 287 | lua_setmetatable(l, -2); 288 | lua_settable(l, LUA_GLOBALSINDEX); 289 | 290 | luaL_getmetatable(l, PAnsiChar(AnsiString(RecordInfo.RecordName)+'_mt')); 291 | midx := lua_gettop(l); 292 | 293 | lua_pushstring(l, RecordInfo.RecordName); 294 | lua_gettable(l, LUA_GLOBALSINDEX); 295 | tidx := lua_gettop(l); 296 | 297 | lua_pushstring(L, '__call'); 298 | lua_pushcfunction(L, @plua_new_record); 299 | lua_rawset(L, midx); 300 | lua_pushstring(L, '__gc'); 301 | lua_pushcfunction(L, @plua_gc_record); 302 | lua_rawset(L, midx); 303 | 304 | lua_pushstring(L, 'new'); 305 | lua_pushcfunction(L, @plua_new_record); 306 | lua_rawset(L, tidx); 307 | 308 | lua_pushstring(L, '__recordID'); 309 | lua_pushinteger(L, lidx); 310 | lua_rawset(L, tidx); 311 | lua_pushstring(L, '__recordPTR'); 312 | ci := LuaRecords.RecordInfo[lidx]; 313 | lua_pushinteger(L, PtrInt(ci)); 314 | lua_rawset(L, tidx); 315 | 316 | lua_pushstring(L, '__index'); 317 | lua_pushcfunction(L, @plua_index_record); 318 | lua_rawset(L, midx); 319 | lua_pushstring(L, '__newindex'); 320 | lua_pushcfunction(L, @plua_newindex_record); 321 | lua_rawset(L, midx); 322 | end; 323 | 324 | procedure plua_newRecordInfo(var RecordInfoPointer: PLuaRecordInfo); 325 | begin 326 | if RecordInfoPointer = nil then 327 | new(RecordInfoPointer); 328 | plua_initRecordInfo(RecordInfoPointer^); 329 | end; 330 | 331 | procedure plua_initRecordInfo(var RecordInfo: TLuaRecordInfo); 332 | begin 333 | RecordInfo.RecordName := ''; 334 | RecordInfo.Parent := nil; 335 | RecordInfo.PropHandlers := TWordList.Create; 336 | RecordInfo.New := nil; 337 | RecordInfo.Release := nil; 338 | SetLength(RecordInfo.Properties, 0); 339 | end; 340 | 341 | procedure plua_releaseRecordInfo(var RecordInfoPointer: PLuaRecordInfo); 342 | begin 343 | RecordInfoPointer^.PropHandlers.Free; 344 | Freemem(RecordInfoPointer); 345 | end; 346 | 347 | function plua_registerExistingRecord(l: PLua_State; InstanceName: String; 348 | RecordPointer: Pointer; RecordInfo: PLuaRecordInfo; FreeOnGC: Boolean 349 | ): PLuaRecordInstanceInfo; 350 | var 351 | oidx : Integer; 352 | rInfo : PLuaRecordInfo; 353 | instance: PLuaRecordInstanceInfo; 354 | begin 355 | rInfo := RecordInfo; 356 | 357 | instance := plua_GetRecordInfo(l, RecordPointer); 358 | if assigned(instance) then 359 | begin 360 | result := instance; 361 | exit; 362 | end; 363 | 364 | new(instance); 365 | result := instance; 366 | instance^.OwnsInstance := FreeOnGC; 367 | instance^.RecordInfo := rInfo; 368 | instance^.l := l; 369 | 370 | instance^.RecordPointer := RecordPointer; 371 | intLuaRecords.Add(pointer(instance)); 372 | 373 | lua_pushstring(l, InstanceName); 374 | lua_newtable(L); 375 | instance^.LuaRef := luaL_ref(L, LUA_REGISTRYINDEX); 376 | lua_rawgeti(l, LUA_REGISTRYINDEX, instance^.LuaRef); 377 | oidx := lua_gettop(L); 378 | 379 | lua_pushliteral(L, '__instance'); 380 | lua_pushinteger(L, PtrInt(instance)); 381 | lua_rawset(l, oidx); 382 | 383 | lua_pushstring(L, 'release'); 384 | lua_pushcfunction(L, @plua_gc_record); 385 | lua_rawset(L, oidx); 386 | 387 | luaL_getmetatable(l, PAnsiChar(AnsiString(rInfo^.RecordName)+'_mt')); 388 | lua_setmetatable(l, -2); 389 | 390 | lua_settable(l, LUA_GLOBALSINDEX ); 391 | end; 392 | 393 | function plua_pushexisting(l: PLua_State; RecordPointer: Pointer; 394 | RecordInfo: PLuaRecordInfo; FreeOnGC: Boolean): PLuaRecordInstanceInfo; 395 | var 396 | oidx : Integer; 397 | rInfo : PLuaRecordInfo; 398 | instance: PLuaRecordInstanceInfo; 399 | begin 400 | instance := plua_GetRecordInfo(l, RecordPointer); 401 | if assigned(instance) then 402 | begin 403 | plua_PushRecord(instance); 404 | result := instance; 405 | exit; 406 | end; 407 | 408 | rInfo := RecordInfo; 409 | 410 | new(instance); 411 | result := instance; 412 | instance^.OwnsInstance := FreeOnGC; 413 | instance^.RecordInfo := rInfo; 414 | instance^.l := l; 415 | instance^.RecordPointer := RecordPointer; 416 | 417 | intLuaRecords.Add(pointer(instance)); 418 | 419 | lua_newtable(L); 420 | instance^.LuaRef := luaL_ref(L, LUA_REGISTRYINDEX); 421 | lua_rawgeti(l, LUA_REGISTRYINDEX, instance^.LuaRef); 422 | oidx := lua_gettop(L); 423 | 424 | lua_pushliteral(L, '__instance'); 425 | lua_pushinteger(L, PtrInt(instance)); 426 | lua_rawset(l, oidx); 427 | 428 | lua_pushstring(L, 'release'); 429 | lua_pushcfunction(L, @plua_gc_record); 430 | lua_rawset(L, oidx); 431 | 432 | luaL_getmetatable(l, PAnsiChar(AnsiString(rinfo^.RecordName)+'_mt')); 433 | lua_setmetatable(l, -2); 434 | end; 435 | 436 | procedure plua_AddRecordProperty(var RecordInfo: TLuaRecordInfo; 437 | propertyName: String; Reader: plua_RecordPropertyReader; 438 | Writer: plua_RecordPropertyWriter); 439 | var 440 | idx : integer; 441 | begin 442 | idx := Length(RecordInfo.Properties); 443 | SetLength(RecordInfo.Properties, idx+1); 444 | RecordInfo.Properties[idx].PropName := propertyName; 445 | RecordInfo.Properties[idx].Reader := Reader; 446 | RecordInfo.Properties[idx].Writer := Writer; 447 | RecordInfo.PropHandlers.AddWord(ansistring(propertyName))^.data := pointer(PtrInt(idx)); 448 | end; 449 | 450 | function plua_getRecord(l: PLua_State; idx: Integer): Pointer; 451 | var 452 | instance : PLuaRecordInstanceInfo; 453 | begin 454 | result := nil; 455 | lua_pushstring(l, '__instance'); 456 | lua_rawget(l, plua_absindex(l, idx)); 457 | instance := PLuaRecordInstanceInfo(ptrint(lua_tointeger(l, -1))); 458 | lua_pop(l, 1); 459 | if assigned(instance) and assigned(instance^.RecordPointer) then 460 | result := instance^.RecordPointer; 461 | end; 462 | 463 | function plua_getRecordInfo(l: PLua_State; idx: Integer 464 | ): PLuaRecordInstanceInfo; 465 | begin 466 | //result := nil; 467 | lua_pushstring(l, '__instance'); 468 | lua_rawget(l, plua_absindex(l, idx)); 469 | result := PLuaRecordInstanceInfo(ptrint(lua_tointeger(l, -1))); 470 | lua_pop(l, 1); 471 | end; 472 | 473 | procedure plua_PushRecord(RecordInfo: PLuaRecordInstanceInfo); 474 | begin 475 | lua_rawgeti(RecordInfo^.l, LUA_REGISTRYINDEX, RecordInfo^.LuaRef); 476 | end; 477 | 478 | function plua_GetRecordInfo(l : PLua_State; RecordPointer: Pointer): PLuaRecordInstanceInfo; 479 | begin 480 | result := LuaRecords.GetInfo(l, RecordPointer); 481 | end; 482 | 483 | procedure plua_PushRecordToTable(L: PLua_State; RecordPointer: Pointer; 484 | RecordInfo: PLuaRecordInfo); 485 | var 486 | i, tblIdx : Integer; 487 | begin 488 | lua_newtable(L); 489 | tblIdx := lua_gettop(L); 490 | for i := 0 to Length(RecordInfo^.Properties) -1 do 491 | if assigned(RecordInfo^.Properties[i].Writer) then 492 | begin 493 | lua_pushstring(L, RecordInfo^.Properties[i].PropName); 494 | RecordInfo^.Properties[i].Writer(RecordPointer, L, 0, 0); 495 | lua_settable(l, tblidx); 496 | end; 497 | end; 498 | 499 | procedure plua_ClearRecords(L: PLua_State); 500 | var 501 | i : Integer; 502 | nfo : PLuaRecordInstanceInfo; 503 | begin 504 | i := intLuaRecords.Count-1; 505 | while i > -1 do 506 | begin 507 | nfo := PLuaRecordInstanceInfo(intLuaRecords[i]); 508 | if nfo^.l = l then 509 | intLuaRecords.Remove(nfo); 510 | dec(i); 511 | end; 512 | end; 513 | 514 | { TLuaRecordList } 515 | 516 | function TLuaRecordList.GetRecordInfo(index: integer): PLuaRecordInfo; 517 | begin 518 | result := PLuaRecordInfo(fItems[index]); 519 | end; 520 | 521 | function TLuaRecordList.GetCount: integer; 522 | begin 523 | result := fItems.Count; 524 | end; 525 | 526 | constructor TLuaRecordList.Create; 527 | begin 528 | fItems := TList.Create; 529 | end; 530 | 531 | destructor TLuaRecordList.Destroy; 532 | begin 533 | Clear; 534 | fItems.Free; 535 | inherited Destroy; 536 | end; 537 | 538 | function TLuaRecordList.GetPropReader(aRecordInfo: PLuaRecordInfo; 539 | aPropertyName: String): plua_RecordPropertyReader; 540 | var 541 | pi : PtrInt; 542 | ei : PWordListSymbol; 543 | begin 544 | // TODO - Add parent property calls in 545 | result := nil; 546 | ei := aRecordInfo^.PropHandlers.WordSymbol[ansistring(aPropertyName)]; 547 | if not assigned(ei) then 548 | exit; 549 | pi := PtrInt(ei^.data); 550 | if (pi >= 0) and (pi < length(aRecordInfo^.Properties)) then 551 | result := aRecordInfo^.Properties[pi].Reader; 552 | end; 553 | 554 | function TLuaRecordList.GetPropWriter(aRecordInfo: PLuaRecordInfo; 555 | aPropertyName: String; out ReadOnly: Boolean): plua_RecordPropertyWriter; 556 | var 557 | pi : PtrInt; 558 | ei : PWordListSymbol; 559 | begin 560 | // TODO - Add parent property calls in 561 | ReadOnly := false; 562 | result := nil; 563 | ei := aRecordInfo^.PropHandlers.WordSymbol[ansistring(aPropertyName)]; 564 | if not assigned(ei) then 565 | exit; 566 | pi := PtrInt(ei^.data); 567 | if (pi >= 0) and (pi < length(aRecordInfo^.Properties)) then 568 | begin 569 | ReadOnly := @aRecordInfo^.Properties[pi].Writer = nil; 570 | result := aRecordInfo^.Properties[pi].Writer; 571 | end; 572 | end; 573 | 574 | function TLuaRecordList.GetInfo(l : PLua_State; RecordPointer: Pointer 575 | ): PLuaRecordInstanceInfo; 576 | var 577 | i : Integer; 578 | begin 579 | result := nil; 580 | i := 0; 581 | while (result = nil) and (i < intLuaRecords.Count) do 582 | begin 583 | if (PLuaRecordInstanceInfo(intLuaRecords[i])^.RecordPointer = RecordPointer) and 584 | (PLuaRecordInstanceInfo(intLuaRecords[i])^.l = l) then 585 | result := PLuaRecordInstanceInfo(intLuaRecords[i]); 586 | inc(i); 587 | end; 588 | end; 589 | 590 | function TLuaRecordList.Add(aRecordInfo: TLuaRecordInfo): Integer; 591 | var 592 | ri : PLuaRecordInfo; 593 | begin 594 | result := IndexOf(aRecordInfo.RecordName); 595 | if result = -1 then 596 | begin 597 | new(ri); 598 | result := fItems.Add(ri); 599 | end 600 | else 601 | ri := RecordInfo[result]; 602 | ri^ := aRecordInfo; 603 | end; 604 | 605 | procedure TLuaRecordList.Remove(aRecordName: String); 606 | var 607 | idx : integer; 608 | ri : PLuaRecordInfo; 609 | begin 610 | idx := IndexOf(aRecordName); 611 | if idx > -1 then 612 | begin 613 | ri := RecordInfo[idx]; 614 | fItems.Delete(idx); 615 | Freemem(ri); 616 | end; 617 | end; 618 | 619 | function TLuaRecordList.IndexOf(aRecordName: String): Integer; 620 | var 621 | i : Integer; 622 | begin 623 | result := -1; 624 | i := 0; 625 | while (result = -1) and (i < count) do 626 | begin 627 | if CompareText(aRecordName, RecordInfo[i]^.RecordName) = 0 then 628 | result := i; 629 | inc(i); 630 | end; 631 | end; 632 | 633 | procedure TLuaRecordList.Clear; 634 | var 635 | ri : PLuaRecordInfo; 636 | begin 637 | while count > 0 do 638 | begin 639 | ri := RecordInfo[count-1]; 640 | fItems.Delete(count-1); 641 | Freemem(ri); 642 | end; 643 | end; 644 | 645 | { TLuaRecordTypesList } 646 | 647 | function TLuaRecordTypesList.GetCount: Integer; 648 | begin 649 | result := fItemList.Count; 650 | end; 651 | 652 | function TLuaRecordTypesList.GetIndexedItem(index : integer): PLuaRecordInfo; 653 | begin 654 | result := PLuaRecordInfo(fItemList[index]); 655 | end; 656 | 657 | function TLuaRecordTypesList.GetItem(ItemName : String): PLuaRecordInfo; 658 | begin 659 | result := PLuaRecordInfo(fItems.WordData[AnsiString(ItemName)]); 660 | end; 661 | 662 | constructor TLuaRecordTypesList.Create; 663 | begin 664 | fItems := TWordList.Create; 665 | fItemList := TList.Create; 666 | end; 667 | 668 | destructor TLuaRecordTypesList.Destroy; 669 | begin 670 | Clear; 671 | fItems.Free; 672 | fItemList.Free; 673 | inherited Destroy; 674 | end; 675 | 676 | function TLuaRecordTypesList.Add(ItemName: String; LuaParent : PLuaRecordInfo = nil): PLuaRecordInfo; 677 | begin 678 | result := PLuaRecordInfo(fItems.WordData[AnsiString(ItemName)]); 679 | if not assigned(result) then 680 | begin 681 | plua_newRecordInfo(result); 682 | result^.Parent := LuaParent; 683 | result^.RecordName := ItemName; 684 | fItems.AddWord(AnsiString(ItemName))^.data := result; 685 | fItemList.Add(result); 686 | end; 687 | end; 688 | 689 | procedure TLuaRecordTypesList.Remove(ItemName: String); 690 | var 691 | wd : PWordListSymbol; 692 | ci : PLuaRecordInfo; 693 | begin 694 | wd := fItems.WordSymbol[AnsiString(ItemName)]; 695 | if (assigned(wd)) and (assigned(wd^.data)) and (wd^.eow) then 696 | begin 697 | ci := PLuaRecordInfo(wd^.data); 698 | fItemList.Remove(wd^.data); 699 | wd^.data := nil; 700 | wd^.eow := false; 701 | plua_releaseRecordInfo(ci); 702 | end; 703 | end; 704 | 705 | procedure TLuaRecordTypesList.Clear; 706 | begin 707 | while Count > 0 do 708 | Remove(IndexedItem[Count-1]^.RecordName); 709 | end; 710 | 711 | procedure TLuaRecordTypesList.RegisterTo(L: PLua_State); 712 | var 713 | i : Integer; 714 | begin 715 | for i := 0 to Count-1 do 716 | plua_registerRecordType(l, IndexedItem[i]^); 717 | end; 718 | 719 | var 720 | instance : PLuaRecordInstanceInfo; 721 | 722 | initialization 723 | RecordTypesList := TLuaRecordTypesList.Create; 724 | LuaRecords := TLuaRecordList.Create; 725 | intLuaRecords := TList.Create; 726 | 727 | finalization 728 | RecordTypesList.Free; 729 | LuaRecords.Free; 730 | LuaRecords := nil; 731 | while intLuaRecords.Count > 0 do 732 | begin 733 | instance := PLuaRecordInstanceInfo(intLuaRecords[intLuaRecords.Count-1]); 734 | intLuaRecords.Delete(intLuaRecords.Count-1); 735 | if instance^.OwnsInstance then 736 | instance^.RecordInfo^.Release(instance, nil); 737 | Freemem(instance); 738 | end; 739 | intLuaRecords.Free; 740 | intLuaRecords := nil; 741 | 742 | end. 743 | -------------------------------------------------------------------------------- /src/pLuaObject.pas: -------------------------------------------------------------------------------- 1 | unit pLuaObject; 2 | 3 | { 4 | Copyright (c) 2007 Jeremy Darling 5 | Modifications copyright (c) 2010-2014 Felipe Daragon 6 | 7 | License: MIT (http://opensource.org/licenses/mit-license.php) 8 | 9 | Changes: 10 | * 26.06.2014, FD - Changed to work with string instead of ansistring. 11 | } 12 | 13 | {$IFDEF FPC} 14 | {$mode objfpc}{$H+} 15 | {$TYPEDADDRESS ON} 16 | {$ENDIF} 17 | 18 | interface 19 | 20 | {$I Lua.inc} 21 | 22 | uses 23 | Classes, SysUtils, lua, pLua, uWordList; 24 | 25 | type 26 | TLuaObjectEventDelegate = class; 27 | PLuaInstanceInfo = ^TLuaInstanceInfo; 28 | plua_ClassMethodWrapper = function(target : TObject; l : Plua_State; paramidxstart, paramcount : integer) : Integer; 29 | plua_PropertyReader = plua_ClassMethodWrapper; 30 | plua_PropertyWriter = plua_ClassMethodWrapper; 31 | plua_MethodWrapper = plua_ClassMethodWrapper; 32 | plua_ClassConstructor = function(l : Plua_State; paramidxstart, paramcount : integer; InstanceInfo : PLuaInstanceInfo) : TObject; 33 | plua_ClassDestructor = procedure(target : TObject; l : Plua_State); 34 | 35 | PLuaClassInfo = ^TLuaClassInfo; 36 | PLuaClassProperty = ^TLuaClassProperty; 37 | TLuaClassProperty = record 38 | PropName : String; 39 | Reader : plua_PropertyReader; 40 | Writer : plua_PropertyWriter; 41 | end; 42 | 43 | TLuaClassMethod = record 44 | MethodName : String; 45 | wrapper : plua_MethodWrapper; 46 | end; 47 | 48 | TLuaClassInfo = record 49 | Parent : PLuaClassInfo; 50 | ClassName : String; 51 | New : plua_ClassConstructor; 52 | Release : plua_ClassDestructor; 53 | PropHandlers: TWordList; 54 | UnhandledReader : plua_PropertyReader; 55 | UnhandledWriter : plua_PropertyWriter; 56 | Properties : Array of TLuaClassProperty; 57 | Methods : Array of TLuaClassMethod; 58 | end; 59 | 60 | TLuaInstanceInfo = record 61 | OwnsObject: Boolean; 62 | LuaRef : Integer; 63 | ClassInfo : PLuaClassInfo; 64 | l : PLua_state; 65 | obj : TObject; 66 | Delegate : TLuaObjectEventDelegate; 67 | end; 68 | 69 | { TLuaClassList } 70 | 71 | TLuaClassList = class 72 | fItems : TList; 73 | private 74 | function GetClassInfo(index : integer): PLuaClassInfo; 75 | function GetCount: integer; 76 | public 77 | constructor Create; 78 | destructor Destroy; override; 79 | 80 | function GetPropReader(aClassInfo : PLuaClassInfo; aPropertyName : String) : plua_PropertyReader; 81 | function GetPropWriter(aClassInfo : PLuaClassInfo; aPropertyName : String; out ReadOnly : Boolean) : plua_PropertyWriter; 82 | 83 | function GetInfo(l : Plua_State; InstanceObject : TObject) : PLuaInstanceInfo; 84 | 85 | function Add(aClassInfo : TLuaClassInfo) : Integer; 86 | procedure Remove(aClassName : String); 87 | function IndexOf(aClassName : String) : Integer; 88 | procedure Clear; 89 | property Count : integer read GetCount; 90 | property LClassInfo[index : integer]:PLuaClassInfo read GetClassInfo; default; 91 | end; 92 | 93 | { TLuaObjectEventDelegate } 94 | 95 | TLuaObjectEventDelegate = class 96 | protected 97 | FInstanceInfo : PLuaInstanceInfo; 98 | FObj : TObject; 99 | 100 | function EventExists( EventName :String ) : Boolean; 101 | function CallEvent( EventName :String ) : Integer; overload; 102 | function CallEvent( EventName :String; 103 | const Args: array of Variant ) : Integer; overload; 104 | function CallEvent( EventName :String; 105 | const Args: array of Variant; 106 | Results : PVariantArray = nil):Integer; overload; 107 | public 108 | constructor Create(InstanceInfo : PLuaInstanceInfo; obj : TObject); virtual; 109 | destructor Destroy; override; 110 | end; 111 | 112 | { TLuaClassTypesList } 113 | 114 | TLuaClassTypesList = class 115 | fItems : TWordList; 116 | fItemList : TList; 117 | private 118 | function GetCount: Integer; 119 | function GetIndexedItem(index : integer): PLuaClassInfo; 120 | function GetItem(ItemName : String): PLuaClassInfo; 121 | public 122 | constructor Create; 123 | destructor Destroy; override; 124 | 125 | function Add(ItemName : String; LuaParent : PLuaClassInfo = nil) : PLuaClassInfo; 126 | procedure Remove(ItemName : String); 127 | procedure Clear; 128 | 129 | procedure RegisterTo(L : PLua_State); 130 | 131 | property Item[ItemName : String] : PLuaClassInfo read GetItem; default; 132 | property IndexedItem[index : integer] : PLuaClassInfo read GetIndexedItem; 133 | property Count : Integer read GetCount; 134 | end; 135 | 136 | procedure plua_registerclass( l : PLua_State; classInfo : TLuaClassInfo); 137 | procedure plua_newClassInfo( var ClassInfoPointer : PLuaClassInfo); 138 | procedure plua_initClassInfo( var ClassInfo : TLuaClassInfo); 139 | procedure plua_releaseClassInfo( var ClassInfoPointer : PLuaClassInfo); 140 | 141 | procedure plua_AddClassProperty( var ClassInfo : TLuaClassInfo; 142 | propertyName : String; 143 | Reader : plua_PropertyReader; 144 | Writer : plua_PropertyWriter ); 145 | procedure plua_AddClassMethod( var ClassInfo : TLuaClassInfo; 146 | methodName : String; 147 | wrapper : plua_MethodWrapper ); 148 | 149 | function plua_getObject( l : PLua_State; idx : Integer) : TObject; 150 | function plua_getObjectInfo( l : PLua_State; idx : Integer) : PLuaInstanceInfo; overload; 151 | 152 | function plua_registerExisting( l : PLua_State; InstanceName : String; 153 | ObjectInstance : TObject; 154 | classInfo : PLuaClassInfo; 155 | FreeOnGC : Boolean = false) : PLuaInstanceInfo; 156 | function plua_pushexisting( l : PLua_State; 157 | ObjectInstance : TObject; 158 | classInfo : PLuaClassInfo; 159 | FreeOnGC : Boolean = false) : PLuaInstanceInfo; 160 | 161 | function plua_PushObject(ObjectInfo : PLuaInstanceInfo) : Boolean; 162 | function plua_GetObjectInfo(l : Plua_State; InstanceObject : TObject) : PLuaInstanceInfo; overload; 163 | function plua_ObjectEventExists( ObjectInfo : PLuaInstanceInfo; 164 | EventName :String ) : Boolean; 165 | function plua_CallObjectEvent( ObjectInfo : PLuaInstanceInfo; 166 | EventName :String; 167 | const Args: array of Variant; 168 | Results : PVariantArray = nil):Integer; 169 | 170 | function plua_GetEventDeletage( Obj : TObject ) : TLuaObjectEventDelegate; 171 | 172 | procedure plua_ClearObjects(L : PLua_State); 173 | 174 | var 175 | LuaClasses : TLuaClassList; 176 | LuaDelegates : TList; 177 | ClassTypesList : TLuaClassTypesList; 178 | 179 | implementation 180 | 181 | uses 182 | typinfo, types; 183 | 184 | var 185 | LuaObjects : TList; 186 | 187 | function plua_gc_class(l : PLua_State) : integer; cdecl; forward; 188 | 189 | function plua_index_class(l : PLua_State) : integer; cdecl; 190 | var 191 | propName : String; 192 | propValueStart : Integer; 193 | obj : TObject; 194 | cInfo : PLuaInstanceInfo; 195 | reader : plua_PropertyReader; 196 | v : variant; 197 | pcount : Integer; 198 | begin 199 | result := 0; 200 | pcount := lua_gettop(l); 201 | if not lua_istable(l, 1) then 202 | exit; 203 | 204 | cInfo := plua_getObjectInfo(l, 1); 205 | if not assigned(cInfo) then 206 | exit; 207 | obj := cInfo^.obj; 208 | 209 | propName := lua_tostring(l, 2); 210 | propValueStart := 3; 211 | reader := LuaClasses.GetPropReader(cInfo^.ClassInfo, propName); 212 | if assigned(reader) then 213 | result := reader(obj, l, propValueStart, pcount) 214 | else 215 | begin 216 | if IsPublishedProp(obj, propName) then 217 | begin 218 | try 219 | v := GetPropValue(obj, propName); 220 | plua_pushvariant(l, v); 221 | result := 1; 222 | except 223 | end; 224 | end; 225 | end; 226 | end; 227 | 228 | function plua_newindex_class(l : PLua_State) : integer; cdecl; 229 | var 230 | propName : String; 231 | propValueStart : Integer; 232 | obj : TObject; 233 | cInfo : PLuaInstanceInfo; 234 | writer : plua_PropertyReader; 235 | bReadOnly: Boolean; 236 | pcount : Integer; 237 | begin 238 | result := 0; 239 | pcount := lua_gettop(l); 240 | if not lua_istable(l, 1) then 241 | exit; 242 | 243 | cinfo := plua_getObjectInfo(l, 1); 244 | if not assigned(cInfo) then 245 | exit; 246 | obj := cInfo^.obj; 247 | 248 | propName := lua_tostring(l, 2); 249 | propValueStart := 3; 250 | writer := LuaClasses.GetPropWriter(cInfo^.ClassInfo, propName, bReadOnly); 251 | if assigned(writer) then 252 | result := writer(obj, l, propValueStart, pcount) 253 | else 254 | begin 255 | if not bReadOnly then 256 | begin 257 | lua_pushstring(l, propName); 258 | lua_pushvalue(l, propValueStart); 259 | lua_rawset(l, 1); 260 | end; 261 | end; 262 | end; 263 | 264 | function plua_call_class_method(l : PLua_State) : integer; cdecl; 265 | var 266 | method : plua_MethodWrapper; 267 | obj : TObject; 268 | pcount : Integer; 269 | begin 270 | result := 0; 271 | pcount := lua_gettop(l); 272 | obj := plua_getObject(l, 1); 273 | method := plua_MethodWrapper(PtrInt(lua_tointeger(l, lua_upvalueindex(1)))); 274 | 275 | if assigned(obj) and assigned(method) then 276 | result := method(obj, l, 2, pcount); 277 | end; 278 | 279 | function plua_new_class(l : PLua_State) : integer; cdecl; 280 | var 281 | i, n, tidx, oidx : Integer; 282 | classPTR: Pointer; 283 | cInfo : PLuaClassInfo; 284 | instance: PLuaInstanceInfo; 285 | pcount : integer; 286 | begin 287 | pcount := lua_gettop(l); 288 | result := 0; 289 | n := lua_gettop(l); 290 | if (n < 1) or (not (lua_istable(l, 1))) then 291 | exit; 292 | 293 | tidx := 1; 294 | 295 | lua_pushstring(l, '__classPTR'); 296 | lua_rawget(l, tidx); 297 | classPTR := pointer(PtrInt(lua_tointeger(l, -1))); 298 | cInfo := PLuaClassInfo(classPTR); 299 | lua_pop(l, 1); 300 | 301 | new(instance); 302 | instance^.OwnsObject := true; 303 | instance^.ClassInfo := cInfo; 304 | instance^.l := l; 305 | //if cInfo^.New <> nil then 306 | if assigned(cInfo^.New) then // FD: 16/05/2010, added assigned 307 | instance^.obj := cInfo^.New(l, 2, pcount, instance) 308 | else 309 | instance^.obj := TObject.Create; 310 | LuaObjects.Add(pointer(instance)); 311 | 312 | lua_newtable(L); 313 | instance^.LuaRef := luaL_ref(L, LUA_REGISTRYINDEX); 314 | lua_rawgeti(l, LUA_REGISTRYINDEX, instance^.LuaRef); 315 | oidx := lua_gettop(L); 316 | 317 | lua_pushliteral(L, '__instance'); 318 | lua_pushinteger(L, PtrInt(instance)); 319 | lua_rawset(l, oidx); 320 | 321 | lua_pushstring(L, 'release'); 322 | lua_pushcfunction(L, @plua_gc_class); 323 | lua_rawset(L, oidx); 324 | // TODO - Add parent method calls in 325 | for i := 0 to Length(cInfo^.Methods)-1 do 326 | begin 327 | lua_pushstring(L, cInfo^.Methods[i].MethodName); 328 | lua_pushinteger(l, PtrInt(@cInfo^.Methods[i].wrapper)); 329 | lua_pushcclosure(L, @plua_call_class_method, 1); 330 | lua_rawset(l, -3); 331 | end; 332 | 333 | luaL_getmetatable(l, PAnsiChar(AnsiString(cinfo^.ClassName)+'_mt')); 334 | lua_setmetatable(l, -2); 335 | 336 | result := 1; 337 | end; 338 | 339 | function plua_gc_class(l : PLua_State) : integer; cdecl; 340 | var 341 | nfo : PLuaInstanceInfo; 342 | d : TLuaObjectEventDelegate; 343 | begin 344 | result := 0; 345 | nfo := plua_getObjectInfo(l, 1); 346 | if not assigned(nfo) then 347 | exit; 348 | LuaObjects.Remove(nfo); 349 | d := plua_GetEventDeletage(nfo^.obj); 350 | if assigned(d) then 351 | d.Free; 352 | if nfo^.OwnsObject then 353 | begin 354 | if assigned(nfo^.ClassInfo^.Release) then 355 | nfo^.ClassInfo^.Release(nfo^.obj, l) 356 | else 357 | nfo^.obj.Free; 358 | end; 359 | luaL_unref(L, LUA_REGISTRYINDEX, nfo^.LuaRef); 360 | freemem(nfo); 361 | end; 362 | 363 | procedure plua_registerclass(l: PLua_State; classInfo: TLuaClassInfo); 364 | var 365 | lidx, tidx, midx: integer; 366 | ci : PLuaClassInfo; 367 | begin 368 | lidx := LuaClasses.Add(classInfo); 369 | 370 | lua_pushstring(l, classInfo.ClassName); 371 | lua_newtable(l); 372 | 373 | luaL_newmetatable(l, PAnsiChar(AnsiString(classInfo.ClassName)+'_mt')); 374 | lua_setmetatable(l, -2); 375 | lua_settable(l, LUA_GLOBALSINDEX); 376 | 377 | luaL_getmetatable(l, PAnsiChar(AnsiString(classInfo.ClassName)+'_mt')); 378 | midx := lua_gettop(l); 379 | 380 | lua_pushstring(l, classInfo.ClassName); 381 | lua_gettable(l, LUA_GLOBALSINDEX); 382 | tidx := lua_gettop(l); 383 | 384 | lua_pushstring(L, '__call'); 385 | lua_pushcfunction(L, @plua_new_class); 386 | lua_rawset(L, midx); 387 | lua_pushstring(L, '__gc'); 388 | lua_pushcfunction(L, @plua_gc_class); 389 | lua_rawset(L, midx); 390 | 391 | lua_pushstring(L, 'new'); 392 | lua_pushcfunction(L, @plua_new_class); 393 | lua_rawset(L, tidx); 394 | 395 | lua_pushstring(L, '__classID'); 396 | lua_pushinteger(L, lidx); 397 | lua_rawset(L, tidx); 398 | lua_pushstring(L, '__classPTR'); 399 | ci := LuaClasses.LClassInfo[lidx]; 400 | lua_pushinteger(L, PtrInt(ci)); 401 | lua_rawset(L, tidx); 402 | 403 | lua_pushstring(L, '__index'); 404 | lua_pushcfunction(L, @plua_index_class); 405 | lua_rawset(L, midx); 406 | lua_pushstring(L, '__newindex'); 407 | lua_pushcfunction(L, @plua_newindex_class); 408 | lua_rawset(L, midx); 409 | end; 410 | 411 | procedure plua_newClassInfo(var ClassInfoPointer: PLuaClassInfo); 412 | begin 413 | if ClassInfoPointer = nil then 414 | new(ClassInfoPointer); 415 | plua_initClassInfo(ClassInfoPointer^); 416 | end; 417 | 418 | procedure plua_initClassInfo( var ClassInfo: TLuaClassInfo); 419 | begin 420 | ClassInfo.ClassName := ''; 421 | ClassInfo.Parent := nil; 422 | ClassInfo.New := nil; 423 | ClassInfo.Release := nil; 424 | ClassInfo.PropHandlers := TWordList.Create; 425 | ClassInfo.UnhandledReader := nil; 426 | ClassInfo.UnhandledWriter := nil; 427 | SetLength(ClassInfo.Properties, 0); 428 | SetLength(ClassInfo.Methods, 0); 429 | end; 430 | 431 | procedure plua_releaseClassInfo(var ClassInfoPointer: PLuaClassInfo); 432 | begin 433 | ClassInfoPointer^.PropHandlers.Free; 434 | Freemem(ClassInfoPointer); 435 | end; 436 | 437 | procedure plua_AddClassProperty(var ClassInfo: TLuaClassInfo; 438 | propertyName: String; Reader: plua_PropertyReader; 439 | Writer: plua_PropertyWriter); 440 | var 441 | idx : integer; 442 | begin 443 | idx := Length(ClassInfo.Properties); 444 | SetLength(ClassInfo.Properties, idx+1); 445 | ClassInfo.Properties[idx].PropName := propertyName; 446 | ClassInfo.Properties[idx].Reader := Reader; 447 | ClassInfo.Properties[idx].Writer := Writer; 448 | ClassInfo.PropHandlers.AddWord(ansistring(propertyName))^.data := pointer(PtrInt(idx)); 449 | end; 450 | 451 | procedure plua_AddClassMethod(var ClassInfo: TLuaClassInfo; 452 | methodName: String; wrapper: plua_MethodWrapper); 453 | var 454 | idx : integer; 455 | begin 456 | idx := Length(ClassInfo.Methods); 457 | SetLength(ClassInfo.Methods, idx+1); 458 | ClassInfo.Methods[idx].MethodName := methodName; 459 | ClassInfo.Methods[idx].wrapper := wrapper; 460 | end; 461 | 462 | function plua_getObject(l: PLua_State; idx: Integer): TObject; 463 | var 464 | instance : PLuaInstanceInfo; 465 | begin 466 | result := nil; 467 | lua_pushstring(l, '__instance'); 468 | lua_rawget(l, plua_absindex(l, idx)); 469 | instance := PLuaInstanceInfo(ptrint(lua_tointeger(l, -1))); 470 | lua_pop(l, 1); 471 | if assigned(instance) and assigned(instance^.obj) then 472 | result := instance^.obj; 473 | end; 474 | 475 | function plua_getObjectInfo(l: PLua_State; idx: Integer): PLuaInstanceInfo; 476 | begin 477 | //result := nil; 478 | lua_pushstring(l, '__instance'); 479 | lua_rawget(l, plua_absindex(l, idx)); 480 | result := PLuaInstanceInfo(ptrint(lua_tointeger(l, -1))); 481 | lua_pop(l, 1); 482 | end; 483 | 484 | function plua_registerExisting(l: PLua_State; InstanceName: String; 485 | ObjectInstance: TObject; classInfo: PLuaClassInfo; 486 | FreeOnGC : Boolean = false) : PLuaInstanceInfo; 487 | var 488 | i, oidx : Integer; 489 | cInfo : PLuaClassInfo; 490 | instance: PLuaInstanceInfo; 491 | begin 492 | instance := plua_GetObjectInfo(l, ObjectInstance); 493 | if assigned(instance) then 494 | begin 495 | lua_pushstring(l, InstanceName); 496 | plua_PushObject(instance); 497 | lua_settable(l, LUA_GLOBALSINDEX); 498 | result := instance; 499 | exit; 500 | end; 501 | 502 | cInfo := classInfo; 503 | 504 | new(instance); 505 | result := instance; 506 | instance^.OwnsObject := FreeOnGC; 507 | instance^.ClassInfo := cInfo; 508 | instance^.l := l; 509 | instance^.obj := ObjectInstance; 510 | 511 | LuaObjects.Add(pointer(instance)); 512 | 513 | lua_pushstring(l, InstanceName); 514 | lua_newtable(L); 515 | instance^.LuaRef := luaL_ref(L, LUA_REGISTRYINDEX); 516 | lua_rawgeti(l, LUA_REGISTRYINDEX, instance^.LuaRef); 517 | oidx := lua_gettop(L); 518 | 519 | lua_pushliteral(L, '__instance'); 520 | lua_pushinteger(L, PtrInt(instance)); 521 | lua_rawset(l, oidx); 522 | 523 | lua_pushstring(L, 'release'); 524 | lua_pushcfunction(L, @plua_gc_class); 525 | lua_rawset(L, oidx); 526 | 527 | // TODO - Add parent method calls in 528 | for i := 0 to Length(cInfo^.Methods)-1 do 529 | begin 530 | lua_pushstring(L, cInfo^.Methods[i].MethodName); 531 | lua_pushinteger(l, PtrInt(@cInfo^.Methods[i].wrapper)); 532 | lua_pushcclosure(L, @plua_call_class_method, 1); 533 | lua_rawset(l, -3); 534 | end; 535 | 536 | luaL_getmetatable(l, PAnsiChar(ansistring(cinfo^.ClassName)+'_mt')); 537 | lua_setmetatable(l, -2); 538 | 539 | lua_settable(l, LUA_GLOBALSINDEX ); 540 | end; 541 | 542 | function plua_pushexisting(l: PLua_State; ObjectInstance: TObject; 543 | classInfo: PLuaClassInfo; FreeOnGC: Boolean): PLuaInstanceInfo; 544 | var 545 | i, oidx : Integer; 546 | cInfo : PLuaClassInfo; 547 | instance: PLuaInstanceInfo; 548 | begin 549 | instance := plua_GetObjectInfo(l, ObjectInstance); 550 | if assigned(instance) then 551 | begin 552 | plua_PushObject(instance); 553 | result := instance; 554 | exit; 555 | end; 556 | 557 | cInfo := classInfo; 558 | 559 | new(instance); 560 | result := instance; 561 | instance^.OwnsObject := FreeOnGC; 562 | instance^.ClassInfo := cInfo; 563 | instance^.l := l; 564 | instance^.obj := ObjectInstance; 565 | 566 | LuaObjects.Add(pointer(instance)); 567 | 568 | lua_newtable(L); 569 | instance^.LuaRef := luaL_ref(L, LUA_REGISTRYINDEX); 570 | lua_rawgeti(l, LUA_REGISTRYINDEX, instance^.LuaRef); 571 | oidx := lua_gettop(L); 572 | 573 | lua_pushliteral(L, '__instance'); 574 | lua_pushinteger(L, PtrInt(instance)); 575 | lua_rawset(l, oidx); 576 | 577 | lua_pushstring(L, 'release'); 578 | lua_pushcfunction(L, @plua_gc_class); 579 | lua_rawset(L, oidx); 580 | 581 | // TODO - Add parent method calls in 582 | for i := 0 to Length(cInfo^.Methods)-1 do 583 | begin 584 | lua_pushstring(L, cInfo^.Methods[i].MethodName); 585 | lua_pushinteger(l, PtrInt(@cInfo^.Methods[i].wrapper)); 586 | lua_pushcclosure(L, @plua_call_class_method, 1); 587 | lua_rawset(l, -3); 588 | end; 589 | 590 | luaL_getmetatable(l, PAnsiChar(AnsiString(cinfo^.ClassName)+'_mt')); 591 | lua_setmetatable(l, -2); 592 | end; 593 | 594 | function plua_PushObject(ObjectInfo: PLuaInstanceInfo) : Boolean; 595 | begin 596 | result := true; 597 | if assigned(ObjectInfo) then 598 | lua_rawgeti(ObjectInfo^.l, LUA_REGISTRYINDEX, ObjectInfo^.LuaRef) 599 | else 600 | result := false; 601 | end; 602 | 603 | function plua_GetObjectInfo(l : Plua_State; InstanceObject: TObject): PLuaInstanceInfo; 604 | begin 605 | result := LuaClasses.GetInfo(l, InstanceObject); 606 | end; 607 | 608 | function plua_ObjectEventExists(ObjectInfo: PLuaInstanceInfo; 609 | EventName: String): Boolean; 610 | begin 611 | plua_PushObject(ObjectInfo); 612 | result := plua_functionexists(ObjectInfo^.l, EventName, lua_gettop(ObjectInfo^.l), false); 613 | lua_pop(ObjectInfo^.L, 1); 614 | end; 615 | 616 | function plua_CallObjectEvent(ObjectInfo: PLuaInstanceInfo; 617 | EventName: String; const Args: array of Variant; Results: PVariantArray 618 | ): Integer; 619 | var 620 | idx : integer; 621 | begin 622 | result := -1; 623 | if not plua_ObjectEventExists(ObjectInfo, EventName) then 624 | exit; 625 | plua_PushObject(ObjectInfo); 626 | idx := lua_gettop(ObjectInfo^.l); 627 | result := plua_callfunction(ObjectInfo^.l, EventName, args, results, idx); 628 | end; 629 | 630 | function plua_GetEventDeletage(Obj: TObject): TLuaObjectEventDelegate; 631 | var 632 | d : TLuaObjectEventDelegate; 633 | i : Integer; 634 | begin 635 | result := nil; 636 | i := 0; 637 | while (not assigned(result)) and (i < LuaDelegates.Count) do 638 | begin 639 | d := TLuaObjectEventDelegate(LuaDelegates[i]); 640 | if d.FInstanceInfo^.obj = obj then 641 | result := d; 642 | inc(i); 643 | end; 644 | end; 645 | 646 | procedure plua_ClearObjects(L: PLua_State); 647 | var 648 | i : Integer; 649 | nfo : PLuaInstanceInfo; 650 | begin 651 | i := LuaObjects.Count-1; 652 | while i > -1 do 653 | begin 654 | nfo := PLuaInstanceInfo(LuaObjects[i]); 655 | if nfo^.l = l then 656 | LuaObjects.Remove(nfo); 657 | dec(i); 658 | end; 659 | end; 660 | 661 | { TLuaClassList } 662 | 663 | function TLuaClassList.GetClassInfo(index : integer): PLuaClassInfo; 664 | begin 665 | result := PLuaClassInfo(fItems[index]); 666 | end; 667 | 668 | function TLuaClassList.GetCount: integer; 669 | begin 670 | result := fItems.Count; 671 | end; 672 | 673 | constructor TLuaClassList.Create; 674 | begin 675 | fItems := TList.Create; 676 | end; 677 | 678 | destructor TLuaClassList.Destroy; 679 | begin 680 | Clear; 681 | fItems.Free; 682 | inherited Destroy; 683 | end; 684 | 685 | function TLuaClassList.GetPropReader(aClassInfo: PLuaClassInfo; 686 | aPropertyName: String): plua_PropertyReader; 687 | var 688 | pi : PtrInt; 689 | ei : PWordListSymbol; 690 | begin 691 | // TODO - Add parent property calls in 692 | result := nil; 693 | ei := aClassInfo^.PropHandlers.WordSymbol[ansistring(aPropertyName)]; 694 | if not assigned(ei) then 695 | begin 696 | if assigned(aClassInfo^.UnhandledReader) then 697 | result := aClassInfo^.UnhandledReader; 698 | exit; 699 | end; 700 | pi := PtrInt(ei^.data); 701 | if (pi >= 0) and (pi < length(aClassInfo^.Properties)) then 702 | result := aClassInfo^.Properties[pi].Reader; 703 | end; 704 | 705 | function TLuaClassList.GetPropWriter(aClassInfo: PLuaClassInfo; 706 | aPropertyName: String; out ReadOnly : Boolean): plua_PropertyWriter; 707 | var 708 | pi : PtrInt; 709 | ei : PWordListSymbol; 710 | begin 711 | // TODO - Add parent property calls in 712 | ReadOnly := false; 713 | result := nil; 714 | ei := aClassInfo^.PropHandlers.WordSymbol[ansistring(aPropertyName)]; 715 | if not assigned(ei) then 716 | begin 717 | if assigned(aClassInfo^.UnhandledWriter) then 718 | result := aClassInfo^.UnhandledWriter; 719 | exit; 720 | end; 721 | pi := PtrInt(ei^.data); 722 | if (pi >= 0) and (pi < length(aClassInfo^.Properties)) then 723 | begin 724 | ReadOnly := @aClassInfo^.Properties[pi].Writer = nil; 725 | result := aClassInfo^.Properties[pi].Writer; 726 | end; 727 | end; 728 | 729 | function TLuaClassList.GetInfo(l : Plua_State; InstanceObject: TObject): PLuaInstanceInfo; 730 | var 731 | i : Integer; 732 | begin 733 | result := nil; 734 | i := 0; 735 | while (result = nil) and (i < LuaObjects.Count) do 736 | begin 737 | if (PLuaInstanceInfo(LuaObjects[i])^.obj = InstanceObject) and 738 | (PLuaInstanceInfo(LuaObjects[i])^.l = l) then 739 | result := PLuaInstanceInfo(LuaObjects[i]); 740 | inc(i); 741 | end; 742 | end; 743 | 744 | function TLuaClassList.Add(aClassInfo: TLuaClassInfo) : Integer; 745 | var 746 | ci : PLuaClassInfo; 747 | begin 748 | result := IndexOf(aClassInfo.ClassName); 749 | if result = -1 then 750 | begin 751 | new(ci); 752 | result := fItems.Add(ci); 753 | end 754 | else 755 | ci := LClassInfo[result]; 756 | ci^ := aClassInfo; 757 | end; 758 | 759 | procedure TLuaClassList.Remove(aClassName: String); 760 | var 761 | idx : integer; 762 | ci : PLuaClassInfo; 763 | begin 764 | idx := IndexOf(aClassName); 765 | if idx > -1 then 766 | begin 767 | ci := LClassInfo[idx]; 768 | fItems.Delete(idx); 769 | Freemem(ci); 770 | end; 771 | end; 772 | 773 | function TLuaClassList.IndexOf(aClassName: String): Integer; 774 | var 775 | i : Integer; 776 | begin 777 | result := -1; 778 | i := 0; 779 | while (result = -1) and (i < count) do 780 | begin 781 | if CompareText(aClassName, LClassInfo[i]^.ClassName) = 0 then 782 | result := i; 783 | inc(i); 784 | end; 785 | end; 786 | 787 | procedure TLuaClassList.Clear; 788 | var 789 | ci : PLuaClassInfo; 790 | begin 791 | while count > 0 do 792 | begin 793 | ci := LClassInfo[count-1]; 794 | fItems.Delete(count-1); 795 | Freemem(ci); 796 | end; 797 | end; 798 | 799 | var 800 | instance : PLuaInstanceInfo; 801 | 802 | { TLuaObjectEventDelegate } 803 | 804 | function TLuaObjectEventDelegate.EventExists(EventName: String): Boolean; 805 | begin 806 | result := plua_ObjectEventExists(FInstanceInfo, EventName); 807 | end; 808 | 809 | function TLuaObjectEventDelegate.CallEvent(EventName: String): Integer; 810 | begin 811 | result := CallEvent(EventName, [], nil); 812 | end; 813 | 814 | function TLuaObjectEventDelegate.CallEvent(EventName: String; 815 | const Args: array of Variant): Integer; 816 | begin 817 | result := CallEvent(EventName, Args, nil); 818 | end; 819 | 820 | function TLuaObjectEventDelegate.CallEvent(EventName: String; 821 | const Args: array of Variant; Results: PVariantArray): Integer; 822 | begin 823 | result := plua_CallObjectEvent(FInstanceInfo, EventName, Args, Results); 824 | end; 825 | 826 | constructor TLuaObjectEventDelegate.Create(InstanceInfo: PLuaInstanceInfo; obj : TObject); 827 | begin 828 | LuaDelegates.Add(Self); 829 | FInstanceInfo := InstanceInfo; 830 | FObj := obj; 831 | InstanceInfo^.Delegate := self; 832 | end; 833 | 834 | destructor TLuaObjectEventDelegate.Destroy; 835 | begin 836 | LuaDelegates.Remove(self); 837 | FInstanceInfo^.Delegate := nil; 838 | inherited Destroy; 839 | end; 840 | 841 | { TLuaClassTypesList } 842 | 843 | function TLuaClassTypesList.GetCount: Integer; 844 | begin 845 | result := fItemList.Count; 846 | end; 847 | 848 | function TLuaClassTypesList.GetIndexedItem(index : integer): PLuaClassInfo; 849 | begin 850 | result := PLuaClassInfo(fItemList[index]); 851 | end; 852 | 853 | function TLuaClassTypesList.GetItem(ItemName : String): PLuaClassInfo; 854 | begin 855 | result := PLuaClassInfo(fItems.WordData[AnsiString(ItemName)]); 856 | end; 857 | 858 | constructor TLuaClassTypesList.Create; 859 | begin 860 | fItems := TWordList.Create; 861 | fItemList := TList.Create; 862 | end; 863 | 864 | destructor TLuaClassTypesList.Destroy; 865 | begin 866 | Clear; 867 | fItems.Free; 868 | fItemList.Free; 869 | inherited Destroy; 870 | end; 871 | 872 | function TLuaClassTypesList.Add(ItemName: String; LuaParent : PLuaClassInfo = nil): PLuaClassInfo; 873 | begin 874 | result := PLuaClassInfo(fItems.WordData[AnsiString(ItemName)]); 875 | if not assigned(result) then 876 | begin 877 | plua_newClassInfo(result); 878 | result^.Parent := LuaParent; 879 | result^.ClassName := ItemName; 880 | fItems.AddWord(ansistring(ItemName))^.data := result; 881 | fItemList.Add(result); 882 | end; 883 | end; 884 | 885 | procedure TLuaClassTypesList.Remove(ItemName: String); 886 | var 887 | wd : PWordListSymbol; 888 | ci : PLuaClassInfo; 889 | begin 890 | wd := fItems.WordSymbol[ansistring(ItemName)]; 891 | if (assigned(wd)) and (assigned(wd^.data)) and (wd^.eow) then 892 | begin 893 | ci := PLuaClassInfo(wd^.data); 894 | fItemList.Remove(wd^.data); 895 | wd^.data := nil; 896 | wd^.eow := false; 897 | plua_releaseClassInfo(ci); 898 | end; 899 | end; 900 | 901 | procedure TLuaClassTypesList.Clear; 902 | begin 903 | while Count > 0 do 904 | Remove(IndexedItem[Count-1]^.ClassName); 905 | end; 906 | 907 | procedure TLuaClassTypesList.RegisterTo(L: PLua_State); 908 | var 909 | i : Integer; 910 | begin 911 | for i := 0 to Count-1 do 912 | plua_registerclass(l, IndexedItem[i]^); 913 | end; 914 | 915 | initialization 916 | LuaClasses := TLuaClassList.Create; 917 | LuaObjects := TList.Create; 918 | LuaDelegates := TList.Create; 919 | ClassTypesList := TLuaClassTypesList.Create; 920 | 921 | finalization 922 | while LuaObjects.Count > 0 do 923 | begin 924 | instance := PLuaInstanceInfo(LuaObjects[LuaObjects.Count-1]); 925 | LuaObjects.Delete(LuaObjects.Count-1); 926 | if instance^.OwnsObject then 927 | begin 928 | if assigned(instance^.ClassInfo^.Release) then 929 | instance^.ClassInfo^.Release(instance^.obj, nil) 930 | else 931 | instance^.obj.Free; 932 | end; 933 | if Instance^.Delegate <> nil then 934 | Instance^.Delegate.Free; 935 | Freemem(instance); 936 | end; 937 | LuaObjects.Free; 938 | LuaObjects := nil; 939 | ClassTypesList.Free; 940 | LuaClasses.Free; 941 | LuaClasses := nil; 942 | LuaDelegates.Free; 943 | LuaDelegates := nil; 944 | 945 | end. 946 | -------------------------------------------------------------------------------- /src/pLua.pas: -------------------------------------------------------------------------------- 1 | unit pLua; 2 | 3 | { 4 | Copyright (c) 2007 Jeremy Darling 5 | Modifications and additions copyright (c) 2010-2020 Felipe Daragon 6 | 7 | License: MIT (http://opensource.org/licenses/mit-license.php) 8 | Same as the original code by Jeremy Darling. 9 | 10 | Changes: 11 | 12 | * 07.10.2020, FD - Added plua_tovariantrec for storing the lua type and 13 | value converted to Variant 14 | * 29.09.2020, FD - Validate LUA_TNIL in argument when requested 15 | * 26.09.2020, FD - Added new functions for method call validation and 16 | improved validation functions 17 | * 25.09.2020, FD - Added plua_LocateCFunctionInArray and 18 | plua_pushcfunction_fromarray 19 | * 24.09.2020, FD - Added plua_tablefunctionexists and plua_tablecallfunction. 20 | * 21.09.2020, FD - Added strict type validation functions 21 | * 20.09.2020, FD - Added plua_validateargsets and plua_validateargscount, 22 | and improved validation functions. 23 | * 18.09.2020, FD - Added plua_validateargs and plua_validatetype functions. 24 | * 17.09.2020, FD - plua_functionexists now checks C function. 25 | - Added plua_pushintnumber 26 | * 16.09.2020, FD - Fixed occasional crash with plua_SetLocal. 27 | * 30.11.2015, FD - Fixed occasional crash with plua_functionexists. 28 | * 26.06.2014, FD - Changed to work with string instead of ansistring. 29 | * 18.06.2014, FD - Added several functions for getting/setting the 30 | value of local/global Lua variables 31 | * 17.06.2014, FD - Added plua_dostring 32 | * 19.05.2014, FD - Added backwards compatibility with non-unicode Delphi. 33 | * 06.05.2013, FD - Added support for Delphi XE2 or higher. 34 | } 35 | 36 | {$IFDEF FPC} 37 | {$mode objfpc}{$H+} 38 | {$modeswitch nestedprocvars} 39 | {$ENDIF} 40 | 41 | interface 42 | 43 | {$I Lua.inc} 44 | 45 | uses 46 | SysUtils, Classes, Variants, Lua; 47 | 48 | const 49 | cLuaGlobalVariableStr = '[LUA_GLOBALSINDEX]'; 50 | var 51 | DefaultMaxTable, SubTableCount: Integer; 52 | 53 | type 54 | PtrInt = Integer; 55 | PtrUint = Cardinal; 56 | TVariantArray = array of Variant; 57 | PVariantArray = ^TVariantArray; 58 | 59 | type 60 | LuaException = class(Exception) 61 | end; 62 | 63 | procedure plua_RegisterLuaTable(L: PLua_State; Name: string; 64 | Reader: lua_CFunction = nil; Writer: lua_CFunction = nil; 65 | TableIndex: Integer = LUA_GLOBALSINDEX); 66 | 67 | function plua_functionexists(L: PLua_State; FunctionName: string; 68 | TableIndex: Integer = LUA_GLOBALSINDEX; 69 | const allowcfunction:boolean=true): boolean; 70 | 71 | function plua_callfunction(L: PLua_State; FunctionName: string; 72 | const args: Array of Variant; results: PVariantArray = nil; 73 | TableIndex: Integer = LUA_GLOBALSINDEX): Integer; 74 | 75 | procedure plua_pushintnumber(L: PLua_State; N: Integer); 76 | 77 | procedure plua_pushvariant(L: PLua_State; v: Variant); 78 | 79 | function plua_TableToVariantArray(L: PLua_State; Index: Integer; 80 | Keys: TStrings = nil): Variant; 81 | function plua_tovariant(L: PLua_State; Index: Integer): Variant; 82 | 83 | function plua_absindex(L: PLua_State; Index: Integer): Integer; 84 | 85 | procedure plua_spliterrormessage(const ErrMsg: string; out Title: string; 86 | out Line: Integer; out Msg: string); 87 | 88 | procedure plua_CopyTable(L: PLua_State; IdxFrom, IdxTo: Integer); 89 | 90 | procedure plua_RegisterMethod(L: PLua_State; aMethodName: string; 91 | MethodPtr: lua_CFunction; totable: Integer = LUA_GLOBALSINDEX); 92 | 93 | procedure plua_GetTableKey(L: PLua_State; TableIndex: Integer; KeyName: string); 94 | 95 | procedure plua_pushansistring(L: PLua_State; AString: ansistring); 96 | function plua_toansistring(L: PLua_State; Index: Integer): ansistring; 97 | 98 | { FD: Additions by Felipe Daragon } 99 | 100 | type 101 | TLuaTypeRange = 1..9; // LUA_TSTRING, etc. 102 | TLuaTypeSet = set of 1..9; // LUA_TSTRING, etc. 103 | 104 | type 105 | TLuaFunctionSearchResult = record 106 | found : boolean; 107 | reg: luaL_Reg; 108 | end; 109 | 110 | type 111 | TValuaResult = record 112 | OK:boolean; 113 | ErrorMessage:string; 114 | ArgsCount:integer; 115 | ArgsCountFromTop:integer; 116 | end; 117 | 118 | type 119 | TVaLuaSettings = record 120 | optional:integer; 121 | ignore:integer; 122 | stricttype:boolean; 123 | end; 124 | 125 | type 126 | TLuaVariantRec = record 127 | LuaType: integer; 128 | Value: Variant; 129 | end; 130 | 131 | procedure plua_dostring(L: PLua_State; AString: String); 132 | function plua_AnyToString(L: PLua_State; idx: Integer): string; 133 | function plua_typetokeyword(const LuaType: integer): string; 134 | function plua_typesettokeyword(const ts: TLuaTypeSet): string; 135 | function plua_keywordtotype(const keyword: string): integer; 136 | function plua_tovariantrec(L: PLua_State; idx: Integer): TLuaVariantRec; 137 | 138 | // Checks if table contains function and calls function 139 | function plua_tablefunctionexists(L: PLua_State; TableName: string; 140 | FunctionName: string; TableIndex: Integer = LUA_GLOBALSINDEX; 141 | const allowcfunction:boolean=true):boolean; 142 | function plua_tablecallfunction(L: PLua_State; TableName: string; 143 | FunctionName: string; const args: Array of Variant; 144 | results: PVariantArray = nil; 145 | TableIndex: Integer = LUA_GLOBALSINDEX): Integer; 146 | 147 | // Gets or sets the value of local and global Lua variables 148 | function plua_GetLuaVar(L: PLua_State; idx: Integer): Variant; 149 | function plua_GetGlobal(L: PLua_State; varName: string): Variant; 150 | function plua_GetLocal(L: PLua_State; varName: string): Variant; 151 | procedure plua_SetGlobal(L: PLua_State; varName: string; const AValue: Variant); 152 | procedure plua_SetLocal(L: PLua_State; varName: string; const AValue: Variant); 153 | 154 | // LuaStackToStr method from old LuaUtils project 155 | function plua_LuaStackToStr(L: Plua_State; Index: Integer; MaxTable: Integer; 156 | SubTableMax: Integer): string; 157 | function plua_dequote(const QuotedStr: string): string; 158 | 159 | { Lua argument validation functions 160 | Proudly present these functions that simplify the process of validating 161 | arguments passed to a C function so it can be done with a single line of code 162 | } 163 | type 164 | TValuaOptions = ( 165 | vaStrict, 166 | vaMethod, 167 | vaOptional1, 168 | vaOptional2, 169 | vaOptional3 170 | ); 171 | TValuaOptionSet = set of TValuaOptions; 172 | function plua_matchtypeset(L: plua_State;const idx:integer;const ts:TLuaTypeSet; 173 | const stricttype:boolean=false):boolean; 174 | function plua_validateargs(L: plua_State; var luaresult:integer; 175 | const p:array of TLuaTypeRange; 176 | const options:TValuaOptionset=[]):TValuaResult; 177 | function plua_validateargsets(L: plua_State; var luaresult:integer; 178 | const p:array of TLuaTypeSet; const options:TValuaOptionset=[]):TValuaResult; 179 | function plua_validateargscount(L: plua_State; var luaresult:integer; 180 | const max_args:integer; const options:TValuaOptionset=[]):TValuaResult; 181 | function plua_validatetype(L: plua_State; const idx, expectedluatype:integer; 182 | const stricttype:boolean=false):boolean; 183 | 184 | // These can be used with colon-separated method calls to a Lua object 185 | function plua_validatemethodargs(L: plua_State; var luaresult:integer; 186 | const p:array of TLuaTypeRange; 187 | const options:TValuaOptionset=[]):TValuaResult; 188 | function plua_validatemethodargsets(L: plua_State; var luaresult:integer; 189 | const p:array of TLuaTypeSet; const options:TValuaOptionset=[]):TValuaResult; 190 | 191 | // Allow to locate and push a C function contained in an array of luaL_reg 192 | function plua_LocateCFunctionInArray(const name: string; 193 | table: array of luaL_reg): TLuaFunctionSearchResult; 194 | function plua_pushcfunction_fromarray(L: plua_State; const name: string; 195 | table: array of luaL_reg):integer; 196 | 197 | 198 | implementation 199 | 200 | function plua_argvalidationset_tosettings(options:TValuaOptionset):TVaLuaSettings; 201 | begin 202 | result.optional := 0; 203 | result.ignore := 0; 204 | result.stricttype := vaStrict in options; 205 | if vaMethod in options then 206 | result.ignore := 1; 207 | if vaOptional1 in options then 208 | result.optional := 1; 209 | if vaOptional2 in options then 210 | result.optional := 2; 211 | if vaOptional3 in options then 212 | result.optional := 3; 213 | end; 214 | 215 | function plua_validatemethodcall(L: plua_State;const options:TValuaOptionset):TValuaResult; 216 | var 217 | vs: TVaLuaSettings; 218 | begin 219 | vs := plua_argvalidationset_tosettings(options); 220 | result.OK := true; 221 | if (vaMethod in options) and (plua_validatetype(L, 1, LUA_TTABLE) = false) then begin 222 | result.OK := false; 223 | result.ErrorMessage := 'regular function call not allowed, use colon instead of dot'; 224 | luaL_error(L, PAnsiChar(AnsiString(result.ErrorMessage))); 225 | end; 226 | end; 227 | 228 | { 229 | This function makes very easy to validate arguments passed to a C function 230 | with just a single line 231 | 232 | Validation example: 233 | function str_after(L: plua_State): integer; cdecl; 234 | begin 235 | if plua_validateargs(L, result, [LUA_TSTRING, LUA_TSTRING]).OK then 236 | lua_pushstring(L, after(lua_tostring(L, 1), lua_tostring(L, 2))); 237 | end; 238 | 239 | If you have optional arguments, remember to pass the number of optional 240 | arguments to the fourth parameter. A max of 3 optional parameters is supported 241 | 242 | If you need strict type validation, pass vaStrict to the fourth parameter. 243 | This means for example that a number passed to C function that expects a string 244 | will not be allowed to be converted to string 245 | } 246 | 247 | function plua_validateargs(L: plua_State; var luaresult:integer; 248 | const p:array of TLuaTypeRange; 249 | const options:TValuaOptionset=[]):TValuaResult; 250 | var 251 | i, idx, startarg:integer; 252 | vs: TVaLuaSettings; 253 | begin 254 | vs := plua_argvalidationset_tosettings(options); 255 | result := plua_validatemethodcall(L, options); 256 | if result.OK then 257 | result := plua_validateargscount(L, luaresult, (high(p) +1), options); 258 | // Use ArgsCount instead of high(p) because we only want to validate provided arguments 259 | if result.OK then 260 | for i := low(p) to result.ArgsCount-1 do 261 | begin 262 | idx := i +1 +vs.ignore; 263 | if plua_validatetype(L, idx, p[i], vs.stricttype) = false then begin 264 | result.OK := false; 265 | result.ErrorMessage := 'argument #'+IntToStr(idx)+' must be '+plua_typetokeyword(p[i]); 266 | luaL_typerror(L, idx, PAnsiChar(AnsiString(plua_typetokeyword(p[i])))); 267 | Break; 268 | end; 269 | end; 270 | end; 271 | 272 | // Same as above but allowing arguments to have different types 273 | // Usage example: 274 | // function somefunction(L: plua_State): integer; cdecl; 275 | // const firstarg = [LUA_TSTRING, LUA_TLUATABLE]; 276 | // begin 277 | // if plua_validateargsets(L, result, [firstarg, [LUA_TSTRING]]).OK then begin 278 | // ... 279 | // end; 280 | // end; 281 | function plua_validateargsets(L: plua_State; var luaresult:integer; 282 | const p:array of TLuaTypeSet; 283 | const options:TValuaOptionset=[]):TValuaResult; 284 | var 285 | i, idx:integer; 286 | vs: TVaLuaSettings; 287 | begin 288 | vs := plua_argvalidationset_tosettings(options); 289 | result := plua_validatemethodcall(L, options); 290 | if result.OK then 291 | result := plua_validateargscount(L, luaresult, (high(p) +1), options); 292 | // Use ArgsCount instead of high(p) because we only want to validated provided arguments 293 | if result.OK then 294 | for i := low(p) to result.ArgsCount-1 do 295 | begin 296 | idx := i +1 +vs.ignore; 297 | if plua_matchtypeset(L, idx, p[i], vs.stricttype) = false then begin 298 | result.OK := false; 299 | result.ErrorMessage := 'argument #'+IntToStr(idx)+' must be '+plua_typesettokeyword(p[i]); 300 | luaL_typerror(L, idx, PAnsiChar(AnsiString(plua_typesettokeyword(p[i])))); 301 | Break; 302 | end; 303 | end; 304 | end; 305 | 306 | // Same as above but for Method call validation 307 | function plua_validatemethodargs(L: plua_State; var luaresult:integer; 308 | const p:array of TLuaTypeRange; 309 | const options:TValuaOptionset=[]):TValuaResult; 310 | begin 311 | result := plua_validateargs(L, luaresult, p, options + [vaMethod]); 312 | end; 313 | 314 | // Same as above but for Method call validation 315 | function plua_validatemethodargsets(L: plua_State; var luaresult:integer; 316 | const p:array of TLuaTypeSet;const options:TValuaOptionset=[]):TValuaResult; 317 | begin 318 | result := plua_validateargsets(L, luaresult, p, options + [vaMethod]); 319 | end; 320 | 321 | function plua_typesettokeyword(const ts: TLuaTypeSet): string; 322 | procedure add(const s:string); 323 | begin 324 | if result = emptystr then 325 | result := s else 326 | result := result + ' or ' + s; 327 | end; 328 | begin 329 | result := emptystr; 330 | if LUA_TSTRING in ts then 331 | add('string'); 332 | if LUA_TBOOLEAN in ts then 333 | add('boolean'); 334 | if LUA_TNUMBER in ts then 335 | add('integer'); 336 | if LUA_TTABLE in ts then 337 | add('table'); 338 | if LUA_TFUNCTION in ts then 339 | add('function'); 340 | if LUA_TTHREAD in ts then 341 | add('thread'); 342 | if LUA_TLIGHTUSERDATA in ts then 343 | add('lightuserdata'); 344 | if LUA_TUSERDATA in ts then 345 | add('userdata'); 346 | end; 347 | 348 | function plua_validateargscount(L: plua_State; var luaresult:integer; 349 | const max_args:integer; const options:TValuaOptionset=[]):TValuaResult; 350 | var 351 | min_args, num_args:integer; 352 | vs: TVaLuaSettings; 353 | begin 354 | vs := plua_argvalidationset_tosettings(options); 355 | luaresult := 1; 356 | result.ArgsCountFromTop := lua_gettop(L); 357 | num_args := result.ArgsCountFromTop -vs.ignore; 358 | result.ArgsCount := num_args; 359 | result.OK := true; 360 | min_args := max_args -vs.optional; 361 | //writeln('min:'+inttostr(min_args)+' max:'+inttostr(max_args)+' opt:'+inttostr(vs.optional)); 362 | if num_args < min_args then begin 363 | result.OK := false; 364 | if vs.optional > 0 then 365 | result.ErrorMessage := 'missing arguments, '+IntToStr(max_args)+' expected, '+IntToStr(vs.optional)+' optional). ' else 366 | result.ErrorMessage := 'missing arguments, '+IntToStr(min_args)+' expected'; 367 | luaL_error(L, PAnsiChar(AnsiString(result.ErrorMessage))); 368 | end; 369 | if num_args > max_args then begin 370 | result.OK := false; 371 | result.ErrorMessage := 'too many arguments, max '+IntToStr(max_args)+' allowed'; 372 | luaL_error(L, PAnsiChar(AnsiString(result.ErrorMessage))); 373 | end; 374 | end; 375 | 376 | function plua_validatetype(L: plua_State; const idx, expectedluatype:integer; 377 | const stricttype:boolean=false):boolean; 378 | function IsInteger(const s: string): Boolean; 379 | var 380 | v, c: integer; 381 | begin 382 | Val(s, v, c); 383 | if v = 0 then 384 | begin // avoid compiler warning 385 | end; 386 | result := c = 0; 387 | end; 388 | var curluatype: integer; 389 | begin 390 | curluatype := lua_type(L, idx); 391 | result := curluatype = expectedluatype; 392 | if (stricttype = false) and (result = false) then begin 393 | // Expected a string, got number. Lua will convert number to string automatically 394 | // Example: string.upper(10) in Lua returns "10" 395 | if (expectedluatype = LUA_TSTRING) and (curluatype = LUA_TNUMBER) then 396 | result := true; 397 | // Expected a number, got string, check if string is number and if true, allow it 398 | // Example: math.sqrt("100") in Lua returns 100, but math.sqrt("A") will raise error 399 | if (expectedluatype = LUA_TNUMBER) and (curluatype = LUA_TSTRING) and (IsInteger(lua_tostring(L, idx))) then 400 | result := true; 401 | end; 402 | end; 403 | 404 | function plua_matchtypeset(L: plua_State;const idx:integer;const ts:TLuaTypeSet; 405 | const stricttype:boolean=false):boolean; 406 | procedure validate(const lt:integer); 407 | begin 408 | if plua_validatetype(L, idx, lt, stricttype) then 409 | result := true; 410 | end; 411 | begin 412 | result := false; 413 | if LUA_TNIL in ts then 414 | validate(LUA_TNIL); 415 | if LUA_TSTRING in ts then 416 | validate(LUA_TSTRING); 417 | if LUA_TBOOLEAN in ts then 418 | validate(LUA_TBOOLEAN); 419 | if LUA_TNUMBER in ts then 420 | validate(LUA_TNUMBER); 421 | if LUA_TTABLE in ts then 422 | validate(LUA_TTABLE); 423 | if LUA_TFUNCTION in ts then 424 | validate(LUA_TFUNCTION); 425 | if LUA_TTHREAD in ts then 426 | validate(LUA_TTHREAD); 427 | if LUA_TLIGHTUSERDATA in ts then 428 | validate(LUA_TLIGHTUSERDATA); 429 | if LUA_TUSERDATA in ts then 430 | validate(LUA_TUSERDATA); 431 | end; 432 | 433 | function plua_typetokeyword(const LuaType: integer): string; 434 | begin 435 | result := emptystr; 436 | case LuaType of 437 | LUA_TNIL: 438 | result := 'nil'; 439 | LUA_TSTRING: 440 | result := 'string'; 441 | LUA_TBOOLEAN: 442 | result := 'boolean'; 443 | LUA_TNUMBER: 444 | result := 'integer'; 445 | LUA_TTABLE: 446 | result := 'table'; 447 | LUA_TFUNCTION: 448 | result := 'function'; 449 | LUA_TTHREAD: 450 | result := 'thread'; 451 | LUA_TLIGHTUSERDATA: 452 | result := 'lightuserdata'; 453 | LUA_TUSERDATA: 454 | result := 'userdata'; 455 | end; 456 | end; 457 | 458 | function plua_keywordtotype(const keyword: string): integer; 459 | begin 460 | result := LUA_TNONE; 461 | if keyword = 'none' then 462 | result := LUA_TNONE else 463 | if keyword = 'nil' then 464 | result := LUA_TNIL else 465 | if keyword = 'string' then 466 | result := LUA_TSTRING else 467 | if keyword = 'boolean' then 468 | result := LUA_TBOOLEAN else 469 | if keyword = 'integer' then 470 | result := LUA_TNUMBER else 471 | if keyword = 'table' then 472 | result := LUA_TTABLE else 473 | if keyword = 'function' then 474 | result := LUA_TFUNCTION else 475 | if keyword = 'thread' then 476 | result := LUA_TTHREAD else 477 | if keyword = 'lightuserdata' then 478 | result := LUA_TLIGHTUSERDATA else 479 | if keyword = 'userdata' then 480 | result := LUA_TUSERDATA; 481 | end; 482 | 483 | function plua_toansistring(L: PLua_State; Index: Integer): ansistring; 484 | var 485 | Size: Integer; 486 | begin 487 | Size := lua_strlen(L, Index); 488 | SetLength(Result, Size); 489 | if (Size > 0) then 490 | Move(lua_tostringP(L, Index)^, Result[1], Size); 491 | end; 492 | 493 | procedure plua_pushansistring(L: PLua_State; AString: ansistring); 494 | begin 495 | lua_pushstring(L, PAnsiChar(AString)); 496 | end; 497 | 498 | procedure plua_RegisterLuaTable(L: PLua_State; Name: string; 499 | Reader: lua_CFunction; Writer: lua_CFunction; TableIndex: Integer); 500 | var 501 | tidx, midx: Integer; 502 | begin 503 | lua_gettable(L, TableIndex); 504 | if (lua_type(L, -1) <> LUA_TTABLE) then 505 | begin 506 | lua_pushliteral(L, Name); 507 | lua_newtable(L); 508 | tidx := lua_gettop(L); 509 | 510 | lua_newtable(L); 511 | midx := lua_gettop(L); 512 | 513 | lua_pushstring(L, '__index'); 514 | lua_pushcfunction(L, Reader); 515 | lua_rawset(L, midx); 516 | lua_pushstring(L, '__newindex'); 517 | lua_pushcfunction(L, Writer); 518 | lua_rawset(L, midx); 519 | lua_setmetatable(L, tidx); 520 | lua_settable(L, TableIndex); 521 | end; 522 | end; 523 | 524 | function plua_functionexists(L: PLua_State; FunctionName: string; 525 | TableIndex: Integer = LUA_GLOBALSINDEX; 526 | const allowcfunction:boolean=true): boolean; 527 | begin 528 | if TableIndex = LUA_GLOBALSINDEX then 529 | lua_getglobal(L, 'tostring'); // FD: fixes global function sometimes not being located 530 | lua_pushstring(L, FunctionName); 531 | lua_rawget(L, TableIndex); 532 | 533 | try 534 | Result := (not lua_isnil(L, lua_gettop(L))) and lua_isfunction(L, lua_gettop(L)); 535 | finally 536 | lua_pop(L, 1); // FD: added lua_isnil check and lua_pop. Fixes occasional exception 537 | end; 538 | 539 | if (Result = true) and (allowcfunction = false) then 540 | begin 541 | try 542 | Result := not lua_iscfunction(L, lua_gettop(L)); 543 | finally 544 | lua_pop(L, 1); 545 | end; 546 | end; 547 | 548 | end; 549 | 550 | function plua_tablefunctionexists(L: PLua_State; TableName: string; 551 | FunctionName: string; TableIndex: Integer = LUA_GLOBALSINDEX; 552 | const allowcfunction:boolean=true):boolean; 553 | begin 554 | result := false; 555 | if TableIndex = LUA_GLOBALSINDEX then 556 | lua_getglobal(L, 'tostring'); 557 | lua_pushstring(L, TableName); 558 | lua_rawget(L, TableIndex); 559 | if lua_istable(L, lua_gettop(L)) then 560 | result := plua_functionexists(L, FunctionName, -2, allowcfunction); 561 | end; 562 | 563 | function plua_tablecallfunction(L: PLua_State; TableName: string; 564 | FunctionName: string; const args: Array of Variant; 565 | results: PVariantArray = nil; 566 | TableIndex: Integer = LUA_GLOBALSINDEX): Integer; 567 | begin 568 | if TableIndex = LUA_GLOBALSINDEX then 569 | lua_getglobal(L, 'tostring'); 570 | lua_pushstring(L, TableName); 571 | lua_rawget(L, TableIndex); 572 | result := plua_callfunction(L, FunctionName, args, results, -2); 573 | end; 574 | 575 | function plua_callfunction(L: PLua_State; FunctionName: string; 576 | const args: Array of Variant; results: PVariantArray = nil; 577 | TableIndex: Integer = LUA_GLOBALSINDEX): Integer; 578 | var 579 | NArgs, offset, i: Integer; 580 | Msg: string; 581 | begin 582 | offset := lua_gettop(L); 583 | lua_pushstring(L, FunctionName); 584 | lua_rawget(L, TableIndex); 585 | NArgs := High(args); 586 | for i := 0 to NArgs do 587 | plua_pushvariant(L, args[i]); 588 | if lua_pcall(L, NArgs + 1, LUA_MULTRET, 0) <> 0 then 589 | begin 590 | Msg := lua_tostring(L, -1); 591 | lua_pop(L, 1); 592 | raise LuaException.create(Msg); 593 | end; 594 | Result := lua_gettop(L) - offset; 595 | if (results <> Nil) then 596 | begin 597 | SetLength(results^, Result); 598 | for i := 0 to Result - 1 do 599 | results^[Result - i - 1] := plua_tovariant(L, -(i + 1)); 600 | end; 601 | end; 602 | 603 | // Just an alias for lua_pushnumber() - Use this if you experience conversion 604 | // issues with negative integers and Lua 64-bit when using lua_pushinteger() 605 | procedure plua_pushintnumber(L: PLua_State; N: Integer); 606 | begin 607 | lua_pushnumber(L, N); 608 | end; 609 | 610 | procedure plua_pushvariant(L: PLua_State; v: Variant); 611 | var 612 | h, c: Integer; 613 | begin 614 | case VarType(v) of 615 | varEmpty, varNull: 616 | lua_pushnil(L); 617 | varBoolean: 618 | lua_pushboolean(L, v); 619 | varStrArg, varOleStr, varString{$IFDEF UNICODE}, varUString{$ENDIF} : 620 | lua_pushstring(L, string(v)); // FD: 06/05/2013, added unicode 621 | varDate: 622 | lua_pushstring(L, DateTimeToStr(VarToDateTime(v))); 623 | varArray: 624 | begin 625 | h := VarArrayHighBound(v, 1); 626 | lua_newtable(L); 627 | for c := 0 to h do 628 | begin 629 | lua_pushinteger(L, c + 1); 630 | plua_pushvariant(L, v[c]); 631 | lua_settable(L, -3); 632 | end; 633 | end; 634 | else 635 | lua_pushnumber(L, Double(VarAsType(v, varDouble))); 636 | end; 637 | end; 638 | 639 | function plua_TableToVariantArray(L: PLua_State; Index: Integer; 640 | Keys: TStrings = nil): Variant; 641 | var 642 | cnt: Integer; 643 | va: array of Variant; 644 | begin 645 | Index := plua_absindex(L, Index); 646 | if Assigned(Keys) then 647 | Keys.Clear; 648 | 649 | lua_pushnil(L); 650 | cnt := 0; 651 | while (lua_next(L, Index) <> 0) do 652 | begin 653 | SetLength(va, cnt + 1); 654 | if Assigned(Keys) then 655 | Keys.Add(lua_tostring(L, -2)); 656 | va[cnt] := plua_tovariant(L, -1); 657 | lua_pop(L, 1); 658 | inc(cnt); 659 | end; 660 | 661 | if cnt > 0 then 662 | begin 663 | Result := VarArrayCreate([0, cnt - 1], varvariant); 664 | while cnt > 0 do 665 | begin 666 | dec(cnt); 667 | Result[cnt] := va[cnt]; 668 | end; 669 | end 670 | else 671 | Result := VarArrayCreate([0, 0], varvariant); 672 | end; 673 | 674 | function plua_tovariant(L: PLua_State; Index: Integer): Variant; 675 | Var 676 | dataType: Integer; 677 | dataNum: Double; 678 | begin 679 | dataType := lua_type(L, Index); 680 | case dataType of 681 | LUA_TSTRING: 682 | Result := VarAsType(lua_tostring(L, Index), varString); 683 | LUA_TUSERDATA, LUA_TLIGHTUSERDATA: 684 | Result := VarAsType(PtrInt(lua_touserdata(L, Index)), varInteger); 685 | LUA_TNONE, LUA_TNIL: 686 | Result := varNull; 687 | LUA_TBOOLEAN: 688 | Result := VarAsType(lua_toboolean(L, Index), varBoolean); 689 | LUA_TNUMBER: 690 | begin 691 | dataNum := lua_tonumber(L, Index); 692 | if (Abs(dataNum) > MAXINT) then 693 | Result := VarAsType(dataNum, varDouble) 694 | else 695 | begin 696 | if (Frac(dataNum) <> 0) then 697 | Result := VarAsType(dataNum, varDouble) 698 | else 699 | Result := Round(VarAsType(dataNum, varDouble)); 700 | end; 701 | end; 702 | LUA_TTABLE: 703 | Result := plua_TableToVariantArray(L, Index); 704 | else 705 | Result := NULL; 706 | end; 707 | end; 708 | 709 | function plua_absindex(L: PLua_State; Index: Integer): Integer; 710 | begin 711 | if (index > -1) or ((index = LUA_GLOBALSINDEX) or (index = LUA_REGISTRYINDEX)) 712 | then 713 | Result := index 714 | else 715 | Result := index + lua_gettop(L) + 1 716 | end; 717 | 718 | procedure plua_spliterrormessage(const ErrMsg: string; out Title: string; 719 | out Line: Integer; out Msg: string); 720 | const 721 | Term = #$00; 722 | function S(Index: Integer): Char; 723 | begin 724 | if (Index <= Length(ErrMsg)) then 725 | Result := ErrMsg[Index] 726 | else 727 | Result := Term; 728 | end; 729 | function IsDigit(c: Char): boolean; 730 | begin 731 | Result := ('0' <= c) and (c <= '9'); 732 | end; 733 | function PP(var Index: Integer): Integer; 734 | begin 735 | inc(Index); 736 | Result := Index; 737 | end; 738 | 739 | var 740 | i, Start, Stop: Integer; 741 | LS: string; 742 | Find: boolean; 743 | begin 744 | Title := ''; 745 | Line := 0; 746 | Msg := ErrMsg; 747 | Find := False; 748 | i := 1 - 1; 749 | Stop := 0; 750 | repeat 751 | while (S(PP(i)) <> ':') do 752 | if (S(i) = Term) then 753 | Exit; 754 | Start := i; 755 | if (not IsDigit(S(PP(i)))) then 756 | Continue; 757 | while (IsDigit(S(PP(i)))) do 758 | if (S(i - 1) = Term) then 759 | Exit; 760 | Stop := i; 761 | if (S(i) = ':') then 762 | Find := True; 763 | until (Find); 764 | Title := Copy(ErrMsg, 1, Start - 1); 765 | LS := Copy(ErrMsg, Start + 1, Stop - Start - 1); 766 | Line := StrToIntDef(LS, 0); 767 | Msg := Copy(ErrMsg, Stop + 1, Length(ErrMsg)); 768 | end; 769 | 770 | procedure plua_CopyTable(L: PLua_State; IdxFrom, IdxTo: Integer); 771 | var 772 | id: Integer; 773 | key: string; 774 | begin 775 | lua_pushnil(L); 776 | while (lua_next(L, IdxFrom) <> 0) do 777 | begin 778 | key := lua_tostring(L, -2); 779 | case lua_type(L, -1) of 780 | LUA_TTABLE: 781 | begin 782 | id := lua_gettop(L); 783 | plua_CopyTable(L, id, IdxTo); 784 | end; 785 | else 786 | lua_pushliteral(L, key); 787 | lua_pushvalue(L, -2); 788 | lua_rawset(L, IdxTo); 789 | end; 790 | lua_pop(L, 1); 791 | end; 792 | end; 793 | 794 | procedure plua_RegisterMethod(L: PLua_State; aMethodName: string; 795 | MethodPtr: lua_CFunction; totable: Integer); 796 | begin 797 | lua_pushliteral(L, aMethodName); 798 | lua_pushcfunction(L, MethodPtr); 799 | lua_settable(L, totable); 800 | end; 801 | 802 | procedure plua_GetTableKey(L: PLua_State; TableIndex: Integer; KeyName: string); 803 | begin 804 | TableIndex := plua_absindex(L, TableIndex); 805 | lua_pushstring(L, KeyName); 806 | lua_gettable(L, TableIndex); 807 | end; 808 | 809 | { FD Additions } 810 | 811 | procedure plua_dostring(L: PLua_State; AString: String); 812 | begin 813 | luaL_loadbuffer(L, PAnsiChar(ansistring(AString)), Length(ansistring(AString) 814 | ), PAnsiChar(ansistring(emptystr))); 815 | lua_pcall(L, 0, 0, 0); 816 | end; 817 | 818 | function plua_tovariantrec(L: PLua_State; idx: Integer): TLuaVariantRec; 819 | begin 820 | result.LuaType := lua_type(L, idx); 821 | result.Value := plua_tovariant(L, idx); 822 | end; 823 | 824 | // This is similar to lua_tostring but covers boolean and number Lua types 825 | function plua_AnyToString(L: PLua_State; idx: Integer): string; 826 | var 827 | ltype: Integer; 828 | begin 829 | Result := emptystr; 830 | ltype := lua_type(L, idx); 831 | case ltype of 832 | LUA_TSTRING: 833 | Result := lua_tostring(L, idx); 834 | LUA_TBOOLEAN: 835 | begin 836 | if lua_toboolean(L, idx) = True then 837 | Result := 'true' 838 | else 839 | Result := 'false'; 840 | end; 841 | LUA_TNUMBER: 842 | begin 843 | if TVarData(plua_tovariant(L, idx)).vType = varDouble then 844 | Result := floattostr(lua_tonumber(L, idx)) 845 | else 846 | Result := inttostr(lua_tointeger(L, idx)); 847 | end; 848 | end; 849 | end; 850 | 851 | // This is a simpler implementation of the plua_tovariant function 852 | function plua_GetLuaVar(L: PLua_State; idx: Integer): Variant; 853 | var 854 | ltype: Integer; 855 | v: Variant; 856 | S: string; 857 | begin 858 | ltype := lua_type(L, idx); 859 | case ltype of 860 | LUA_TSTRING: 861 | begin 862 | S := lua_tostring(L, idx); 863 | v := S; 864 | end; 865 | LUA_TBOOLEAN: 866 | v := lua_toboolean(L, idx); 867 | LUA_TNUMBER: 868 | v := lua_tointeger(L, idx); 869 | else 870 | v := plua_tovariant(L, idx); 871 | end; 872 | Result := v; 873 | end; 874 | 875 | function plua_GetGlobal(L: PLua_State; varName: string): Variant; 876 | var 877 | v: Variant; 878 | begin 879 | Result := NULL; 880 | lua_pushstring(L, varName); 881 | lua_rawget(L, LUA_GLOBALSINDEX); 882 | try 883 | // writeln('getting '+varname); 884 | v := plua_GetLuaVar(L, -1); // plua_tovariant(L, -1); 885 | Result := v; 886 | // writeln('got '+varname+': '+result); 887 | finally 888 | lua_pop(L, 1); 889 | end; 890 | end; 891 | 892 | function plua_GetLocal(L: PLua_State; varName: string): Variant; 893 | var 894 | ar: plua_Debug; // use plua_debug instead of lua_debug 895 | vn: PAnsiChar; 896 | value: Variant; 897 | i: Integer; 898 | found: boolean; 899 | begin 900 | Result := NULL; 901 | found := False; 902 | 903 | lua_getglobal(L, 'tostring'); // this fixes occasional crash with lua_getstack 904 | if lua_getstack(L, 1, @ar) <> 1 then 905 | Exit; 906 | i := 1; 907 | // lua_pop(L, 1); 908 | vn := lua_getlocal(L, @ar, i); 909 | while vn <> nil do 910 | begin 911 | // lua_pop(L,1); 912 | //writeln('Matching against var:'+varName); 913 | if strpas(vn) = ansistring(varName) then 914 | begin 915 | found := True; 916 | if found = True then 917 | begin // hides H2077 compiler warning 918 | end; 919 | // writeln('Found var:'+vn); 920 | try 921 | value := plua_GetLuaVar(L, -1); // plua_tovariant(L, -1); 922 | finally 923 | lua_pop(L, 1); 924 | end; 925 | //writeln('found!'+vn+';'+value); 926 | Result := value; 927 | Exit; 928 | end; 929 | lua_pop(L, 1); 930 | vn := lua_getlocal(L, @ar, i); 931 | inc(i); 932 | end; 933 | if found = False then 934 | begin // local not found, tries to get global with the same name 935 | //writeln(varname+' not found locally:'+vn); 936 | try 937 | value := plua_GetGlobal(L, varName); 938 | except 939 | end; 940 | Result := value; 941 | //writeln('global search for '+vn+' returned):'+result); 942 | end; 943 | end; 944 | 945 | procedure plua_SetLocal(L: PLua_State; varName: string; const AValue: Variant); 946 | var 947 | ar: plua_Debug; 948 | vn: PAnsiChar; 949 | i: Integer; 950 | found: boolean; 951 | NewValue: Variant; 952 | begin 953 | found := False; 954 | NewValue := AValue; 955 | lua_getglobal(L, 'tostring'); // this fixes occasional crash with lua_getstack 956 | if lua_getstack(L, 1, @ar) <> 1 then 957 | Exit; 958 | i := 1; 959 | //lua_pop(L, 1); 960 | vn := lua_getlocal(L, @ar, i); 961 | 962 | while vn <> nil do 963 | begin 964 | if strpas(vn) = ansistring(varName) then 965 | begin 966 | found := True; 967 | if found = True then 968 | begin // hides H2077 compiler warning 969 | end; 970 | //writeln('Found var:'+varname+' changing to:'+newvalue); 971 | // lua_pop(L,1); 972 | try 973 | plua_pushvariant(L, NewValue); 974 | lua_setlocal(L, @ar, i); 975 | finally 976 | lua_pop(L, 1); 977 | end; 978 | //writeln('Changed var:'+varname+' to:'+newvalue); 979 | Exit; 980 | end; 981 | lua_pop(L, 1); 982 | inc(i); 983 | vn := lua_getlocal(L, @ar, i); 984 | 985 | end; 986 | if found = False then 987 | begin // new, local not found, tries to set global with the same name 988 | //writeln('not found locally:'+varname); 989 | plua_SetGlobal(L, varName, NewValue); 990 | end; 991 | end; 992 | 993 | procedure plua_SetGlobal(L: PLua_State; varName: string; const AValue: Variant); 994 | begin 995 | // writeln('setting glob:'+varname+'; new value: '+avalue); 996 | if VarIsType(AValue, varString) then 997 | begin 998 | lua_pushliteral(L, varName); 999 | lua_pushstring(L, string(AValue)); 1000 | lua_settable(L, LUA_GLOBALSINDEX); 1001 | end 1002 | else 1003 | begin 1004 | lua_pushliteral(L, varName); 1005 | plua_pushvariant(L, AValue); 1006 | lua_settable(L, LUA_GLOBALSINDEX); 1007 | end; 1008 | end; 1009 | 1010 | function plua_LocateCFunctionInArray(const name: string; 1011 | table: array of luaL_reg): TLuaFunctionSearchResult; 1012 | var 1013 | i: integer; 1014 | begin 1015 | result.found := false; 1016 | for i := low(table) to high(table) do 1017 | begin 1018 | if ansistring(name) = table[i].name then begin 1019 | result.found := true; 1020 | result.reg := table[i]; 1021 | break; 1022 | end; 1023 | end; 1024 | end; 1025 | 1026 | function plua_pushcfunction_FromArray(L: plua_State; const name: string; 1027 | table: array of luaL_reg):integer; 1028 | var 1029 | rs:TLuaFunctionSearchResult; 1030 | begin 1031 | result := 0; 1032 | rs := plua_LocateCFunctionInArray(name,table); 1033 | if rs.found then begin 1034 | result := 1; 1035 | lua_pushcfunction(L,rs.reg.func); 1036 | end; 1037 | end; 1038 | 1039 | // Convert the last item at 'Index' from the stack to a string 1040 | // nil : nil 1041 | // Number : FloatToStr 1042 | // Boolean: True/False 1043 | // stirng : "..." 1044 | // Table : { Key1=Value Key2=Value } 1045 | // LuaStackToStr from LuaUtils project 1046 | function plua_dequote(const QuotedStr: string): string; 1047 | begin 1048 | Result := AnsiDequotedStr(QuotedStr, '"'); 1049 | end; 1050 | 1051 | function plua_LuaStackToStr(L: Plua_State; Index: Integer; MaxTable: Integer; SubTableMax: Integer): string; 1052 | var 1053 | pGLobalsIndexPtr: Pointer; 1054 | function TableToStr(Index: Integer): string; 1055 | var 1056 | Key, Value: string; 1057 | Count: Integer; 1058 | 1059 | begin 1060 | Result := '{ '; 1061 | Count := 0; 1062 | lua_pushnil(L); 1063 | 1064 | // Go through the current table 1065 | while (lua_next(L, Index) <> 0) do 1066 | begin 1067 | Inc(Count); 1068 | if (Count > MaxTable) then 1069 | begin 1070 | Result := Result + '... '; 1071 | lua_pop(L, 2); 1072 | Break; 1073 | end; 1074 | 1075 | // Key to string 1076 | if lua_type(L, -2) = LUA_TNUMBER then 1077 | Key := '[' + plua_dequote(plua_LuaStackToStr(L, -2, MaxTable, SubTableMax)) + ']' 1078 | else 1079 | Key := plua_dequote(plua_LuaStackToStr(L, -2, MaxTable, SubTableMax)); 1080 | 1081 | // Value to string... 1082 | if ((Key = '_G') or (lua_topointer(L, -1) = pGLobalsIndexPtr)) then 1083 | Value := cLuaGlobalVariableStr 1084 | else 1085 | Value := plua_LuaStackToStr(L, -1, MaxTable, SubTableMax); 1086 | 1087 | if (lua_type(L, -1) = LUA_TFUNCTION) then 1088 | Result := Result + Format('%s()=%p ', [Key, lua_topointer(L, -1)]) 1089 | else 1090 | Result := Result + Format('%s=%s ', [Key, Value]); 1091 | 1092 | // Pop current value from stack leaving current key on top of the stack for lua_next 1093 | lua_pop(L, 1); 1094 | end; 1095 | 1096 | Result := Result + '}'; 1097 | end; 1098 | 1099 | begin 1100 | if (MaxTable < 0) then 1101 | MaxTable := DefaultMaxTable; 1102 | 1103 | pGLobalsIndexPtr := lua_topointer(L, LUA_GLOBALSINDEX); // Retrieve globals index poiner for later conditions 1104 | lua_checkstack(L, SubTableMax * 3); // Ensure there is enough space on stack to work with according to user's setting 1105 | Index := plua_absindex(L, Index); 1106 | 1107 | case (lua_type(L, Index)) of 1108 | LUA_TNIL: 1109 | Result := 'nil'; 1110 | LUA_TNUMBER: 1111 | Result := Format('%g', [lua_tonumber(L, Index)]); 1112 | LUA_TBOOLEAN: 1113 | Result := BoolToStr(lua_toboolean(L, Index) <> false, True); 1114 | LUA_TSTRING: 1115 | Result := '"'+lua_tostring(L, Index)+'"'; 1116 | LUA_TTABLE: 1117 | begin 1118 | if SubTableCount < SubTableMax then 1119 | begin 1120 | SubTableCount := SubTableCount + 1; 1121 | Result := TableToStr(Index); 1122 | SubTableCount := SubTableCount - 1; 1123 | end 1124 | else 1125 | Result := '[SUB_TABLE_MAX_LEVEL_HAS_BEEN_REACHED]'; 1126 | end; 1127 | LUA_TFUNCTION: 1128 | if (lua_iscfunction(L, Index) <> false) then 1129 | Result := Format('CFUNC:%p', [Pointer(lua_tocfunction(L, Index))]) 1130 | else 1131 | Result := Format('FUNC:%p', [lua_topointer(L, Index)]); 1132 | LUA_TUSERDATA: 1133 | Result := Format('USERDATA:%p', [lua_touserdata(L, Index)]); 1134 | LUA_TTHREAD: 1135 | Result := Format('THREAD:%p', [lua_tothread(L, Index)]); 1136 | LUA_TLIGHTUSERDATA: 1137 | Result := Format('LIGHTUSERDATA:%p', [lua_touserdata(L, Index)]); 1138 | else 1139 | Assert(False); 1140 | end; 1141 | end; 1142 | 1143 | initialization 1144 | DefaultMaxTable := 256; 1145 | 1146 | end. 1147 | --------------------------------------------------------------------------------