From 73c1a485fb6c9fdaea11ff5cfd1b57852d650764 Mon Sep 17 00:00:00 2001 From: Aly Date: Fri, 2 Apr 2021 15:13:54 -0700 Subject: [PATCH] Switch decoding over to a Monad for portability At some point this may run on BizHawk so that I can draw information instead of having the very limited Dolphin text. I should really start working on my own Amulet prelude... There's lots of stuff from cats that I miss here. --- dolphin.ml | 11 ++++++ main.ml | 3 +- mem/decode.ml | 37 ++++++++++++++++++- mem/int.ml | 63 +++++++++----------------------- oot/equipment.ml | 13 +++++-- oot/inventory.ml | 51 ++++++++++++++++++-------- oot/item.ml | 46 ++++++++++++++++++++++- oot/item_equips.ml | 30 ++++++++++----- oot/save_context.ml | 89 +++++++++++++++++++++++++++++++-------------- reader.ml | 19 ++++++++++ 10 files changed, 255 insertions(+), 107 deletions(-) create mode 100644 reader.ml diff --git a/dolphin.ml b/dolphin.ml index ab81ee6..a51c4a8 100644 --- a/dolphin.ml +++ b/dolphin.ml @@ -1,4 +1,6 @@ open import "prelude.ml" +open import "./mem/decode.ml" +open import "./mem/int.ml" module Dolphin = struct external val read_value_8 : int -> int = "ReadValue8" @@ -9,4 +11,13 @@ module Dolphin = struct external val msg_box : string -> int -> () = "MsgBox" external val set_screen_text : string -> () = "SetScreenText" + + let decoding_context : decoding_context = DecodingContext { + read_u8 = U8 # read_value_8, + read_u16 = U16 # read_value_16, + read_u32 = U32 # read_value_32, + read_s8 = u8_to_s8 # U8 # read_value_8, + read_s16 = u16_to_s16 # U16 # read_value_16, + read_s32 = u32_to_s32 # U32 # read_value_32 + } end diff --git a/main.ml b/main.ml index 06bf99f..e9461a3 100644 --- a/main.ml +++ b/main.ml @@ -1,5 +1,6 @@ open import "prelude.ml" +open import "./reader.ml" open import "./pretty.ml" open import "./dolphin.ml" @@ -16,7 +17,7 @@ let onScriptStart () = () let onScriptCancel () = () let onScriptUpdate () = - let save_ctx : save_context = decode (base_address + g_save_ctx_address) + let save_ctx : save_context = r_run (decode (base_address + g_save_ctx_address)) Dolphin.decoding_context let text : string = pretty save_ctx 0 Dolphin.set_screen_text text diff --git a/mem/decode.ml b/mem/decode.ml index 081b179..c134c5e 100644 --- a/mem/decode.ml +++ b/mem/decode.ml @@ -1,5 +1,40 @@ open import "prelude.ml" +open import "./int.ml" +open import "../reader.ml" + +type decoding_context = DecodingContext of { + read_u8 : int -> u8, + read_s8 : int -> s8, + read_u16 : int -> u16, + read_s16 : int -> s16, + read_u32 : int -> u32, + read_s32 : int -> s32 +} class decode 'a begin - val decode : int -> 'a + val decode : int -> reader decoding_context 'a +end + +instance decode u8 begin + let decode addr = Reader (fun (DecodingContext c) -> c.read_u8 addr) +end + +instance decode s8 begin + let decode addr = Reader (fun (DecodingContext c) -> c.read_s8 addr) +end + +instance decode u16 begin + let decode addr = Reader (fun (DecodingContext c) -> c.read_u16 addr) +end + +instance decode s16 begin + let decode addr = Reader (fun (DecodingContext c) -> c.read_s16 addr) +end + +instance decode u32 begin + let decode addr = Reader (fun (DecodingContext c) -> c.read_u32 addr) +end + +instance decode s32 begin + let decode addr = Reader (fun (DecodingContext c) -> c.read_s32 addr) end diff --git a/mem/int.ml b/mem/int.ml index e5e9749..e807981 100644 --- a/mem/int.ml +++ b/mem/int.ml @@ -1,6 +1,4 @@ open import "prelude.ml" -open import "./decode.ml" -open import "../dolphin.ml" type u8 = U8 of int @@ -9,10 +7,6 @@ instance show u8 begin let show (U8 x) = (show x) ^ "_u8" end -instance decode u8 begin - let decode addr = U8 (Dolphin.read_value_8 addr) -end - type s8 = S8 of int @@ -20,17 +14,6 @@ instance show s8 begin let show (S8 x) = (show x) ^ "_s8" end -instance decode s8 begin - let decode addr = - let u8 = Dolphin.read_value_8 addr - let signfix = - if u8 > 0xFF then - negate (0x100 - u8) - else - u8 - S8 signfix -end - type u16 = U16 of int @@ -38,10 +21,6 @@ instance show u16 begin let show (U16 x) = (show x) ^ "_u16" end -instance decode u16 begin - let decode addr = U16 (Dolphin.read_value_16 addr) -end - type s16 = S16 of int @@ -49,17 +28,6 @@ instance show s16 begin let show (S16 x) = (show x) ^ "_s16" end -instance decode s16 begin - let decode addr = - let u16 = Dolphin.read_value_16 addr - let signfix = - if u16 > 0xFFFF then - negate (0x10000 - u16) - else - u16 - S16 signfix -end - type u32 = U32 of int @@ -67,10 +35,6 @@ instance show u32 begin let show (U32 x) = (show x) ^ "_u32" end -instance decode u32 begin - let decode addr = U32 (Dolphin.read_value_32 addr) -end - type s32 = S32 of int @@ -78,13 +42,20 @@ instance show s32 begin let show (S32 x) = (show x) ^ "_s32" end -instance decode s32 begin - let decode addr = - let u32 = Dolphin.read_value_32 addr - let signfix = - if u32 > 0xFFFFFFFF then - negate (0x100000000 - u32) - else - u32 - S32 signfix -end +let u8_to_s8 (U8 u8) = + if u8 > 0x7F then + S8 (0x100 - u8) + else + S8 u8 + +let u16_to_s16 (U16 u16) = + if u16 > 0x7FFF then + S16 (0x10000 - u16) + else + S16 u16 + +let u32_to_s32 (U32 u32) = + if u32 > 0x7FFFFFFF then + S32 (0x100000000 - u32) + else + S32 u32 diff --git a/oot/equipment.ml b/oot/equipment.ml index 4ecf9dd..af6ab02 100644 --- a/oot/equipment.ml +++ b/oot/equipment.ml @@ -9,6 +9,7 @@ type sword = | KokiriSword | MasterSword | BiggoronsSword +| UnknownSword of int instance show sword begin let show = function @@ -16,19 +17,22 @@ instance show sword begin | KokiriSword -> "Kokiri Sword" | MasterSword -> "Master Sword" | BiggoronsSword -> "Biggoron's Sword" + | UnknownSword x -> "Unknown Sword " ^ (show x) end let sword_from_index = function | 0 -> NoSword | 1 -> KokiriSword | 2 -> MasterSword -| 3 -> BiggoronsSword +| 3 -> BiggoronsSword +| x -> UnknownSword x type shield = | NoShield | DekuShield | HylianShield | MirrorShield +| UnknownShield of int instance show shield begin let show = function @@ -36,6 +40,7 @@ instance show shield begin | DekuShield -> "Deku Shield" | HylianShield -> "Hylian Shield" | MirrorShield -> "Mirror Shield" + | UnknownShield x -> "Unknown Shield " ^ (show x) end let shield_from_index = function @@ -43,6 +48,7 @@ let shield_from_index = function | 1 -> DekuShield | 2 -> HylianShield | 3 -> MirrorShield +| x -> UnknownShield x type tunic = | KokiriTunic @@ -98,17 +104,18 @@ external private val ( .&. ) : int -> int -> int instance decode equipment begin let decode addr = - let code = Dolphin.read_value_16 addr + let! (U16 code) = decode addr let sword_index = (code .>>. 0) .&. 0xF let shield_index = (code .>>. 4) .&. 0xF let tunic_index = (code .>>. 8) .&. 0xF let boots_index = (code .>>. 12) .&. 0xF - Equipment { + let equipment = Equipment { sword = sword_from_index sword_index, shield = shield_from_index shield_index, tunic = tunic_from_index tunic_index, boots = boots_from_index boots_index } + pure equipment end instance prettyrecord equipment begin diff --git a/oot/inventory.ml b/oot/inventory.ml index 4ebad64..07b94e2 100644 --- a/oot/inventory.ml +++ b/oot/inventory.ml @@ -1,33 +1,52 @@ open import "prelude.ml" -open import "data/array.ml" open import "../pretty.ml" open import "../mem/decode.ml" open import "../mem/int.ml" type inventory = Inventory of { - items: array u8, - ammo: array s8, + items: list u8, + ammo: list s8, equipment: u16, upgrades: u32, quest_items: u32, - dungeon_items: array u8, - dungeon_keys: array s8, + dungeon_items: list u8, + dungeon_keys: list s8, defense_hearts: s8, gs_tokens: s16 } +let rec private init_tailrec i f acc = + if i <= 0 then + acc + else + init_tailrec (i - 1) f ((f i) :: acc) + +let init i f = + init_tailrec i f [] + instance decode inventory begin - let decode addr = Inventory { - items = init 24 (fun i -> decode (addr + 0x00 + i)), - ammo = init 16 (fun i -> decode (addr + 0x18 + i)), - equipment = decode (addr + 0x28), - upgrades = decode (addr + 0x2C), - quest_items = decode (addr + 0x30), - dungeon_items = init 20 (fun i -> decode (addr + 0x34 + i)), - dungeon_keys = init 19 (fun i -> decode (addr + 0x48 + i)), - defense_hearts = decode (addr + 0x5B), - gs_tokens = decode (addr + 0x5C) - } + let decode addr = + let! items = traverse decode (init 24 (fun i -> addr + 0x00 + i)) + let! ammo = traverse decode (init 16 (fun i -> addr + 0x18 + i)) + let! equipment = decode (addr + 0x28) + let! upgrades = decode (addr + 0x2C) + let! quest_items = decode (addr + 0x30) + let! dungeon_items = traverse decode (init 20 (fun i -> addr + 0x34 + i)) + let! dungeon_keys = traverse decode (init 19 (fun i -> addr + 0x48 + i)) + let! defense_hearts = decode (addr + 0x5B) + let! gs_tokens = decode (addr + 0x5C) + let inventory = Inventory { + items = items, + ammo = ammo, + equipment = equipment, + upgrades = upgrades, + quest_items = quest_items, + dungeon_items = dungeon_items, + dungeon_keys = dungeon_keys, + defense_hearts = defense_hearts, + gs_tokens = gs_tokens + } + pure inventory end instance prettyrecord inventory begin diff --git a/oot/item.ml b/oot/item.ml index 1ed2170..6b786aa 100644 --- a/oot/item.ml +++ b/oot/item.ml @@ -158,8 +158,8 @@ type item = instance decode item begin let decode addr = - let code = Dolphin.read_value_8 addr - match code with + let! (U8 code) = decode addr + let item = match code with | 0x00 -> DekuStick | 0x01 -> DekuNut | 0x02 -> Bomb @@ -222,8 +222,50 @@ instance decode item begin | 0x3B -> KokiriSword | 0x3C -> MasterSword | 0x3D -> GoronsSword + | 0x3E -> DekuShield + | 0x3F -> HylianShield + | 0x40 -> MirrorShield + | 0x41 -> KokiriTunic + | 0x42 -> GoronTunic + | 0x43 -> ZoraTunic + | 0x44 -> KokiriBoots + | 0x45 -> IronBoots + | 0x46 -> HoverBoots + | 0x47 -> BulletBag_30 + | 0x48 -> BulletBag_40 + | 0x49 -> BulletBag_50 + | 0x4A -> Quiver_30 + | 0x4B -> BigQuiver_40 + | 0x4C -> BiggestQuiver_50 + | 0x4D -> BombBag_20 + | 0x4E -> BigBombBag_30 + | 0x4F -> BiggestBombBag_40 + | 0x50 -> GoronsBracelet + | 0x51 -> SilverGauntlets + | 0x52 -> GoldenGauntlets + | 0x53 -> SilverScale + | 0x54 -> GoldenScale + | 0x55 -> BrokenGiantsKnife + | 0x56 -> AdultsWallet + | 0x57 -> GiantsWallet + | 0x58 -> DekuSeeds_5 + | 0x59 -> FishingPole + | 0x5A -> MinuetOfForest + | 0x5B -> BoleroOfFire + | 0x5C -> SerenadeOfWater + | 0x5D -> RequiemOfSpirit + | 0x5E -> NocturneOfShadow + | 0x5F -> PreludeOfLight + | 0x60 -> ZeldasLullaby + | 0x61 -> EponasSong + | 0x62 -> SariasSong + | 0x63 -> SunsSong + | 0x64 -> SongOfTime + | 0x65 -> SongOfStorms + | 0x66 -> ForestMedallion | 0xFF -> NoItem | x -> UnknownItem x + pure item end let dummy_show : int -> string = show diff --git a/oot/item_equips.ml b/oot/item_equips.ml index 23fe408..f7ca9b4 100644 --- a/oot/item_equips.ml +++ b/oot/item_equips.ml @@ -17,16 +17,26 @@ type item_equips = ItemEquips of { } instance decode item_equips begin - let decode addr = ItemEquips { - button_item_b = decode (addr + 0x00), - button_item_c_left = decode (addr + 0x01), - button_item_c_down = decode (addr + 0x02), - button_item_c_right = decode (addr + 0x03), - button_slot_c_left = decode (addr + 0x04), - button_slot_c_down = decode (addr + 0x05), - button_slot_c_right = decode (addr + 0x06), - equipment = decode (addr + 0x08) - } + let decode addr = + let! button_item_b = decode (addr + 0x00) + let! button_item_c_left = decode (addr + 0x01) + let! button_item_c_down = decode (addr + 0x02) + let! button_item_c_right = decode (addr + 0x03) + let! button_slot_c_left = decode (addr + 0x04) + let! button_slot_c_down = decode (addr + 0x05) + let! button_slot_c_right = decode (addr + 0x06) + let! equipment = decode (addr + 0x08) + let item_equips = ItemEquips { + button_item_b = button_item_b, + button_item_c_left = button_item_c_left, + button_item_c_down = button_item_c_down, + button_item_c_right = button_item_c_right, + button_slot_c_left = button_slot_c_left, + button_slot_c_down = button_slot_c_down, + button_slot_c_right = button_slot_c_right, + equipment = equipment + } + pure item_equips end instance prettyrecord item_equips begin diff --git a/oot/save_context.ml b/oot/save_context.ml index 88cb764..f8d292d 100644 --- a/oot/save_context.ml +++ b/oot/save_context.ml @@ -40,38 +40,71 @@ type save_context = SaveContext of { } instance decode save_context begin - let decode addr = SaveContext { - entrance_index = decode (addr + 0x0000), - link_age = decode (addr + 0x0004), - cutscene_index = decode (addr + 0x0008), - day_time = decode (addr + 0x000C), - night_flag = decode (addr + 0x0010), - num_days = decode (addr + 0x0014), - claim_days = decode (addr + 0x0018), + let decode addr = + let! entrance_index = decode (addr + 0x0000) + let! link_age = decode (addr + 0x0004) + let! cutscene_index = decode (addr + 0x0008) + let! day_time = decode (addr + 0x000C) + let! night_flag = decode (addr + 0x0010) + let! num_days = decode (addr + 0x0014) + let! claim_days = decode (addr + 0x0018) (* newf, *) - deaths = decode (addr + 0x0022), + let! deaths = decode (addr + 0x0022) (* player_name, *) - n64dd_flag = decode (addr + 0x002C), - health_capacity = decode (addr + 0x002E), - health = decode (addr + 0x0030), - magic_level = decode (addr + 0x0032), - magic = decode (addr + 0x0033), - rupees = decode (addr + 0x0034), - sword_health = decode (addr + 0x0036), - navi_timer = decode (addr + 0x0038), - magic_acquired = decode (addr + 0x003A), + let! n64dd_flag = decode (addr + 0x002C) + let! health_capacity = decode (addr + 0x002E) + let! health = decode (addr + 0x0030) + let! magic_level = decode (addr + 0x0032) + let! magic = decode (addr + 0x0033) + let! rupees = decode (addr + 0x0034) + let! sword_health = decode (addr + 0x0036) + let! navi_timer = decode (addr + 0x0038) + let! magic_acquired = decode (addr + 0x003A) (* unk_3B *) - double_magic = decode (addr + 0x003C), - double_defense = decode (addr + 0x003D), - bgs_flag = decode (addr + 0x003E), - ocarina_game_reward = decode (addr + 0x003F), - child_equips = decode (addr + 0x0040), - adult_equips = decode (addr + 0x004A), + let! double_magic = decode (addr + 0x003C) + let! double_defense = decode (addr + 0x003D) + let! bgs_flag = decode (addr + 0x003E) + let! ocarina_game_reward = decode (addr + 0x003F) + let! child_equips = decode (addr + 0x0040) + let! adult_equips = decode (addr + 0x004A) (* unk_54, *) - saved_scene_num = decode (addr + 0x0066), - equips = decode (addr + 0x0068), - inventory = decode (addr + 0x0074) - } + let! saved_scene_num = decode (addr + 0x0066) + let! equips = decode (addr + 0x0068) + let! inventory = decode (addr + 0x0074) + let save_context = SaveContext { + entrance_index = entrance_index, + link_age = link_age, + cutscene_index = cutscene_index, + day_time = day_time, + night_flag = night_flag, + num_days = num_days, + claim_days = claim_days, + (* newf = *) + deaths = deaths, + (* playerName = *) + n64dd_flag = n64dd_flag, + health_capacity = health_capacity, + health = health, + magic_level = magic_level, + magic = magic, + rupees = rupees, + sword_health = sword_health, + navi_timer = navi_timer, + magic_acquired = magic_acquired, + (* unk_3B = *) + double_magic = double_magic, + double_defense = double_defense, + bgs_flag = bgs_flag, + ocarina_game_reward = ocarina_game_reward, + child_equips = child_equips, + adult_equips = adult_equips, + (* unk_54 = *) + (* unk_58 = *) + saved_scene_num = saved_scene_num, + equips = equips, + inventory: inventory + } + pure save_context end instance prettyrecord save_context begin diff --git a/reader.ml b/reader.ml new file mode 100644 index 0000000..e17e8bd --- /dev/null +++ b/reader.ml @@ -0,0 +1,19 @@ +open import "prelude.ml" + +type reader 'r 'a = Reader of ('r -> 'a) + +let r_run (Reader f) r = f r + +instance functor (reader 'r) begin + let f <$> (Reader g) = Reader (f # g) +end + +instance applicative (reader 'r) begin + let pure x = Reader (const x) + let (Reader rab) <*> (Reader ra) = Reader (fun r -> rab r (ra r)) +end + +instance monad (reader 'r) begin + let (Reader ra) >>= arb = Reader (fun r -> r_run (arb (ra r)) r) + let join (Reader f) = Reader (fun r -> r_run (f r) r) +end