set/remove_script and HOOK_STDPROCEDURE{_END} (#392)

* `set/remove_script` and `HOOK_STDPROCEDURE{_END}`

These were implemented together as I thought HOOK_STDPROCEDURE would be useful for testing set_script.

SFALL_COMPATIBILITY.md

@@ -66,7 +66,7 @@ See [`https://sfall-team.github.io/sfall/`](https://sfall-team.github.io/sfall/)
 | Interface / Cursor | get/set_cursor_mode | ✅ | - |
 | Locks | lock_is_jammed<br>unjam_lock<br>set_unjam_locks_time | not implemented | - |
 | INI settings | get_ini_setting<br>get_ini_string<br>get_ini_section<br>get_ini_sections<br>get_ini_config<br>get_ini_config_db<br>set_ini_setting | ✅ except get_ini_config, get_ini_config_db | `modified_ini` is intentionally omitted as deprecated. |
-| Objects and scripts | set_self<br>set_dude_obj<br>real_dude_obj<br>remove_script<br>get/set_script<br>obj_is_carrying_obj<br>loot_obj<br>dialog_obj<br>obj_under_cursor<br>get/set_object_data<br>get/set_flags<br>set_unique_id<br>set_scr_name<br>obj_is_openable<br>get/set_proto_data<br>get_object_ai_data | implemented: set_self, get_script, obj_is_carrying_obj, loot_obj, dialog_obj, obj_under_cursor, get_object_data, get_flags, set_flags, obj_is_openable, get_proto_data, set_proto_data | - |
+| Objects and scripts | set_self<br>set_dude_obj<br>real_dude_obj<br>remove_script<br>get/set_script<br>obj_is_carrying_obj<br>loot_obj<br>dialog_obj<br>obj_under_cursor<br>get/set_object_data<br>get/set_flags<br>set_unique_id<br>set_scr_name<br>obj_is_openable<br>get/set_proto_data<br>get_object_ai_data | implemented: set_self, get/set/remove_script, obj_is_carrying_obj, loot_obj, dialog_obj, obj_under_cursor, get_object_data, get_flags, set_flags, obj_is_openable, get_proto_data, set_proto_data | - |
 | Other / Game management | set_movie_path<br>stop/resume_game<br>mark_movie_played<br>game_loaded<br>get_game_mode<br>get_uptime<br>signal_close_game | implemented: game_loaded, get_game_mode, get_uptime, signal_close_game | - |
 | Gameplay tweaks | set_pickpocket_max<br>set_hit_chance_max<br>set_xp_mod<br>set_critter_hit_chance_mod<br>set_base_hit_chance_mod<br>set_hp_per_level_mod<br>get_unspent_ap_bonus<br>gdialog_get_barter_mod<br>set_unspent_ap_bonus<br>get/set_unspent_ap_perk_bonus<br>set_inven_ap_cost<br>set_base_pickpocket_mod<br>set_critter_pickpocket_mod<br>get_inven_ap_cost<br>set_drugs_data<br>get_kill_counter<br>mod_kill_counter<br>set_pipboy_available | implemented: gdialog_get_barter_mod | - |
 | NPCs | inc_npc_level<br>get_npc_level<br>npc_engine_level_up | not implemented | - |
@@ -100,8 +100,8 @@ See [`https://sfall-team.github.io/sfall/`](https://sfall-team.github.io/sfall/)
 | InvenWield | `HOOK_INVENWIELD` | 🚫 | - |
 | AdjustFID | `HOOK_ADJUSTFID` | 🚫 | - |
 | CombatTurn | `HOOK_COMBATTURN` | ✅ | - |
-| StdProcedure | `HOOK_STDPROCEDURE` | 🚫 | Et tu |
-| StdProcedureEnd | `HOOK_STDPROCEDURE_END` | 🚫 | - |
+| StdProcedure | `HOOK_STDPROCEDURE` | ✅ | - |
+| StdProcedureEnd | `HOOK_STDPROCEDURE_END` | ✅ | - |
 | CarTravel | `HOOK_CARTRAVEL` | 🚫 | - |
 | SetGlobalVar | `HOOK_SETGLOBALVAR` | 🚫 | - |
 | RestTimer | `HOOK_RESTTIMER` | 🚫 | Et tu |

sfall_testing/gl_test_script_manipulation.ssl

@@ -0,0 +1,59 @@
+#include "sfall.h"
+#include "test_utils.h"
+
+#define TEST_SCRIPT_INDEX (2)
+// Depends on Test0.int, which provides a controllable object script helper.
+// Put the compiled helper at mods/test_script_override/scripts/Test0.int,
+// and add "test_script_override" to mod_order.txt. The helper must live there
+// (and not scripts/) because patch000.dat already contains a stock Test0.int and
+// scripts/ load before it.
+// Without Test0, these 2 tests will fail:
+// - "set_script normal hp"
+// - "set_script no map_enter hp"
+
+variable testScriptObj := 0;
+
+procedure create_test_object begin
+    if (testScriptObj != 0) then return;
+    testScriptObj := create_object_sid(obj_pid(dude_obj), tile_num_in_direction(tile_num(dude_obj), has_trait(TRAIT_OBJECT, dude_obj, OBJECT_CUR_ROT), 3), elevation(dude_obj), -1);
+end
+
+procedure stdprocedure_hook begin
+    if (get_sfall_arg_at(0) != 15) then return;
+
+    if (get_sfall_arg_at(3)) then begin
+        set_sfall_global("T0HAFTR1", 1);
+    end else begin
+        set_sfall_global("T0HBEFO1", 1);
+    end
+end
+
+procedure exercise_set_script(variable scriptId, variable expectedHp, variable expectedBeforeHook, variable expectedAfterHook, variable desc) begin
+    set_sfall_global("T0MAPEN1", 0);
+    set_sfall_global("T0HBEFO1", 0);
+    set_sfall_global("T0HAFTR1", 0);
+    set_script(testScriptObj, scriptId);
+    call assertEquals(desc + " get_script", get_script(testScriptObj), TEST_SCRIPT_INDEX);
+    call assertEquals(desc + " map_enter global", get_sfall_global_int("T0MAPEN1"), expectedHp);
+    call assertEquals(desc + " stdprocedure hook before", get_sfall_global_int("T0HBEFO1"), expectedBeforeHook);
+    call assertEquals(desc + " stdprocedure hook after", get_sfall_global_int("T0HAFTR1"), expectedAfterHook);
+    remove_script(testScriptObj);
+    call assertEquals(desc + " remove_script clears get_script", get_script(testScriptObj), 0);
+end
+
+procedure start begin
+    if (not game_loaded) then return;
+
+    display_msg("Testing set_script/remove_script/get_script...");
+    register_hook_proc(HOOK_STDPROCEDURE, stdprocedure_hook);
+    register_hook_proc(HOOK_STDPROCEDURE_END, stdprocedure_hook);
+    call create_test_object;
+
+    call exercise_set_script(TEST_SCRIPT_INDEX, 22, 1, 1, "set_script normal");
+    call exercise_set_script(TEST_SCRIPT_INDEX bwor 0x80000000, 11, 0, 0, "set_script no map_enter");
+
+    destroy_object(testScriptObj);
+    testScriptObj := 0;
+
+    call report_test_results("script_manipulation");
+end

src/obj_types.h

@@ -287,7 +287,7 @@ typedef struct Object {
     int outline; // obj_outline
     int sid; // obj_sid
     Object* owner;
-    int scriptIndex;
+    int scriptIndex; // TODO: remove
 } Object;
 
 typedef struct ObjectListNode {

src/proto_instance.cc

@@ -130,7 +130,7 @@ int objectSetScriptFromProto(Object* object, int* sidPtr)
     return 0;
 }
 
-// 0x49AAC0
+// 0x49AAC0 obj_new_sid_inst
 int objectSetScript(Object* obj, int scriptType, int scriptIndex)
 {
     if (scriptIndex == -1) {

src/scripts.cc

@@ -34,6 +34,7 @@
 #include "sfall_arrays.h"
 #include "sfall_config.h"
 #include "sfall_global_scripts.h"
+#include "sfall_script_hooks.h"
 #include "stat.h"
 #include "svga.h"
 #include "tile.h"
@@ -1208,8 +1209,7 @@ void _script_make_path(char* path)
     strcat(path, gScriptsBasePath);
 }
 
-// exec_script_proc
-// 0x4A4810
+// 0x4A4810 exec_script_proc
 int scriptExecProc(int sid, int proc)
 {
     assert(proc >= 0 && proc < SCRIPT_PROC_COUNT);
@@ -1276,6 +1276,7 @@ int scriptExecProc(int sid, int proc)
     // CE: Fix for the start procedure not being called correctly if the required standard script procedure is missing.
     int procedureIndex = script->procs[proc];
     if (procedureIndex == 0) {
+        // Fixme: hook receives `proc` which is wrong in this context
         procedureIndex = script->procs[SCRIPT_PROC_START];
         if (procedureIndex == 0) {
             procedureIndex = -1;
@@ -1288,9 +1289,25 @@ int scriptExecProc(int sid, int proc)
 
     script->action = proc;
 
+    Object* self = script->owner;
+    Object* source = script->source;
+    Object* target = script->target;
+    int fixedParam = script->fixedParam;
+
+    // HOOK_STDPROCEDURE
+    if (scriptHooks_StdProcedure(proc, self, source, target, fixedParam, false)) {
+        script->action = 0;
+        script->source = nullptr;
+        return -1;
+    }
+
     programExecuteProcedure(program, procedureIndex);
 
+    // HOOK_STDPROCEDURE_END
+    scriptHooks_StdProcedure(proc, self, source, target, fixedParam, true);
+
     script->source = nullptr;
+    script->action = 0;
 
     return 0;
 }
@@ -1408,6 +1425,11 @@ static int scriptsGetFileName(int scriptIndex, char* name, size_t size)
     return 0;
 }
 
+bool scriptsIsValidScriptIndex(int scriptIndex)
+{
+    return scriptIndex >= 0 && scriptIndex < gScriptsListEntriesLength;
+}
+
 // scr_set_dude_script
 // 0x4A4F90
 int scriptsSetDudeScript()

src/scripts.h

@@ -210,6 +210,7 @@ int scriptSaveAll(File* stream);
 int scriptLoadAll(File* stream);
 int scriptGetScript(int sid, Script** script);
 int scriptAdd(int* sidPtr, int scriptType);
+bool scriptsIsValidScriptIndex(int scriptIndex);
 int scriptRemove(int index);
 int _scr_remove_all();
 int _scr_remove_all_force();

src/sfall_opcodes.cc

@@ -25,6 +25,7 @@
 #include "object.h"
 #include "party_member.h"
 #include "proto.h"
+#include "proto_instance.h"
 #include "scripts.h"
 #include "sfall_animation.h"
 #include "sfall_arrays.h"
@@ -477,7 +478,94 @@ static void op_exponent(Program* program)
 static void op_get_script(Program* program)
 {
     Object* obj = static_cast<Object*>(programStackPopPointer(program));
-    programStackPushInteger(program, obj->scriptIndex + 1);
+    if (obj == nullptr) {
+        programStackPushInteger(program, -1);
+        return;
+    }
+
+    if (obj->sid == -1) {
+        programStackPushInteger(program, 0);
+        return;
+    }
+
+    Script* script;
+    if (scriptGetScript(obj->sid, &script) == -1 || script->index < 0) {
+        programStackPushInteger(program, 0);
+        return;
+    }
+
+    programStackPushInteger(program, script->index + 1);
+}
+
+// remove_script
+static void op_remove_script(Program* program)
+{
+    Object* obj = static_cast<Object*>(programStackPopPointer(program));
+    if (obj == nullptr || obj->sid == -1) {
+        return;
+    }
+
+    scriptRemove(obj->sid);
+    obj->sid = -1;
+    obj->scriptIndex = -1;
+}
+
+// set_script
+static void op_set_script(Program* program)
+{
+    int scriptId = programStackPopInteger(program);
+    Object* obj = static_cast<Object*>(programStackPopPointer(program));
+
+    if (obj == nullptr) {
+        return;
+    }
+
+    unsigned int rawScriptId = static_cast<unsigned int>(scriptId);
+    // sfall encodes set_script() ids as a 1-based script index in the low
+    // 28 bits, with the upper bits reserved for flags. The top bit
+    // (0x80000000) suppresses map_enter_p_proc after start().
+    int scriptIndex = static_cast<int>(rawScriptId & ~0xF0000000u);
+    if (scriptIndex == 0) {
+        programPrintError("set_script: invalid script index number %d.", scriptIndex);
+        return;
+    }
+
+    scriptIndex--;
+    if (!scriptsIsValidScriptIndex(scriptIndex)) {
+        programPrintError("set_script: invalid script index (engine) number %d.", scriptIndex);
+        return;
+    }
+
+    if (obj->sid != -1) {
+        scriptRemove(obj->sid);
+        obj->sid = -1;
+        obj->scriptIndex = -1;
+    }
+
+    int scriptType = (PID_TYPE(obj->pid) == OBJ_TYPE_CRITTER) ? SCRIPT_TYPE_CRITTER : SCRIPT_TYPE_ITEM;
+    if (objectSetScript(obj, scriptType, scriptIndex) == -1) {
+        obj->sid = -1;
+        obj->scriptIndex = -1;
+        return;
+    }
+
+    Script* script;
+    if (scriptGetScript(obj->sid, &script) == -1) {
+        scriptRemove(obj->sid);
+        obj->sid = -1;
+        obj->scriptIndex = -1;
+        return;
+    }
+
+    int sid = obj->sid;
+    script->owner = obj;
+    obj->scriptIndex = scriptIndex;
+
+    scriptExecProc(sid, SCRIPT_PROC_START);
+    if ((rawScriptId & 0x80000000u) == 0) {
+        // note: if map_enter_p_proc is missing, START gets executed again
+        scriptExecProc(sid, SCRIPT_PROC_MAP_ENTER);
+    }
 }
 
 // get_proto_data
@@ -1877,7 +1965,9 @@ void sfallOpcodesInit()
     // 0x81f2 - void set_palette(string path)
 
     // 0x81f3 - void remove_script(object)
+    interpreterRegisterOpcode(0x81F3, op_remove_script);
     // 0x81f4 - void set_script(object, int scriptid)
+    interpreterRegisterOpcode(0x81F4, op_set_script);
     // 0x81f5 - int get_script(object)
     interpreterRegisterOpcode(0x81F5, op_get_script);
 

src/sfall_script_hooks.cc

@@ -131,6 +131,40 @@ bool scriptHooksRegister(Program* program, const HookType hookType, const int pr
     return true; // register success
 }
 
+/*
+Runs before/after Fallout executes a standard procedure (handler) in any script
+of any object. This hook will not be executed for `start`, `critter_p_proc`,
+`timed_event_p_proc`, or `map_update_p_proc`.
+
+int     arg0 - the number of the standard script handler (see *_proc in define.h)
+Obj     arg1 - the object that owns this handler (self_obj)
+Obj     arg2 - the object that called this handler (source_obj, can be 0)
+int     arg3 - always 0 for HOOK_STDPROCEDURE, always 1 for HOOK_STDPROCEDURE_END
+Obj     arg4 - the object that is acted upon by this handler (target_obj, can be 0)
+int     arg5 - the parameter of this call (fixed_param), useful for combat_proc
+
+int     ret0 - pass -1 to cancel the execution of the handler
+*/
+bool scriptHooks_StdProcedure(int procedureNumber, Object* self, Object* source, Object* target, int fixedParam, bool after)
+{
+    if (procedureNumber == SCRIPT_PROC_START
+        || procedureNumber == SCRIPT_PROC_CRITTER
+        || procedureNumber == SCRIPT_PROC_TIMED
+        || procedureNumber == SCRIPT_PROC_MAP_UPDATE) {
+        return false;
+    }
+
+    ScriptHookCall hook(after ? HOOK_STDPROCEDURE_END : HOOK_STDPROCEDURE, after ? 0 : 1,
+        { procedureNumber, self, source, after ? 1 : 0, target, fixedParam });
+    hook.call();
+
+    if (after || hook.numReturnValues() <= 0) {
+        return false;
+    }
+
+    return hook.getReturnValueAt(0).asInt() == -1;
+}
+
 static void scriptHooksClear()
 {
     for (auto& hooks : scriptHooks) {

src/sfall_script_hooks.h

@@ -251,6 +251,7 @@ struct BarterPriceContext {
 };
 
 bool scriptHooksRegister(Program* program, HookType hookType, int procedureIndex);
+bool scriptHooks_StdProcedure(int procedureNumber, Object* self, Object* source, Object* target, int fixedParam, bool after);
 
 bool scriptHooksInit();
 void scriptHooksReset();