43fe3afc42227e6d453417bc604a2b7e2265de7f
1 (* Copyright (C) DooM 2D:Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
32 PScriptContext
= Plua_State
;
33 PScriptProc
= lua_CFunction
;
36 gScriptCtx
: PScriptContext
= nil;
37 gScriptInit
: Boolean = False;
39 function g_Scripts_Init(): Boolean;
40 procedure g_Scripts_Reset(What
: Integer);
41 function g_Scripts_ProcExec(PName
: string; const Args
: array of const): Integer;
42 function g_Scripts_ProcExists(PName
: string): Boolean;
43 function g_Scripts_ProcInstall(PName
: string; PPtr
: PScriptProc
): Boolean;
44 function g_Scripts_Load(Text: string): Boolean;
45 procedure g_Scripts_Free();
50 SysUtils
, g_console
, g_scriptprocs
;
53 POpenFunc
= function(L
: Plua_State
): LongBool; cdecl;
60 LUA_LIBS
: array [0..3] of TLuaReg
= (
61 (name
: ''; func
: luaopen_base
),
62 (name
: LUA_TABLIBNAME
; func
: luaopen_table
),
63 (name
: LUA_STRLINAME
; func
: luaopen_string
), // STRLINAME is actually a typo in fpc's lua module
64 (name
: LUA_MATHLIBNAME
; func
: luaopen_math
)
67 function LuaInstallGameFuncs(): Boolean;
71 if not g_Scripts_ProcInstall('conprint', SP_Lua_ConPrint
) then Exit
;
76 function g_Scripts_Init(): Boolean;
81 if gScriptInit
then Exit
;
83 gScriptCtx
:= luaL_newstate();
84 if gScriptCtx
= nil then Exit
;
86 // don't open all the libs
87 for i
:= 0 to High(LUA_LIBS
) do
89 //lua_pushcfunction(gScriptCtx, LUA_LIBS[i].func);
90 lua_pushstring(gScriptCtx
, LUA_LIBS
[i
].name
);
91 //lua_call(gScriptCtx, 1, 0);
92 LUA_LIBS
[i
].func(gScriptCtx
);
95 // create a table for game-related functions
96 lua_newtable(gScriptCtx
);
97 lua_setglobal(gScriptCtx
, 'game');
99 // create game-related tables
100 g_Scripts_Reset(RESET_ALL
);
103 // try to install game-related shit
104 if not LuaInstallGameFuncs() then
106 g_Console_Add('SCRIPT: Could not init game callbacks');
107 lua_close(gScriptCtx
);
109 gScriptInit
:= False;
116 // TODO: maybe actually put some fields into these?
117 procedure g_Scripts_Reset(What
: Integer);
119 if not gScriptInit
then Exit
;
120 if What
in [RESET_ALL
, RESET_SRV
] then
122 lua_newtable(gScriptCtx
);
123 lua_setglobal(gScriptCtx
, 'srv');
125 if What
in [RESET_ALL
, RESET_WAD
] then
127 lua_newtable(gScriptCtx
);
128 lua_setglobal(gScriptCtx
, 'wad');
130 if What
in [RESET_ALL
, RESET_MAP
] then
132 lua_newtable(gScriptCtx
);
133 lua_setglobal(gScriptCtx
, 'map');
137 function g_Scripts_ProcInstall(PName
: string; PPtr
: PScriptProc
): Boolean;
140 if not gScriptInit
then Exit
;
142 if g_Scripts_ProcExists(PName
) then
144 g_Console_Add('SCRIPT: ProcInstall(' + PName
+ '): function already exists');
148 lua_getglobal(gScriptCtx
, 'game');
149 lua_pushstring(gScriptCtx
, PName
);
150 lua_pushcfunction(gScriptCtx
, PPtr
);
151 lua_settable(gScriptCtx
, -3);
152 lua_setglobal(gScriptCtx
, 'game');
157 function g_Scripts_ProcExists(PName
: string): Boolean;
160 if not gScriptInit
then Exit
;
162 lua_getglobal(gScriptCtx
, 'game');
163 lua_pushstring(gScriptCtx
, PName
);
164 lua_gettable(gScriptCtx
, -2);
166 if lua_isfunction(gScriptCtx
, -1) then
170 function g_Scripts_ProcExec(PName
: string; const Args
: array of const): Integer;
175 if not gScriptInit
then Exit
;
177 lua_getglobal(gScriptCtx
, 'game');
178 lua_pushstring(gScriptCtx
, PName
);
179 lua_gettable(gScriptCtx
, -2);
180 if not lua_isfunction(gScriptCtx
, -1) then
182 g_Console_Add('SCRIPT: ProcExec(' + PName
+ ') error: no such function');
186 for i
:= 0 to High(Args
) do
190 vtInteger
: lua_pushinteger(gScriptCtx
, vInteger
);
191 vtBoolean
: lua_pushboolean(gScriptCtx
, vBoolean
);
192 vtString
: lua_pushstring(gScriptCtx
, vString
^);
193 vtAnsiString
: lua_pushstring(gScriptCtx
, PAnsiString(vAnsiString
)^);
194 vtExtended
: lua_pushnumber(gScriptCtx
, vExtended
^);
198 if lua_pcall(gScriptCtx
, Length(Args
), 1, 0) <> 0 then
200 g_Console_Add('SCRIPT: ProcExec(' + PName
+ ') error: ' + lua_tostring(gScriptCtx
, -1));
204 if not lua_isnumber(gScriptCtx
, -1) then
206 g_Console_Add('SCRIPT: ProcExec(' + PName
+ ') error: return value is not a number');
210 Result
:= lua_tointeger(gScriptCtx
, -1);
211 lua_pop(gScriptCtx
, 1);
214 function g_Scripts_Load(Text: string): Boolean;
217 if not gScriptInit
then Exit
;
219 if lua_dostring(gScriptCtx
, PChar(Text)) <> 0 then
221 g_Console_Add('SCRIPT: Load() error: ' + lua_tostring(gScriptCtx
, -1));
228 procedure g_Scripts_Free();
230 if not gScriptInit
then Exit
;
231 lua_close(gScriptCtx
);
232 gScriptInit
:= False;