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   if not g_Scripts_ProcInstall('message', SP_Lua_Message) then Exit;
  73   if not g_Scripts_ProcInstall('sound', SP_Lua_PlaySound) then Exit;
  74   if not g_Scripts_ProcInstall('get_gamemode', SP_Lua_GetGameMode) then Exit;
  75   if not g_Scripts_ProcInstall('get_gametype', SP_Lua_GetGameType) then Exit;
  76   if not g_Scripts_ProcInstall('get_time', SP_Lua_GetTime) then Exit;
  77
  78   if not g_Scripts_ProcInstall('player_get_keys', SP_Lua_PlayerGetKeys) then Exit;
  79   if not g_Scripts_ProcInstall('player_get_armor', SP_Lua_PlayerGetArmor) then Exit;
  80   if not g_Scripts_ProcInstall('player_get_score', SP_Lua_PlayerGetScore) then Exit;
  81   if not g_Scripts_ProcInstall('player_get_name', SP_Lua_PlayerGetName) then Exit;
  82   if not g_Scripts_ProcInstall('player_get_team', SP_Lua_PlayerGetTeam) then Exit;
  83
  84   if not g_Scripts_ProcInstall('uid_get_health', SP_Lua_ActorGetHealth) then Exit;
  85   if not g_Scripts_ProcInstall('uid_get_pos', SP_Lua_ActorGetPos) then Exit;
  86   if not g_Scripts_ProcInstall('uid_get_state', SP_Lua_ActorGetState) then Exit;
  87   if not g_Scripts_ProcInstall('uid_get_type', SP_Lua_ActorGetType) then Exit;
  88   if not g_Scripts_ProcInstall('uid_nearest', SP_Lua_ActorNearest) then Exit;
  89   if not g_Scripts_ProcInstall('uid_farthest', SP_Lua_ActorFarthest) then Exit;
  90   if not g_Scripts_ProcInstall('uid_damage', SP_Lua_ActorDamage) then Exit;
  91   if not g_Scripts_ProcInstall('uid_push', SP_Lua_ActorPush) then Exit;
  92   if not g_Scripts_ProcInstall('uid_teleport', SP_Lua_ActorTeleport) then Exit;
  93
  94   if not g_Scripts_ProcInstall('trigger_get_enabled', SP_Lua_TriggerGetEnabled) then Exit;
  95   if not g_Scripts_ProcInstall('trigger_set_enabled', SP_Lua_TriggerSetEnabled) then Exit;
  96   if not g_Scripts_ProcInstall('trigger_activate', SP_Lua_TriggerActivate) then Exit;
  97   if not g_Scripts_ProcInstall('trigger_get_pos', SP_Lua_TriggerGetPos) then Exit;
  98   if not g_Scripts_ProcInstall('trigger_set_pos', SP_Lua_TriggerSetPos) then Exit;
  99
 100   if not g_Scripts_ProcInstall('panel_get_type', SP_Lua_PanelGetType) then Exit;
 101   if not g_Scripts_ProcInstall('panel_get_pos', SP_Lua_PanelGetPos) then Exit;
 102   if not g_Scripts_ProcInstall('panel_get_size', SP_Lua_PanelGetSize) then Exit;
 103   if not g_Scripts_ProcInstall('panel_set_pos', SP_Lua_PanelSetPos) then Exit;
 104   if not g_Scripts_ProcInstall('panel_switch_texture', SP_Lua_PanelSwitchTexture) then Exit;
 105
 106   if not g_Scripts_ProcInstall('door_get_open', SP_Lua_DoorGetState) then Exit;
 107   if not g_Scripts_ProcInstall('door_close', SP_Lua_DoorClose) then Exit;
 108   if not g_Scripts_ProcInstall('door_close_trap', SP_Lua_DoorCloseTrap) then Exit;
 109   if not g_Scripts_ProcInstall('door_open', SP_Lua_DoorOpen) then Exit;
 110   if not g_Scripts_ProcInstall('door_toggle', SP_Lua_DoorToggle) then Exit;
 111   if not g_Scripts_ProcInstall('lift_get_dir', SP_Lua_LiftGetDir) then Exit;
 112   if not g_Scripts_ProcInstall('lift_set_dir', SP_Lua_LiftSetDir) then Exit;
 113
 114   if not g_Scripts_ProcInstall('spawn_item', SP_Lua_SpawnItem) then Exit;
 115   if not g_Scripts_ProcInstall('spawn_shot', SP_Lua_SpawnShot) then Exit;
 116   if not g_Scripts_ProcInstall('spawn_effect', SP_Lua_SpawnEffect) then Exit;
 117   if not g_Scripts_ProcInstall('spawn_monster', SP_Lua_SpawnMonster) then Exit;
 118
 119   Result := True;
 120 end;
 121
 122 function g_Scripts_Init(): Boolean;
 123 var
 124   i: Integer;
 125 begin
 126   Result := False;
 127   if gScriptInit then Exit;
 128
 129   gScriptCtx := luaL_newstate();
 130   if gScriptCtx = nil then Exit;
 131
 132   // don't open all the libs
 133   for i := 0 to High(LUA_LIBS) do
 134   begin
 135     //lua_pushcfunction(gScriptCtx, LUA_LIBS[i].func);
 136     lua_pushstring(gScriptCtx, LUA_LIBS[i].name);
 137     //lua_call(gScriptCtx, 1, 0);
 138     LUA_LIBS[i].func(gScriptCtx);
 139   end;
 140
 141   // create a table for game-related functions
 142   lua_newtable(gScriptCtx);
 143   lua_setglobal(gScriptCtx, 'game');
 144
 145   // create game-related tables
 146   g_Scripts_Reset(RESET_ALL);
 147
 148   gScriptInit := True;
 149   // try to install game-related shit
 150   if not LuaInstallGameFuncs() then
 151   begin
 152     g_Console_Add('SCRIPT: Could not init game callbacks');
 153     lua_close(gScriptCtx);
 154     gScriptCtx := nil;
 155     gScriptInit := False;
 156     Exit;
 157   end;
 158
 159   Result := True;
 160 end;
 161
 162 // TODO: maybe actually put some fields into these?
 163 procedure g_Scripts_Reset(What: Integer);
 164 begin
 165   if not gScriptInit then Exit;
 166   if What in [RESET_ALL, RESET_SRV] then
 167   begin
 168     lua_newtable(gScriptCtx);
 169     lua_setglobal(gScriptCtx, 'srv');
 170   end;
 171   if What in [RESET_ALL, RESET_WAD] then
 172   begin
 173     lua_newtable(gScriptCtx);
 174     lua_setglobal(gScriptCtx, 'wad');
 175   end;
 176   if What in [RESET_ALL, RESET_MAP] then
 177   begin
 178     lua_newtable(gScriptCtx);
 179     lua_setglobal(gScriptCtx, 'map');
 180   end;
 181 end;
 182
 183 function g_Scripts_ProcInstall(PName: string; PPtr: PScriptProc): Boolean;
 184 begin
 185   Result := False;
 186   if not gScriptInit then Exit;
 187
 188   if g_Scripts_ProcExists(PName) then
 189   begin
 190     g_Console_Add('SCRIPT: ProcInstall(' + PName + '): function already exists');
 191     Exit;
 192   end;
 193
 194   lua_getglobal(gScriptCtx, 'game');
 195   lua_pushstring(gScriptCtx, PName);
 196   lua_pushcfunction(gScriptCtx, PPtr);
 197   lua_settable(gScriptCtx, -3);
 198   lua_setglobal(gScriptCtx, 'game');
 199
 200   Result := True;
 201 end;
 202
 203 function g_Scripts_ProcExists(PName: string): Boolean;
 204 begin
 205   Result := False;
 206   if not gScriptInit then Exit;
 207
 208   lua_getglobal(gScriptCtx, 'game');
 209   lua_pushstring(gScriptCtx, PName);
 210   lua_gettable(gScriptCtx, -2);
 211
 212   if lua_isfunction(gScriptCtx, -1) then
 213     Result := True;
 214 end;
 215
 216 function g_Scripts_ProcExec(PName: string; const Args: array of const; Namespace: string = ''): Integer;
 217 var
 218   i: Integer;
 219 begin
 220   Result := -255;
 221   if not gScriptInit then Exit;
 222
 223   if Namespace = '' then
 224     lua_getglobal(gScriptCtx, PChar(PName))
 225   else
 226   begin
 227     lua_getglobal(gScriptCtx, PChar(Namespace));
 228     lua_pushstring(gScriptCtx, PName);
 229     lua_gettable(gScriptCtx, -2);
 230   end;
 231
 232   if not lua_isfunction(gScriptCtx, -1) then
 233   begin
 234     g_Console_Add('SCRIPT: ProcExec(' + Namespace + '.' + PName + ') error: no such function');
 235     Exit;
 236   end;
 237
 238   for i := 0 to High(Args) do
 239     with Args[i] do
 240     begin
 241       case VType of
 242         vtInteger: lua_pushinteger(gScriptCtx, vInteger);
 243         vtBoolean: lua_pushboolean(gScriptCtx, vBoolean);
 244         vtString: lua_pushstring(gScriptCtx, vString^);
 245         vtAnsiString: lua_pushstring(gScriptCtx, PAnsiString(vAnsiString)^);
 246         vtExtended: lua_pushnumber(gScriptCtx, vExtended^);
 247       end;
 248     end;
 249
 250   if lua_pcall(gScriptCtx, Length(Args), 1, 0) <> 0 then
 251   begin
 252     g_Console_Add('SCRIPT: ProcExec(' + Namespace + '.' + PName + ') error: ' + lua_tostring(gScriptCtx, -1));
 253     Exit;
 254   end;
 255
 256   Result := 0;
 257   if lua_isnumber(gScriptCtx, -1) then
 258   begin
 259     Result := lua_tointeger(gScriptCtx, -1);
 260     lua_pop(gScriptCtx, 1);
 261   end;
 262 end;
 263
 264 function g_Scripts_Load(Text: string): Boolean;
 265 begin
 266   Result := False;
 267   if not gScriptInit then Exit;
 268
 269   if lua_dostring(gScriptCtx, PChar(Text)) <> 0 then
 270   begin
 271     g_Console_Add('SCRIPT: Load() error: ' + lua_tostring(gScriptCtx, -1));
 272     Exit;
 273   end;
 274
 275   Result := True;
 276 end;
 277
 278 procedure g_Scripts_Free();
 279 begin
 280   if not gScriptInit then Exit;
 281   lua_close(gScriptCtx);
 282   gScriptInit := False;
 283   gScriptCtx := nil;
 284 end;
 285
 286 end.