src/game/g_scripts.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   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.
   7  *
   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.
  12  *
  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/>.
  15  *)
  16 {$MODE DELPHI}
  17 unit g_scripts;
  18
  19 interface
  20
  21 uses
  22   lua, lualib, lauxlib;
  23
  24 const
  25   // reset levels
  26   RESET_ALL  = 0;
  27   RESET_SRV  = 1;
  28   RESET_WAD  = 2;
  29   RESET_MAP  = 3;
  30
  31 type
  32   PScriptContext = Plua_State;
  33   PScriptProc = lua_CFunction;
  34
  35 var
  36   gScriptCtx: PScriptContext = nil;
  37   gScriptInit: Boolean = False;
  38
  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();
  46
  47 implementation
  48
  49 uses
  50   SysUtils, g_console, g_scriptprocs;
  51
  52 type
  53   POpenFunc = function(L: Plua_State): LongBool; cdecl;
  54   TLuaReg = record
  55     name: PAnsiChar;
  56     func: POpenFunc;
  57   end;
  58
  59 const
  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)
  65   );
  66
  67 function LuaInstallGameFuncs(): Boolean;
  68 begin
  69   Result := False;
  70
  71   if not g_Scripts_ProcInstall('conprint', SP_Lua_ConPrint) then Exit;
  72
  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;
  77
  78   Result := True;
  79 end;
  80
  81 function g_Scripts_Init(): Boolean;
  82 var
  83   i: Integer;
  84 begin
  85   Result := False;
  86   if gScriptInit then Exit;
  87
  88   gScriptCtx := luaL_newstate();
  89   if gScriptCtx = nil then Exit;
  90
  91   // don't open all the libs
  92   for i := 0 to High(LUA_LIBS) do
  93   begin
  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);
  98   end;
  99
 100   // create a table for game-related functions
 101   lua_newtable(gScriptCtx);
 102   lua_setglobal(gScriptCtx, 'game');
 103
 104   // create game-related tables
 105   g_Scripts_Reset(RESET_ALL);
 106
 107   gScriptInit := True;
 108   // try to install game-related shit
 109   if not LuaInstallGameFuncs() then
 110   begin
 111     g_Console_Add('SCRIPT: Could not init game callbacks');
 112     lua_close(gScriptCtx);
 113     gScriptCtx := nil;
 114     gScriptInit := False;
 115     Exit;
 116   end;
 117
 118   Result := True;
 119 end;
 120
 121 // TODO: maybe actually put some fields into these?
 122 procedure g_Scripts_Reset(What: Integer);
 123 begin
 124   if not gScriptInit then Exit;
 125   if What in [RESET_ALL, RESET_SRV] then
 126   begin
 127     lua_newtable(gScriptCtx);
 128     lua_setglobal(gScriptCtx, 'srv');
 129   end;
 130   if What in [RESET_ALL, RESET_WAD] then
 131   begin
 132     lua_newtable(gScriptCtx);
 133     lua_setglobal(gScriptCtx, 'wad');
 134   end;
 135   if What in [RESET_ALL, RESET_MAP] then
 136   begin
 137     lua_newtable(gScriptCtx);
 138     lua_setglobal(gScriptCtx, 'map');
 139   end;
 140 end;
 141
 142 function g_Scripts_ProcInstall(PName: string; PPtr: PScriptProc): Boolean;
 143 begin
 144   Result := False;
 145   if not gScriptInit then Exit;
 146
 147   if g_Scripts_ProcExists(PName) then
 148   begin
 149     g_Console_Add('SCRIPT: ProcInstall(' + PName + '): function already exists');
 150     Exit;
 151   end;
 152
 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');
 158
 159   Result := True;
 160 end;
 161
 162 function g_Scripts_ProcExists(PName: string): Boolean;
 163 begin
 164   Result := False;
 165   if not gScriptInit then Exit;
 166
 167   lua_getglobal(gScriptCtx, 'game');
 168   lua_pushstring(gScriptCtx, PName);
 169   lua_gettable(gScriptCtx, -2);
 170
 171   if lua_isfunction(gScriptCtx, -1) then
 172     Result := True;
 173 end;
 174
 175 function g_Scripts_ProcExec(PName: string; const Args: array of const; Namespace: string = ''): Integer;
 176 var
 177   i: Integer;
 178 begin
 179   Result := -255;
 180   if not gScriptInit then Exit;
 181
 182   if Namespace = '' then
 183     lua_getglobal(gScriptCtx, PChar(PName))
 184   else
 185   begin
 186     lua_getglobal(gScriptCtx, PChar(Namespace));
 187     lua_pushstring(gScriptCtx, PName);
 188     lua_gettable(gScriptCtx, -2);
 189   end;
 190
 191   if not lua_isfunction(gScriptCtx, -1) then
 192   begin
 193     g_Console_Add('SCRIPT: ProcExec(' + Namespace + '.' + PName + ') error: no such function');
 194     Exit;
 195   end;
 196
 197   for i := 0 to High(Args) do
 198     with Args[i] do
 199     begin
 200       case VType of
 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^);
 206       end;
 207     end;
 208
 209   if lua_pcall(gScriptCtx, Length(Args), 1, 0) <> 0 then
 210   begin
 211     g_Console_Add('SCRIPT: ProcExec(' + Namespace + '.' + PName + ') error: ' + lua_tostring(gScriptCtx, -1));
 212     Exit;
 213   end;
 214
 215   Result := 0;
 216   if lua_isnumber(gScriptCtx, -1) then
 217   begin
 218     Result := lua_tointeger(gScriptCtx, -1);
 219     lua_pop(gScriptCtx, 1);
 220   end;
 221 end;
 222
 223 function g_Scripts_Load(Text: string): Boolean;
 224 begin
 225   Result := False;
 226   if not gScriptInit then Exit;
 227
 228   if lua_dostring(gScriptCtx, PChar(Text)) <> 0 then
 229   begin
 230     g_Console_Add('SCRIPT: Load() error: ' + lua_tostring(gScriptCtx, -1));
 231     Exit;
 232   end;
 233
 234   Result := True;
 235 end;
 236
 237 procedure g_Scripts_Free();
 238 begin
 239   if not gScriptInit then Exit;
 240   lua_close(gScriptCtx);
 241   gScriptInit := False;
 242   gScriptCtx := nil;
 243 end;
 244
 245 end.