s/ootAI
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Switch decoding over to a Monad for portability

Browse source 
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.
This commit is contained in:
Aly 2021-04-02 15:13:54 -07:00
parent 723fe69684
commit 73c1a485fb
10 changed files with 255 additions and 107 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
dolphin.ml
View file

@ -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

3
main.ml
View file

@ -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

37
mem/decode.ml
View file

@ -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

61
mem/int.ml
View file

@ -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)
let u8_to_s8 (U8 u8) =
if u8 > 0x7F then
S8 (0x100 - u8)
else
u32
S32 signfix
end
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

11
oot/equipment.ml
View file

@ -9,6 +9,7 @@ type sword =
| KokiriSword
| MasterSword
| BiggoronsSword
| UnknownSword of int
instance show sword begin
let show = function
@ -16,6 +17,7 @@ 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
@ -23,12 +25,14 @@ let sword_from_index = function
| 1 -> KokiriSword
| 2 -> MasterSword
| 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

49
oot/inventory.ml
View file

@ -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

46
oot/item.ml
View file

@ -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

28
oot/item_equips.ml
View file

@ -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

87
oot/save_context.ml
View file

@ -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

19
reader.ml Normal file
View file

@ -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