Test out nesting the pretty printer
This commit is contained in:
parent
2ea479e193
commit
2cb81461d8
4 changed files with 203 additions and 3 deletions
118
oot/equipment.ml
Normal file
118
oot/equipment.ml
Normal file
|
@ -0,0 +1,118 @@
|
|||
open import "prelude.ml"
|
||||
open import "lua/bit.ml"
|
||||
open Ops
|
||||
open import "../dolphin.ml"
|
||||
open import "../pretty.ml"
|
||||
open import "../mem/decode.ml"
|
||||
open import "../mem/int.ml"
|
||||
|
||||
type sword =
|
||||
| NoSword
|
||||
| KokiriSword
|
||||
| MasterSword
|
||||
| BiggoronsSword
|
||||
|
||||
instance show sword begin
|
||||
let show = function
|
||||
| NoSword -> "No Sword"
|
||||
| KokiriSword -> "Kokiri Sword"
|
||||
| MasterSword -> "Master Sword"
|
||||
| BiggoronsSword -> "Biggoron's Sword"
|
||||
end
|
||||
|
||||
let sword_from_index = function
|
||||
| 0 -> NoSword
|
||||
| 1 -> KokiriSword
|
||||
| 2 -> MasterSword
|
||||
| 3 -> BiggoronsSword
|
||||
|
||||
type shield =
|
||||
| NoShield
|
||||
| DekuShield
|
||||
| HylianShield
|
||||
| MirrorShield
|
||||
|
||||
instance show shield begin
|
||||
let show = function
|
||||
| NoShield -> "No Shield"
|
||||
| DekuShield -> "Deku Shield"
|
||||
| HylianShield -> "Hylian Shield"
|
||||
| MirrorShield -> "Mirror Shield"
|
||||
end
|
||||
|
||||
let shield_from_index = function
|
||||
| 0 -> NoShield
|
||||
| 1 -> DekuShield
|
||||
| 2 -> HylianShield
|
||||
| 3 -> MirrorShield
|
||||
|
||||
type tunic =
|
||||
| KokiriTunic
|
||||
| GoronTunic
|
||||
| ZoraTunic
|
||||
|
||||
instance show tunic begin
|
||||
let show = function
|
||||
| KokiriTunic -> "Kokiri Tunic"
|
||||
| GoronTunic -> "Goron Tunic"
|
||||
| ZoraTunic -> "Zora Tunic"
|
||||
end
|
||||
|
||||
let tunic_from_index = function
|
||||
| 1 -> KokiriTunic
|
||||
| 2 -> GoronTunic
|
||||
| 3 -> ZoraTunic
|
||||
|
||||
type boots =
|
||||
| KokiriBoots
|
||||
| IronBoots
|
||||
| HoverBoots
|
||||
|
||||
instance show boots begin
|
||||
let show = function
|
||||
| KokiriBoots -> "Kokiri Boots"
|
||||
| IronBoots -> "Iron Boots"
|
||||
| HoverBoots -> "Hover Boots"
|
||||
end
|
||||
|
||||
let boots_from_index = function
|
||||
| 1 -> KokiriBoots
|
||||
| 2 -> IronBoots
|
||||
| 3 -> HoverBoots
|
||||
|
||||
type equipment = Equipment of {
|
||||
sword: sword,
|
||||
shield: shield,
|
||||
tunic: tunic,
|
||||
boots: boots
|
||||
}
|
||||
|
||||
instance decode equipment begin
|
||||
let decode addr =
|
||||
let code = Dolphin.read_value_16 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 {
|
||||
sword = sword_from_index sword_index,
|
||||
shield = shield_from_index shield_index,
|
||||
tunic = tunic_from_index tunic_index,
|
||||
boots = boots_from_index boots_index
|
||||
}
|
||||
end
|
||||
|
||||
instance prettyrecord equipment begin
|
||||
let name _ = "Equipment"
|
||||
let fields (Equipment x) =
|
||||
[
|
||||
("sword", S x.sword),
|
||||
("shield", S x.shield),
|
||||
("tunic", S x.tunic),
|
||||
("boots", S x.boots)
|
||||
]
|
||||
end
|
||||
|
||||
instance pretty equipment begin
|
||||
let pretty = pretty_from_record
|
||||
end
|
23
oot/item.ml
Normal file
23
oot/item.ml
Normal file
|
@ -0,0 +1,23 @@
|
|||
open import "prelude.ml"
|
||||
open import "../dolphin.ml"
|
||||
open import "../pretty.ml"
|
||||
open import "../mem/decode.ml"
|
||||
open import "../mem/int.ml"
|
||||
|
||||
type item =
|
||||
| DekuSticks
|
||||
| NoItem
|
||||
|
||||
instance decode item begin
|
||||
let decode addr =
|
||||
let code = Dolphin.read_value_8 addr
|
||||
match code with
|
||||
| 0 -> DekuSticks
|
||||
| 255 -> NoItem
|
||||
end
|
||||
|
||||
instance show item begin
|
||||
let show = function
|
||||
| DekuSticks -> "Deku Sticks"
|
||||
| NoItem -> "No Item"
|
||||
end
|
49
oot/item_equips.ml
Normal file
49
oot/item_equips.ml
Normal file
|
@ -0,0 +1,49 @@
|
|||
open import "prelude.ml"
|
||||
open import "../pretty.ml"
|
||||
open import "../mem/decode.ml"
|
||||
open import "../mem/int.ml"
|
||||
open import "./equipment.ml"
|
||||
open import "./item.ml"
|
||||
|
||||
type item_equips = ItemEquips of {
|
||||
button_item_b: item,
|
||||
button_item_c_left: item,
|
||||
button_item_c_down: item,
|
||||
button_item_c_right: item,
|
||||
button_slot_c_left: u8,
|
||||
button_slot_c_down: u8,
|
||||
button_slot_c_right: u8,
|
||||
equipment: equipment
|
||||
}
|
||||
|
||||
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)
|
||||
}
|
||||
end
|
||||
|
||||
instance prettyrecord item_equips begin
|
||||
let name _ = "ItemEquips"
|
||||
let fields (ItemEquips x) =
|
||||
[
|
||||
("button_item_b", S x.button_item_b),
|
||||
("button_item_c_left", S x.button_item_c_left),
|
||||
("button_item_c_down", S x.button_item_c_down),
|
||||
("button_item_c_right", S x.button_item_c_right),
|
||||
("button_slot_c_left", S x.button_slot_c_left),
|
||||
("button_slot_c_down", S x.button_slot_c_down),
|
||||
("button_slot_c_right", S x.button_slot_c_right),
|
||||
("equipment", P x.equipment)
|
||||
]
|
||||
end
|
||||
|
||||
instance pretty item_equips begin
|
||||
let pretty = pretty_from_record
|
||||
end
|
|
@ -2,14 +2,21 @@ open import "prelude.ml"
|
|||
open import "../pretty.ml"
|
||||
open import "../mem/decode.ml"
|
||||
open import "../mem/int.ml"
|
||||
open import "./item_equips.ml"
|
||||
|
||||
type save_context = SaveContext of {
|
||||
rupees: s16
|
||||
rupees: s16,
|
||||
child_equips: item_equips,
|
||||
adult_equips: item_equips,
|
||||
equips: item_equips
|
||||
}
|
||||
|
||||
instance decode save_context begin
|
||||
let decode addr = SaveContext {
|
||||
rupees = decode (addr + 0x0034)
|
||||
rupees = decode (addr + 0x0034),
|
||||
child_equips = decode (addr + 0x0040),
|
||||
adult_equips = decode (addr + 0x004A),
|
||||
equips = decode (addr + 0x0068)
|
||||
}
|
||||
end
|
||||
|
||||
|
@ -17,7 +24,10 @@ instance prettyrecord save_context begin
|
|||
let name _ = "SaveContext"
|
||||
let fields (SaveContext x) =
|
||||
[
|
||||
("rupees", S x.rupees)
|
||||
("rupees", S x.rupees),
|
||||
("child_equips", P x.child_equips),
|
||||
("adult_equips", P x.adult_equips),
|
||||
("equips", P x.equips)
|
||||
]
|
||||
end
|
||||
|
||||
|
|
Loading…
Reference in a new issue