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