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; Namespace
: string = ''): 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
;
73 if not g_Scripts_ProcInstall('spawn_item', SP_Lua_SpawnItem
) then Exit
;
74 if not g_Scripts_ProcInstall('spawn_shot', SP_Lua_SpawnShot
) then Exit
;
75 if not g_Scripts_ProcInstall('spawn_effect', SP_Lua_SpawnEffect
) then Exit
;
76 if not g_Scripts_ProcInstall('spawn_monster', SP_Lua_SpawnMonster
) then Exit
;
81 function g_Scripts_Init(): Boolean;
86 if gScriptInit
then Exit
;
88 gScriptCtx
:= luaL_newstate();
89 if gScriptCtx
= nil then Exit
;
91 // don't open all the libs
92 for i
:= 0 to High(LUA_LIBS
) do
94 //lua_pushcfunction(gScriptCtx, LUA_LIBS[i].func);
95 lua_pushstring(gScriptCtx
, LUA_LIBS
[i
].name
);
96 //lua_call(gScriptCtx, 1, 0);
97 LUA_LIBS
[i
].func(gScriptCtx
);
100 // create a table for game-related functions
101 lua_newtable(gScriptCtx
);
102 lua_setglobal(gScriptCtx
, 'game');
104 // create game-related tables
105 g_Scripts_Reset(RESET_ALL
);
108 // try to install game-related shit
109 if not LuaInstallGameFuncs() then
111 g_Console_Add('SCRIPT: Could not init game callbacks');
112 lua_close(gScriptCtx
);
114 gScriptInit
:= False;
121 // TODO: maybe actually put some fields into these?
122 procedure g_Scripts_Reset(What
: Integer);
124 if not gScriptInit
then Exit
;
125 if What
in [RESET_ALL
, RESET_SRV
] then
127 lua_newtable(gScriptCtx
);
128 lua_setglobal(gScriptCtx
, 'srv');
130 if What
in [RESET_ALL
, RESET_WAD
] then
132 lua_newtable(gScriptCtx
);
133 lua_setglobal(gScriptCtx
, 'wad');
135 if What
in [RESET_ALL
, RESET_MAP
] then
137 lua_newtable(gScriptCtx
);
138 lua_setglobal(gScriptCtx
, 'map');
142 function g_Scripts_ProcInstall(PName
: string; PPtr
: PScriptProc
): Boolean;
145 if not gScriptInit
then Exit
;
147 if g_Scripts_ProcExists(PName
) then
149 g_Console_Add('SCRIPT: ProcInstall(' + PName
+ '): function already exists');
153 lua_getglobal(gScriptCtx
, 'game');
154 lua_pushstring(gScriptCtx
, PName
);
155 lua_pushcfunction(gScriptCtx
, PPtr
);
156 lua_settable(gScriptCtx
, -3);
157 lua_setglobal(gScriptCtx
, 'game');
162 function g_Scripts_ProcExists(PName
: string): Boolean;
165 if not gScriptInit
then Exit
;
167 lua_getglobal(gScriptCtx
, 'game');
168 lua_pushstring(gScriptCtx
, PName
);
169 lua_gettable(gScriptCtx
, -2);
171 if lua_isfunction(gScriptCtx
, -1) then
175 function g_Scripts_ProcExec(PName
: string; const Args
: array of const; Namespace
: string = ''): Integer;
180 if not gScriptInit
then Exit
;
182 if Namespace
= '' then
183 lua_getglobal(gScriptCtx
, PChar(PName
))
186 lua_getglobal(gScriptCtx
, PChar(Namespace
));
187 lua_pushstring(gScriptCtx
, PName
);
188 lua_gettable(gScriptCtx
, -2);
191 if not lua_isfunction(gScriptCtx
, -1) then
193 g_Console_Add('SCRIPT: ProcExec(' + Namespace
+ '.' + PName
+ ') error: no such function');
197 for i
:= 0 to High(Args
) do
201 vtInteger
: lua_pushinteger(gScriptCtx
, vInteger
);
202 vtBoolean
: lua_pushboolean(gScriptCtx
, vBoolean
);
203 vtString
: lua_pushstring(gScriptCtx
, vString
^);
204 vtAnsiString
: lua_pushstring(gScriptCtx
, PAnsiString(vAnsiString
)^);
205 vtExtended
: lua_pushnumber(gScriptCtx
, vExtended
^);
209 if lua_pcall(gScriptCtx
, Length(Args
), 1, 0) <> 0 then
211 g_Console_Add('SCRIPT: ProcExec(' + Namespace
+ '.' + PName
+ ') error: ' + lua_tostring(gScriptCtx
, -1));
216 if lua_isnumber(gScriptCtx
, -1) then
218 Result
:= lua_tointeger(gScriptCtx
, -1);
219 lua_pop(gScriptCtx
, 1);
223 function g_Scripts_Load(Text: string): Boolean;
226 if not gScriptInit
then Exit
;
228 if lua_dostring(gScriptCtx
, PChar(Text)) <> 0 then
230 g_Console_Add('SCRIPT: Load() error: ' + lua_tostring(gScriptCtx
, -1));
237 procedure g_Scripts_Free();
239 if not gScriptInit
then Exit
;
240 lua_close(gScriptCtx
);
241 gScriptInit
:= False;