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.
This commit is contained in:
parent
723fe69684
commit
73c1a485fb
10 changed files with 255 additions and 107 deletions
11
dolphin.ml
11
dolphin.ml
|
@ -1,4 +1,6 @@
|
||||||
open import "prelude.ml"
|
open import "prelude.ml"
|
||||||
|
open import "./mem/decode.ml"
|
||||||
|
open import "./mem/int.ml"
|
||||||
|
|
||||||
module Dolphin = struct
|
module Dolphin = struct
|
||||||
external val read_value_8 : int -> int = "ReadValue8"
|
external val read_value_8 : int -> int = "ReadValue8"
|
||||||
|
@ -9,4 +11,13 @@ module Dolphin = struct
|
||||||
|
|
||||||
external val msg_box : string -> int -> () = "MsgBox"
|
external val msg_box : string -> int -> () = "MsgBox"
|
||||||
external val set_screen_text : string -> () = "SetScreenText"
|
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
|
end
|
||||||
|
|
3
main.ml
3
main.ml
|
@ -1,5 +1,6 @@
|
||||||
open import "prelude.ml"
|
open import "prelude.ml"
|
||||||
|
|
||||||
|
open import "./reader.ml"
|
||||||
open import "./pretty.ml"
|
open import "./pretty.ml"
|
||||||
open import "./dolphin.ml"
|
open import "./dolphin.ml"
|
||||||
|
|
||||||
|
@ -16,7 +17,7 @@ let onScriptStart () = ()
|
||||||
let onScriptCancel () = ()
|
let onScriptCancel () = ()
|
||||||
|
|
||||||
let onScriptUpdate () =
|
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
|
let text : string = pretty save_ctx 0
|
||||||
Dolphin.set_screen_text text
|
Dolphin.set_screen_text text
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,40 @@
|
||||||
open import "prelude.ml"
|
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
|
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
|
end
|
||||||
|
|
63
mem/int.ml
63
mem/int.ml
|
@ -1,6 +1,4 @@
|
||||||
open import "prelude.ml"
|
open import "prelude.ml"
|
||||||
open import "./decode.ml"
|
|
||||||
open import "../dolphin.ml"
|
|
||||||
|
|
||||||
type u8 =
|
type u8 =
|
||||||
U8 of int
|
U8 of int
|
||||||
|
@ -9,10 +7,6 @@ instance show u8 begin
|
||||||
let show (U8 x) = (show x) ^ "_u8"
|
let show (U8 x) = (show x) ^ "_u8"
|
||||||
end
|
end
|
||||||
|
|
||||||
instance decode u8 begin
|
|
||||||
let decode addr = U8 (Dolphin.read_value_8 addr)
|
|
||||||
end
|
|
||||||
|
|
||||||
type s8 =
|
type s8 =
|
||||||
S8 of int
|
S8 of int
|
||||||
|
|
||||||
|
@ -20,17 +14,6 @@ instance show s8 begin
|
||||||
let show (S8 x) = (show x) ^ "_s8"
|
let show (S8 x) = (show x) ^ "_s8"
|
||||||
end
|
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 =
|
type u16 =
|
||||||
U16 of int
|
U16 of int
|
||||||
|
|
||||||
|
@ -38,10 +21,6 @@ instance show u16 begin
|
||||||
let show (U16 x) = (show x) ^ "_u16"
|
let show (U16 x) = (show x) ^ "_u16"
|
||||||
end
|
end
|
||||||
|
|
||||||
instance decode u16 begin
|
|
||||||
let decode addr = U16 (Dolphin.read_value_16 addr)
|
|
||||||
end
|
|
||||||
|
|
||||||
type s16 =
|
type s16 =
|
||||||
S16 of int
|
S16 of int
|
||||||
|
|
||||||
|
@ -49,17 +28,6 @@ instance show s16 begin
|
||||||
let show (S16 x) = (show x) ^ "_s16"
|
let show (S16 x) = (show x) ^ "_s16"
|
||||||
end
|
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 =
|
type u32 =
|
||||||
U32 of int
|
U32 of int
|
||||||
|
|
||||||
|
@ -67,10 +35,6 @@ instance show u32 begin
|
||||||
let show (U32 x) = (show x) ^ "_u32"
|
let show (U32 x) = (show x) ^ "_u32"
|
||||||
end
|
end
|
||||||
|
|
||||||
instance decode u32 begin
|
|
||||||
let decode addr = U32 (Dolphin.read_value_32 addr)
|
|
||||||
end
|
|
||||||
|
|
||||||
type s32 =
|
type s32 =
|
||||||
S32 of int
|
S32 of int
|
||||||
|
|
||||||
|
@ -78,13 +42,20 @@ instance show s32 begin
|
||||||
let show (S32 x) = (show x) ^ "_s32"
|
let show (S32 x) = (show x) ^ "_s32"
|
||||||
end
|
end
|
||||||
|
|
||||||
instance decode s32 begin
|
let u8_to_s8 (U8 u8) =
|
||||||
let decode addr =
|
if u8 > 0x7F then
|
||||||
let u32 = Dolphin.read_value_32 addr
|
S8 (0x100 - u8)
|
||||||
let signfix =
|
else
|
||||||
if u32 > 0xFFFFFFFF then
|
S8 u8
|
||||||
negate (0x100000000 - u32)
|
|
||||||
else
|
let u16_to_s16 (U16 u16) =
|
||||||
u32
|
if u16 > 0x7FFF then
|
||||||
S32 signfix
|
S16 (0x10000 - u16)
|
||||||
end
|
else
|
||||||
|
S16 u16
|
||||||
|
|
||||||
|
let u32_to_s32 (U32 u32) =
|
||||||
|
if u32 > 0x7FFFFFFF then
|
||||||
|
S32 (0x100000000 - u32)
|
||||||
|
else
|
||||||
|
S32 u32
|
||||||
|
|
|
@ -9,6 +9,7 @@ type sword =
|
||||||
| KokiriSword
|
| KokiriSword
|
||||||
| MasterSword
|
| MasterSword
|
||||||
| BiggoronsSword
|
| BiggoronsSword
|
||||||
|
| UnknownSword of int
|
||||||
|
|
||||||
instance show sword begin
|
instance show sword begin
|
||||||
let show = function
|
let show = function
|
||||||
|
@ -16,19 +17,22 @@ instance show sword begin
|
||||||
| KokiriSword -> "Kokiri Sword"
|
| KokiriSword -> "Kokiri Sword"
|
||||||
| MasterSword -> "Master Sword"
|
| MasterSword -> "Master Sword"
|
||||||
| BiggoronsSword -> "Biggoron's Sword"
|
| BiggoronsSword -> "Biggoron's Sword"
|
||||||
|
| UnknownSword x -> "Unknown Sword " ^ (show x)
|
||||||
end
|
end
|
||||||
|
|
||||||
let sword_from_index = function
|
let sword_from_index = function
|
||||||
| 0 -> NoSword
|
| 0 -> NoSword
|
||||||
| 1 -> KokiriSword
|
| 1 -> KokiriSword
|
||||||
| 2 -> MasterSword
|
| 2 -> MasterSword
|
||||||
| 3 -> BiggoronsSword
|
| 3 -> BiggoronsSword
|
||||||
|
| x -> UnknownSword x
|
||||||
|
|
||||||
type shield =
|
type shield =
|
||||||
| NoShield
|
| NoShield
|
||||||
| DekuShield
|
| DekuShield
|
||||||
| HylianShield
|
| HylianShield
|
||||||
| MirrorShield
|
| MirrorShield
|
||||||
|
| UnknownShield of int
|
||||||
|
|
||||||
instance show shield begin
|
instance show shield begin
|
||||||
let show = function
|
let show = function
|
||||||
|
@ -36,6 +40,7 @@ instance show shield begin
|
||||||
| DekuShield -> "Deku Shield"
|
| DekuShield -> "Deku Shield"
|
||||||
| HylianShield -> "Hylian Shield"
|
| HylianShield -> "Hylian Shield"
|
||||||
| MirrorShield -> "Mirror Shield"
|
| MirrorShield -> "Mirror Shield"
|
||||||
|
| UnknownShield x -> "Unknown Shield " ^ (show x)
|
||||||
end
|
end
|
||||||
|
|
||||||
let shield_from_index = function
|
let shield_from_index = function
|
||||||
|
@ -43,6 +48,7 @@ let shield_from_index = function
|
||||||
| 1 -> DekuShield
|
| 1 -> DekuShield
|
||||||
| 2 -> HylianShield
|
| 2 -> HylianShield
|
||||||
| 3 -> MirrorShield
|
| 3 -> MirrorShield
|
||||||
|
| x -> UnknownShield x
|
||||||
|
|
||||||
type tunic =
|
type tunic =
|
||||||
| KokiriTunic
|
| KokiriTunic
|
||||||
|
@ -98,17 +104,18 @@ external private val ( .&. ) : int -> int -> int
|
||||||
|
|
||||||
instance decode equipment begin
|
instance decode equipment begin
|
||||||
let decode addr =
|
let decode addr =
|
||||||
let code = Dolphin.read_value_16 addr
|
let! (U16 code) = decode addr
|
||||||
let sword_index = (code .>>. 0) .&. 0xF
|
let sword_index = (code .>>. 0) .&. 0xF
|
||||||
let shield_index = (code .>>. 4) .&. 0xF
|
let shield_index = (code .>>. 4) .&. 0xF
|
||||||
let tunic_index = (code .>>. 8) .&. 0xF
|
let tunic_index = (code .>>. 8) .&. 0xF
|
||||||
let boots_index = (code .>>. 12) .&. 0xF
|
let boots_index = (code .>>. 12) .&. 0xF
|
||||||
Equipment {
|
let equipment = Equipment {
|
||||||
sword = sword_from_index sword_index,
|
sword = sword_from_index sword_index,
|
||||||
shield = shield_from_index shield_index,
|
shield = shield_from_index shield_index,
|
||||||
tunic = tunic_from_index tunic_index,
|
tunic = tunic_from_index tunic_index,
|
||||||
boots = boots_from_index boots_index
|
boots = boots_from_index boots_index
|
||||||
}
|
}
|
||||||
|
pure equipment
|
||||||
end
|
end
|
||||||
|
|
||||||
instance prettyrecord equipment begin
|
instance prettyrecord equipment begin
|
||||||
|
|
|
@ -1,33 +1,52 @@
|
||||||
open import "prelude.ml"
|
open import "prelude.ml"
|
||||||
open import "data/array.ml"
|
|
||||||
open import "../pretty.ml"
|
open import "../pretty.ml"
|
||||||
open import "../mem/decode.ml"
|
open import "../mem/decode.ml"
|
||||||
open import "../mem/int.ml"
|
open import "../mem/int.ml"
|
||||||
|
|
||||||
type inventory = Inventory of {
|
type inventory = Inventory of {
|
||||||
items: array u8,
|
items: list u8,
|
||||||
ammo: array s8,
|
ammo: list s8,
|
||||||
equipment: u16,
|
equipment: u16,
|
||||||
upgrades: u32,
|
upgrades: u32,
|
||||||
quest_items: u32,
|
quest_items: u32,
|
||||||
dungeon_items: array u8,
|
dungeon_items: list u8,
|
||||||
dungeon_keys: array s8,
|
dungeon_keys: list s8,
|
||||||
defense_hearts: s8,
|
defense_hearts: s8,
|
||||||
gs_tokens: s16
|
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
|
instance decode inventory begin
|
||||||
let decode addr = Inventory {
|
let decode addr =
|
||||||
items = init 24 (fun i -> decode (addr + 0x00 + i)),
|
let! items = traverse decode (init 24 (fun i -> addr + 0x00 + i))
|
||||||
ammo = init 16 (fun i -> decode (addr + 0x18 + i)),
|
let! ammo = traverse decode (init 16 (fun i -> addr + 0x18 + i))
|
||||||
equipment = decode (addr + 0x28),
|
let! equipment = decode (addr + 0x28)
|
||||||
upgrades = decode (addr + 0x2C),
|
let! upgrades = decode (addr + 0x2C)
|
||||||
quest_items = decode (addr + 0x30),
|
let! quest_items = decode (addr + 0x30)
|
||||||
dungeon_items = init 20 (fun i -> decode (addr + 0x34 + i)),
|
let! dungeon_items = traverse decode (init 20 (fun i -> addr + 0x34 + i))
|
||||||
dungeon_keys = init 19 (fun i -> decode (addr + 0x48 + i)),
|
let! dungeon_keys = traverse decode (init 19 (fun i -> addr + 0x48 + i))
|
||||||
defense_hearts = decode (addr + 0x5B),
|
let! defense_hearts = decode (addr + 0x5B)
|
||||||
gs_tokens = decode (addr + 0x5C)
|
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
|
end
|
||||||
|
|
||||||
instance prettyrecord inventory begin
|
instance prettyrecord inventory begin
|
||||||
|
|
46
oot/item.ml
46
oot/item.ml
|
@ -158,8 +158,8 @@ type item =
|
||||||
|
|
||||||
instance decode item begin
|
instance decode item begin
|
||||||
let decode addr =
|
let decode addr =
|
||||||
let code = Dolphin.read_value_8 addr
|
let! (U8 code) = decode addr
|
||||||
match code with
|
let item = match code with
|
||||||
| 0x00 -> DekuStick
|
| 0x00 -> DekuStick
|
||||||
| 0x01 -> DekuNut
|
| 0x01 -> DekuNut
|
||||||
| 0x02 -> Bomb
|
| 0x02 -> Bomb
|
||||||
|
@ -222,8 +222,50 @@ instance decode item begin
|
||||||
| 0x3B -> KokiriSword
|
| 0x3B -> KokiriSword
|
||||||
| 0x3C -> MasterSword
|
| 0x3C -> MasterSword
|
||||||
| 0x3D -> GoronsSword
|
| 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
|
| 0xFF -> NoItem
|
||||||
| x -> UnknownItem x
|
| x -> UnknownItem x
|
||||||
|
pure item
|
||||||
end
|
end
|
||||||
|
|
||||||
let dummy_show : int -> string = show
|
let dummy_show : int -> string = show
|
||||||
|
|
|
@ -17,16 +17,26 @@ type item_equips = ItemEquips of {
|
||||||
}
|
}
|
||||||
|
|
||||||
instance decode item_equips begin
|
instance decode item_equips begin
|
||||||
let decode addr = ItemEquips {
|
let decode addr =
|
||||||
button_item_b = decode (addr + 0x00),
|
let! button_item_b = decode (addr + 0x00)
|
||||||
button_item_c_left = decode (addr + 0x01),
|
let! button_item_c_left = decode (addr + 0x01)
|
||||||
button_item_c_down = decode (addr + 0x02),
|
let! button_item_c_down = decode (addr + 0x02)
|
||||||
button_item_c_right = decode (addr + 0x03),
|
let! button_item_c_right = decode (addr + 0x03)
|
||||||
button_slot_c_left = decode (addr + 0x04),
|
let! button_slot_c_left = decode (addr + 0x04)
|
||||||
button_slot_c_down = decode (addr + 0x05),
|
let! button_slot_c_down = decode (addr + 0x05)
|
||||||
button_slot_c_right = decode (addr + 0x06),
|
let! button_slot_c_right = decode (addr + 0x06)
|
||||||
equipment = decode (addr + 0x08)
|
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
|
end
|
||||||
|
|
||||||
instance prettyrecord item_equips begin
|
instance prettyrecord item_equips begin
|
||||||
|
|
|
@ -40,38 +40,71 @@ type save_context = SaveContext of {
|
||||||
}
|
}
|
||||||
|
|
||||||
instance decode save_context begin
|
instance decode save_context begin
|
||||||
let decode addr = SaveContext {
|
let decode addr =
|
||||||
entrance_index = decode (addr + 0x0000),
|
let! entrance_index = decode (addr + 0x0000)
|
||||||
link_age = decode (addr + 0x0004),
|
let! link_age = decode (addr + 0x0004)
|
||||||
cutscene_index = decode (addr + 0x0008),
|
let! cutscene_index = decode (addr + 0x0008)
|
||||||
day_time = decode (addr + 0x000C),
|
let! day_time = decode (addr + 0x000C)
|
||||||
night_flag = decode (addr + 0x0010),
|
let! night_flag = decode (addr + 0x0010)
|
||||||
num_days = decode (addr + 0x0014),
|
let! num_days = decode (addr + 0x0014)
|
||||||
claim_days = decode (addr + 0x0018),
|
let! claim_days = decode (addr + 0x0018)
|
||||||
(* newf, *)
|
(* newf, *)
|
||||||
deaths = decode (addr + 0x0022),
|
let! deaths = decode (addr + 0x0022)
|
||||||
(* player_name, *)
|
(* player_name, *)
|
||||||
n64dd_flag = decode (addr + 0x002C),
|
let! n64dd_flag = decode (addr + 0x002C)
|
||||||
health_capacity = decode (addr + 0x002E),
|
let! health_capacity = decode (addr + 0x002E)
|
||||||
health = decode (addr + 0x0030),
|
let! health = decode (addr + 0x0030)
|
||||||
magic_level = decode (addr + 0x0032),
|
let! magic_level = decode (addr + 0x0032)
|
||||||
magic = decode (addr + 0x0033),
|
let! magic = decode (addr + 0x0033)
|
||||||
rupees = decode (addr + 0x0034),
|
let! rupees = decode (addr + 0x0034)
|
||||||
sword_health = decode (addr + 0x0036),
|
let! sword_health = decode (addr + 0x0036)
|
||||||
navi_timer = decode (addr + 0x0038),
|
let! navi_timer = decode (addr + 0x0038)
|
||||||
magic_acquired = decode (addr + 0x003A),
|
let! magic_acquired = decode (addr + 0x003A)
|
||||||
(* unk_3B *)
|
(* unk_3B *)
|
||||||
double_magic = decode (addr + 0x003C),
|
let! double_magic = decode (addr + 0x003C)
|
||||||
double_defense = decode (addr + 0x003D),
|
let! double_defense = decode (addr + 0x003D)
|
||||||
bgs_flag = decode (addr + 0x003E),
|
let! bgs_flag = decode (addr + 0x003E)
|
||||||
ocarina_game_reward = decode (addr + 0x003F),
|
let! ocarina_game_reward = decode (addr + 0x003F)
|
||||||
child_equips = decode (addr + 0x0040),
|
let! child_equips = decode (addr + 0x0040)
|
||||||
adult_equips = decode (addr + 0x004A),
|
let! adult_equips = decode (addr + 0x004A)
|
||||||
(* unk_54, *)
|
(* unk_54, *)
|
||||||
saved_scene_num = decode (addr + 0x0066),
|
let! saved_scene_num = decode (addr + 0x0066)
|
||||||
equips = decode (addr + 0x0068),
|
let! equips = decode (addr + 0x0068)
|
||||||
inventory = decode (addr + 0x0074)
|
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
|
end
|
||||||
|
|
||||||
instance prettyrecord save_context begin
|
instance prettyrecord save_context begin
|
||||||
|
|
19
reader.ml
Normal file
19
reader.ml
Normal 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
|
Loading…
Reference in a new issue