Rsaves/lib/Rsaves.pm

1038 lines
31 KiB
Perl

package Rsaves;
use v5.34.1;
use strict;
use warnings;
use Data::Dumper;
use Rsaves::Constants::Ruby::Flags qw/$FLAG_SYS_HAS_EON_TICKET $FLAG_LEGENDARY_BATTLE_COMPLETED $FLAG_HIDE_LEGEND_MON_CAVE_OF_ORIGIN/;
use Rsaves::Constants::Ruby::Vars qw/$VAR_CAVE_OF_ORIGIN_B4F_STATE $VARS_START/;
use Exporter;
use parent 'Exporter';
our @EXPORT_OK = (
qw/read_pc_storage save_pc_changes save_changes enable_eon_ticket
add_key_item set_flag_id change_gender read_save get_saves
find_current_save_index check_correct_size find_pokemon_substruct
read_pkm_file_box calculate_shiny_personality pokemon_set_shiny
get_first_super_data set_first_super_data enable_rematch_main_legendary
check_flag_id/
);
my $SAVE_SIZE = 57344;
my $SECTION_DATA_SIZE = 3968;
my $SECTION_AFTER_DATA_PADDING = 4084;
my $SECTION_ID_SIZE = 2;
my $SECTION_CHECKSUM_SIZE = 2;
my $SECTION_SIGNATURE_SIZE = 4;
my $SECTION_SAVE_INDEX_SIZE = 4;
my @ORDER_SECTION_WITHOUT_DATA = (qw/id checksum signature save_index/);
my @ORDER_SECTION_FIELDS = ( 'data', @ORDER_SECTION_WITHOUT_DATA );
my $TRAINER_INFO = 0;
my $TEAM_ITEMS = 1;
my $GAME_STATE = 2;
my $MISC_DATA = 3;
my $RIVAL_INFO = 4;
my $PC_BUFFER_A = 5;
my $PC_BUFFER_B = 6;
my $PC_BUFFER_C = 7;
my $PC_BUFFER_D = 8;
my $PC_BUFFER_E = 9;
my $PC_BUFFER_F = 10;
my $PC_BUFFER_G = 11;
my $PC_BUFFER_H = 12;
my $PC_BUFFER_I = 13;
my ( $FEMALE, $MALE ) = ( 1, 0 );
my $FLAGS_OFFSET = hex '1220';
my $TRAINER_FLAG_START = hex '500';
my $NUMBER_OF_TRAINERS = 693;
my $KEY_ITEMS_OFFSET = hex '5b0';
my $MAX_KEY_ITEMS = 20;
my $ITEM_EON_TICKET = 275;
my $POKEMON_NAME_LENGTH = 10;
my $OT_NAME_LENGTH = 7;
my $BOX_NAME_LENGTH = 9;
my %CHECKSUM_BYTES = (
$TRAINER_INFO => hex 'F80',
$TEAM_ITEMS => 3968,
$GAME_STATE => 3968,
$MISC_DATA => 3968,
$RIVAL_INFO => 3848,
( map { ( $_ => 3968 ) } ( $PC_BUFFER_A .. $PC_BUFFER_H ) ),
$PC_BUFFER_I => 0x83d0 - ( @{ [ $PC_BUFFER_A .. $PC_BUFFER_H ] } * 3968 ),
);
die 'Invalid number of checksum sections.'
if ( scalar keys %CHECKSUM_BYTES ) != 14;
sub _hihalf_u32 {
my $n = shift;
return (($n & 0xFFFF0000) >> 16);
}
sub _lowhalf_u32 {
my $n = shift;
return ($n & 0xFFFF);
}
sub pokemon_set_shiny {
my $pokemon = shift;
$pokemon->{personality} = calculate_shiny_personality($pokemon->{otid}, $pokemon->{personality});
}
sub calculate_shiny_personality {
my $otid = shift;
my $personality = shift;
my $wanted_three_parts_bytes = _lowhalf_u32($personality) ^ int(rand(7));
my $wanted_high_personality = _hihalf_u32($otid) ^ _lowhalf_u32($otid) ^ $wanted_three_parts_bytes;
return ($wanted_high_personality << 16) | _lowhalf_u32($personality);
}
sub get_first_super_data {
my $save = shift;
my @sections = _find_sections_save( $save, 1 .. 4 );
my $superdata = join '', map { $_->{data} } @sections;
return \$superdata;
}
sub set_first_super_data {
my $save = shift;
my $superdata = shift;
my @sections = _find_sections_save( $save, 1 .. 4 );
open my $fh, '<', $superdata;
for my $section (@sections) {
read $fh, $section->{data}, $SECTION_DATA_SIZE;
}
close $fh;
}
sub find_pokemon_substruct {
my $substructures = shift;
my $type = shift;
for my $substruct (@$substructures) {
return $substruct if $substruct->{type} == $type;
}
}
sub read_pc_storage {
my $save = shift;
my @sections = _find_sections_save( $save, $PC_BUFFER_A .. $PC_BUFFER_I );
my $superdata = join '', map { $_->{data} } @sections;
open my $fh, '<', \$superdata;
read $fh, my $read, 1;
my $current_box = unpack 'C', $read;
read $fh, $read, 3;
my $unknown = $read;
my $pc = _read_pokemon_boxes_from_fh($fh);
my @box_names;
for ( 0 .. 13 ) {
read $fh, ( my $read ), $BOX_NAME_LENGTH;
push @box_names, $read;
}
my @wallpapers;
for ( 0 .. 13 ) {
read $fh, ( my $read ), 1;
push @wallpapers, unpack 'C', $read;
}
read $fh, $read, 1 and die "Unread space";
close $fh;
return {
current_box => $current_box,
boxes => $pc,
unknown => $unknown,
boxes_names => \@box_names,
wallpapers => \@wallpapers,
};
}
sub save_pc_changes {
my $save = shift;
my $pc = shift;
my $superdata = '';
open my $fh, '>', \$superdata;
print $fh pack 'C', $pc->{current_box};
print $fh $pc->{unknown};
_write_pokemon_boxes_to_fh( $fh, $pc->{boxes} );
for (0..13) {
print $fh $pc->{boxes_names}[$_];
}
for (0..13) {
print $fh (pack 'C', $pc->{wallpapers}[$_]);
}
my $length = length $superdata;
die "Wrong pc size $length != @{[0x83d0]}" if $length != 0x83d0;
my @sections = _find_sections_save( $save, $PC_BUFFER_A .. $PC_BUFFER_I );
open $fh, '<', \$superdata;
for my $section (@sections) {
read $fh, (my $read), $SECTION_DATA_SIZE;
my $length = length $read;
$section->{data} = $read;
}
read $fh, my $read, 1 and die "Not all readed";
close $fh;
}
sub _write_pokemon_boxes_to_fh {
my $fh = shift;
my $boxes = shift;
for my $box ( $boxes->@* ) {
for my $pokemon ( $box->@* ) {
my $pokemon_raw = '';
open my $fh_pokemon, '>', \$pokemon_raw;
_write_pokemon_fh( $fh_pokemon, $pokemon );
close $fh_pokemon;
my $length = length $pokemon_raw;
die "Bad size pokemon $length" if $length != 0x50;
print $fh $pokemon_raw;
}
}
}
sub _read_pokemon_boxes_from_fh {
my $fh = shift;
my $boxes = [];
my $read;
for my $i ( 0 .. 13 ) {
my $box = [];
for my $j ( 0 .. 29 ) {
read $fh, my $pokemon_data, 0x50 or die "Failed to read 0x50 bytes";
open my $pokemon_fh, '<', \$pokemon_data;
push @$box, _read_pokemon_box_from_fh($pokemon_fh);
close $pokemon_fh;
}
push @$boxes, $box;
}
return $boxes;
}
sub read_pkm_file_box {
my $file = shift;
open my $fh, '<', $file or die "Unable to open $file";
my $file_contents = join '', <$fh>;
$file_contents = substr $file_contents, 0, 0x50;
open $fh, '<', \$file_contents;
return _read_pokemon_box_from_fh($fh, 1);
}
sub _write_pokemon_fh {
my $fh = shift;
my $pokemon = shift;
if ($pokemon->{personality} > 0xFFFFFFFF) {
die "Too big personality";
}
print $fh pack 'V', $pokemon->{personality};
print $fh pack 'V', $pokemon->{otid};
print $fh $pokemon->{nickname};
print $fh pack 'C', $pokemon->{language};
print $fh pack 'C', $pokemon->{flags_eggs};
print $fh $pokemon->{ot_name};
print $fh pack 'C', $pokemon->{markings};
my $substructures_raw = '';
{
open my $fh_substructures, '>', \$substructures_raw;
$pokemon->{checksum} = _write_pokemon_substructures_fh(
$fh_substructures,
$pokemon->{substructures},
$pokemon->{personality},
$pokemon->{otid}
);
close $fh_substructures;
}
my $length = length $substructures_raw;
die "Bad size for the whole substructures $length" if $length != 12 * 4;
print $fh pack 'v', $pokemon->{checksum};
print $fh pack 'v', $pokemon->{unknown};
print $fh $substructures_raw;
}
sub _read_pokemon_box_from_fh {
my $fh = shift;
my $is_pkm_file = shift;
# 0
read $fh, my $read, 4;
my $personality = unpack 'V', $read // die "\$personality undefined";
# 4
read $fh, $read, 4;
my $otid = unpack 'V', $read;
# 8
read $fh, $read, $POKEMON_NAME_LENGTH;
my $nickname = $read;
read $fh, $read, 1;
my $language = unpack 'C', $read;
read $fh, $read, 1;
my $flags_eggs = unpack 'C', $read;
read $fh, $read, $OT_NAME_LENGTH;
my $ot_name = $read;
read $fh, $read, 1;
my $markings = unpack 'C', $read;
read $fh, $read, 2;
my $checksum = unpack 'v', $read;
read $fh, $read, 2;
my $unknown = unpack 'v', $read;
my $substructures =
_read_pokemon_substructures_from_fh( $fh, $otid, $personality,
$checksum, $is_pkm_file );
read $fh, $read, 1 and die "You have not read all";
return {
personality => $personality,
otid => $otid,
nickname => $nickname,
language => $language,
flags_eggs => $flags_eggs,
ot_name => $ot_name,
markings => $markings,
checksum => $checksum,
unknown => $unknown,
substructures => $substructures,
};
}
sub _read_pokemon_substructures_from_fh {
my $fh = shift;
my $otid = shift;
my $personality = shift;
my $checksum = shift;
my $is_pkm_file = shift;
read $fh, my $read, ( 12 * 4 );
my $raw;
my @order_substructures;
if (!$is_pkm_file) {
$raw = _decrypt_pokemon_substructures_raw( $read, $otid, $personality,
$checksum );
@order_substructures =
_pokemon_substructures_order_by_modulo( $personality % 24 );
} else {
$raw = $read;
@order_substructures = (0, 1, 2, 3);
}
my $substructures = [];
open my $fh_raw, '<', \$raw;
for my $i (@order_substructures) {
read $fh_raw, my $substruct, 12;
open my $fh_substruct, '<', \$substruct;
push @$substructures,
_read_pokemon_substruct_n_from_fh( $fh_substruct, $i);
close $fh_substruct;
}
close $fh_raw;
read $fh, $read, 1 and die "You have not read all";
return $substructures;
}
sub _write_pokemon_substructures_fh {
my $fh = shift;
my $substructures = shift;
my $personality = shift;
my $otid = shift;
my $modulo = $personality % 24;
my $decrypted_substructures = '';
open my $fh_decrypted_substructures, '>', \$decrypted_substructures;
my @order_substructures = _pokemon_substructures_order_by_modulo($modulo);
my $substruct0 = find_pokemon_substruct( $substructures, 0 );
for my $i (@order_substructures) {
my $substruct = find_pokemon_substruct( $substructures, $i );
my $substruct_raw = '';
open my $fh_decrypted_substruct, '>', \$substruct_raw;
_write_pokemon_substruct_fh( $fh_decrypted_substruct, $substruct );
close $fh_decrypted_substruct;
my $length = length $substruct_raw;
die "Bad size substruct $i -> $length" if $length != 12;
print $fh_decrypted_substructures $substruct_raw;
}
close $fh_decrypted_substructures;
open $fh_decrypted_substructures, '<', \$decrypted_substructures;
my $checksum = _pokemon_checksum_substructures_fh($fh_decrypted_substructures);
seek $fh_decrypted_substructures, 0, 0;
my $encrypted_substructures;
open my $fh_encrypted_substructures, '>', \$encrypted_substructures;
for ( 0 .. 11 ) {
read $fh_decrypted_substructures, my $read, 4;
$read = pack 'V', ( ( ( unpack 'V', $read ) ^ $personality ) ^ $otid );
print $fh_encrypted_substructures $read;
}
close $fh_decrypted_substructures;
close $fh_encrypted_substructures;
print $fh $encrypted_substructures;
return $checksum;
}
sub _pokemon_checksum_substructures_fh {
my $fh = shift;
my $checksum = 0;
for ( 0 .. 3 ) {
for ( 0 .. 5 ) {
read $fh, my $read, 2 or die "Unable to read";
$checksum = _sum_u16( (unpack 'v', $read), $checksum );
}
}
return $checksum;
}
sub _read_pokemon_substruct_n_from_fh {
my $fh = shift;
my $type = shift;
return _read_pokemon_substruct_0_from_fh($fh) if $type == 0;
return _read_pokemon_substruct_1_from_fh($fh) if $type == 1;
return _read_pokemon_substruct_2_from_fh($fh) if $type == 2;
return _read_pokemon_substruct_3_from_fh($fh) if $type == 3;
}
sub _write_pokemon_substruct_fh {
my $fh = shift;
my $substruct = shift;
my $type = $substruct->{type};
return _write_pokemon_substruct0_fh( $fh, $substruct ) if $type == 0;
return _write_pokemon_substruct1_fh( $fh, $substruct ) if $type == 1;
return _write_pokemon_substruct2_fh( $fh, $substruct ) if $type == 2;
return _write_pokemon_substruct3_fh( $fh, $substruct ) if $type == 3;
}
{
my %translate_encoding_table;
my %translate_real_table;
{
my $counter = hex 'BB';
for my $char ( 'A' .. 'Z', 'a' .. 'z' ) {
$translate_encoding_table{ chr($counter) } = $char;
$translate_real_table{$char} = chr($counter);
$counter++;
}
$translate_real_table{'♂'} = chr(0xB5);
$translate_real_table{'♀'} = chr(0xB6);
$translate_encoding_table{ chr(0xB5) } = '♂';
$translate_encoding_table{ chr(0xB6) } = '♀';
}
sub _to_3rd_encoding {
my $text = shift;
my @chars = split '', $text;
my $return_text = '';
for my $char (@chars) {
$return_text .= $translate_real_table{$char};
}
return $return_text;
}
sub _translate_3rd_encoding {
my $text = shift;
my @chars = split '', $text;
my $return_text = '';
for my $char (@chars) {
last if ord($char) == hex 'FF';
$return_text .= $translate_encoding_table{$char} // '?';
}
return $return_text;
}
}
sub _read_pokemon_substruct_0_from_fh {
my $fh = shift;
my $read;
read $fh, $read, 2;
my $species = unpack 'v', $read;
read $fh, $read, 2;
my $held_item = unpack 'v', $read;
read $fh, $read, 4;
my $experience = unpack 'V', $read;
read $fh, $read, 1;
my $pp_bonuses = unpack 'C', $read;
read $fh, $read, 1;
my $friendship = unpack 'C', $read;
read $fh, $read, 2;
my $unknown = unpack 'v', $read;
return {
type => 0,
species => $species,
held_item => $held_item,
experience => $experience,
pp_bonuses => $pp_bonuses,
friendship => $friendship,
unknown => $unknown,
};
}
sub _write_pokemon_substruct0_fh {
my $fh = shift;
my $substruct = shift;
print $fh pack 'v', $substruct->{species};
print $fh pack 'v', $substruct->{held_item};
print $fh pack 'V', $substruct->{experience};
print $fh pack 'C', $substruct->{pp_bonuses};
print $fh pack 'C', $substruct->{friendship};
print $fh pack 'v', $substruct->{unknown};
}
sub _read_pokemon_substruct_1_from_fh {
my $fh = shift;
my $read;
my @movements;
my @pp;
for ( 0 .. 3 ) {
read $fh, $read, 2;
push @movements, unpack 'v', $read;
}
for ( 0 .. 3 ) {
read $fh, $read, 1;
push @pp, unpack 'C', $read;
}
return {
type => 1,
movements => \@movements,
pp => \@pp,
};
}
sub _write_pokemon_substruct1_fh {
my $fh = shift;
my $substruct = shift;
for my $i ( 0 .. 3 ) {
print $fh pack 'v', $substruct->{movements}[$i];
}
for my $i ( 0 .. 3 ) {
print $fh pack 'C', $substruct->{pp}[$i];
}
}
sub _read_pokemon_substruct_2_from_fh {
my $fh = shift;
my $read;
read $fh, $read, 1;
my $hp_ev = unpack 'C', $read;
read $fh, $read, 1;
my $attack_ev = unpack 'C', $read;
read $fh, $read, 1;
my $defense_ev = unpack 'C', $read;
read $fh, $read, 1;
my $speed_ev = unpack 'C', $read;
read $fh, $read, 1;
my $special_attack_ev = unpack 'C', $read;
read $fh, $read, 1;
my $special_defense_ev = unpack 'C', $read;
read $fh, $read, 1;
my $cool = unpack 'C', $read;
read $fh, $read, 1;
my $beauty = unpack 'C', $read;
read $fh, $read, 1;
my $cute = unpack 'C', $read;
read $fh, $read, 1;
my $smart = unpack 'C', $read;
read $fh, $read, 1;
my $tough = unpack 'C', $read;
read $fh, $read, 1;
my $sheen = unpack 'C', $read;
return {
type => 2,
hp_ev => $hp_ev,
attack_ev => $attack_ev,
defense_ev => $defense_ev,
speed_ev => $speed_ev,
special_attack_ev => $special_attack_ev,
special_defense_ev => $special_defense_ev,
cool => $cool,
beauty => $beauty,
cute => $cute,
smart => $smart,
tough => $tough,
sheen => $sheen,
};
}
sub _write_pokemon_substruct2_fh {
my $fh = shift;
my $substruct = shift;
print $fh pack 'C', $substruct->{hp_ev};
print $fh pack 'C', $substruct->{attack_ev};
print $fh pack 'C', $substruct->{defense_ev};
print $fh pack 'C', $substruct->{speed_ev};
print $fh pack 'C', $substruct->{special_attack_ev};
print $fh pack 'C', $substruct->{special_defense_ev};
print $fh pack 'C', $substruct->{cool};
print $fh pack 'C', $substruct->{beauty};
print $fh pack 'C', $substruct->{cute};
print $fh pack 'C', $substruct->{smart};
print $fh pack 'C', $substruct->{tough};
print $fh pack 'C', $substruct->{sheen};
}
sub _read_pokemon_substruct_3_from_fh {
my $fh = shift;
my $read;
read $fh, $read, 1;
my $pokerus = unpack 'C', $read;
read $fh, $read, 1;
my $met_location = unpack 'C', $read;
read $fh, $read, 2;
my $met_data = unpack 'v', $read;
read $fh, $read, 4;
# We do not mess with this here.
my $ivs_egg_status_and_ability = unpack 'V', $read;
read $fh, $read, 4;
my $ribbons_and_event_legal = unpack 'V', $read;
return {
type => 3,
pokerus => $pokerus,
met_location => $met_location,
met_data => $met_data,
ivs_egg_status_and_ability => $ivs_egg_status_and_ability,
ribbons_and_event_legal => $ribbons_and_event_legal,
};
}
sub _write_pokemon_substruct3_fh {
my $fh = shift;
my $substruct = shift;
print $fh pack 'C', $substruct->{pokerus};
print $fh pack 'C', $substruct->{met_location};
print $fh pack 'v', $substruct->{met_data};
print $fh pack 'V', $substruct->{ivs_egg_status_and_ability};
print $fh pack 'V', $substruct->{ribbons_and_event_legal};
}
sub _generate_permutations_array {
my $array = shift;
my @permutations;
if ( ( scalar @$array ) == 1 ) {
push @permutations, $array;
return \@permutations;
}
for ( my $i = 0 ; $i < @$array ; $i++ ) {
my @list_to_send_recursive;
for ( my $j = 0 ; $j < @$array ; $j++ ) {
next if $j == $i;
push @list_to_send_recursive, $array->[$j];
}
for my $permutation (
@{ _generate_permutations_array( \@list_to_send_recursive ) } )
{
push @permutations, [ $array->[$i], @$permutation ];
}
}
return \@permutations;
}
sub _decrypt_pokemon_substructures_raw {
my $raw = shift;
my $otid = shift;
my $personality = shift;
my $checksum = shift;
my $result = '';
open my $fh, '<', \$raw;
for ( 0 .. 11 ) {
read $fh, my $read, 4 or die "Unable to read";
$read = unpack 'V', $read;
$read ^= $otid;
$read ^= $personality;
$result .= pack 'V', $read;
}
read $fh, my $read, 1 and die "Not all read";
close $fh;
open $fh, '<', \$result;
# my @order_substructures = _pokemon_substructures_order_by_modulo($personality % 24);
# for my $substruct_n (0..3) {
# my $offset = $substruct_n * 12;
# seek $fh, $substruct_n * 12, 0;
# for (0..5) {
# read $fh, my $read, 2 or die "Unable to read";
# $read = unpack 'v', $read;
# $compare_checksum = _sum_u16($read, $compare_checksum);
# }
# }
#
my $compare_checksum = _pokemon_checksum_substructures_fh($fh);
die "Checksum $compare_checksum not equal to $checksum"
if $compare_checksum != $checksum;
close $fh;
return $result;
}
sub _pokemon_substructures_order_by_modulo {
my $modulo = shift;
my @return;
my @types_location = _pokemon_substructures_types_location($modulo);
for ( my $i = 0 ; $i < @types_location ; $i++ ) {
@return[ $types_location[$i] ] = $i;
}
return @return;
}
sub _pokemon_substructures_types_location {
my $modulo = shift;
return ( 0, 1, 2, 3 ) if $modulo == 0;
return ( 0, 1, 3, 2 ) if $modulo == 1;
return ( 0, 2, 1, 3 ) if $modulo == 2;
return ( 0, 3, 1, 2 ) if $modulo == 3;
return ( 0, 2, 3, 1 ) if $modulo == 4;
return ( 0, 3, 2, 1 ) if $modulo == 5;
return ( 1, 0, 2, 3 ) if $modulo == 6;
return ( 1, 0, 3, 2 ) if $modulo == 7;
return ( 2, 0, 1, 3 ) if $modulo == 8;
return ( 3, 0, 1, 2 ) if $modulo == 9;
return ( 2, 0, 3, 1 ) if $modulo == 10;
return ( 3, 0, 2, 1 ) if $modulo == 11;
return ( 1, 2, 0, 3 ) if $modulo == 12;
return ( 1, 3, 0, 2 ) if $modulo == 13;
return ( 2, 1, 0, 3 ) if $modulo == 14;
return ( 3, 1, 0, 2 ) if $modulo == 15;
return ( 2, 3, 0, 1 ) if $modulo == 16;
return ( 3, 2, 0, 1 ) if $modulo == 17;
return ( 1, 2, 3, 0 ) if $modulo == 18;
return ( 1, 3, 2, 0 ) if $modulo == 19;
return ( 2, 1, 3, 0 ) if $modulo == 20;
return ( 3, 1, 2, 0 ) if $modulo == 21;
return ( 2, 3, 1, 0 ) if $modulo == 22;
return ( 3, 2, 1, 0 ) if $modulo == 23;
}
sub _save_section {
my ( $content, $section ) = @_;
my $new_content = '';
$new_content .= $section->{data};
$new_content .=
"\x00" x ( $SECTION_AFTER_DATA_PADDING - $SECTION_DATA_SIZE );
$new_content .=
"\x00" x ( $SECTION_DATA_SIZE - $CHECKSUM_BYTES{ $section->{id} } );
$new_content .= pack 'v', $section->{id};
$new_content .= pack 'v', $section->{checksum};
$new_content .= pack 'V', $section->{signature};
$new_content .= pack 'V', $section->{save_index};
die
"The section size for section @{[$section->{id}]} is wrong @{[length $new_content]}."
if length $new_content != 4 * 1024;
${$content} .= $new_content;
}
sub save_changes {
my ( @saves, $extra, $filename );
( @saves[ 0, 1 ], $extra, $filename ) = @_;
my $content = '';
for my $save (@saves) {
my $counter_j = 0;
for my $section (@$save) {
die "Too much memory allocated" if length $content > 1000000;
_recalculate_checksum($section);
_save_section( \$content, $section );
}
}
$content .= $extra;
die "Save length is incorrect." if length $content != 128 * 1024;
open my $fh, '>', $filename;
print $fh $content;
close $fh;
}
sub enable_eon_ticket {
my $save = shift;
my $superdata = get_first_super_data($save);
say "Latios already enabled", return
if check_flag_id( $save, $superdata, $FLAG_SYS_HAS_EON_TICKET );
set_flag_id( $save, $superdata, $FLAG_SYS_HAS_EON_TICKET, 1 );
add_key_item( $save, $superdata, $ITEM_EON_TICKET );
set_first_super_data( $save, $superdata );
}
sub enable_rematch_main_legendary {
my $save = shift;
my $superdata = get_first_super_data($save);
if (check_flag_id($save, $superdata, $FLAG_LEGENDARY_BATTLE_COMPLETED)) {
set_flag_id ($save, $superdata, $FLAG_LEGENDARY_BATTLE_COMPLETED, 0);
}
if (check_flag_id($save, $superdata, $FLAG_HIDE_LEGEND_MON_CAVE_OF_ORIGIN)) {
set_flag_id ($save, $superdata, $FLAG_HIDE_LEGEND_MON_CAVE_OF_ORIGIN, 0);
}
if (get_var($save, $superdata, $VAR_CAVE_OF_ORIGIN_B4F_STATE)) {
set_var($save, $superdata, $VAR_CAVE_OF_ORIGIN_B4F_STATE, 0);
}
set_first_super_data( $save, $superdata );
}
sub add_key_item {
my $save = shift;
my $superdata = shift;
my $item_id = shift;
my $result = '';
open my $fh, '<', $superdata;
read $fh, my ($read), $KEY_ITEMS_OFFSET;
$result .= $read;
LOOP: {
for my $i ( 0 .. 19 ) {
read $fh, $read, 2;
my $found_item = unpack 'v', $read;
if ( $found_item == 0 ) {
read $fh, $read, 2;
$result .= pack 'v', $item_id;
$result .= pack 'v', 1;
last LOOP;
}
$result .= $read;
read $fh, $read, 2;
my $quantity = unpack 'v', $read;
$result .= $read;
if ( $found_item == $item_id ) {
warn "$item_id already present.";
last LOOP;
}
}
die "No room to add $item_id.";
}
$result .= join '', <$fh>;
${$superdata} = $result;
close $fh;
}
sub get_var {
my $save = shift;
my $superdata = shift;
my $var = shift;
my $read_until = (($var - $VARS_START) * 2) + 0x1340;
open my $fh, '<', $superdata;
read $fh, (my $read), $read_until or die "Unable to read";
read $fh, $read, 2 or die "Unable to read";
my $flag = unpack 'v', $read;
close $fh;
return $flag;
}
sub set_var {
my $save = shift;
my $superdata = shift;
my $var = shift;
my $value = shift;
die "$value bigger than 0xffff" if $value > 0xffff;
my $read_until = (($var - $VARS_START) * 2) + 0x1340;
my $result = shift;
open my $fh, '<', $superdata;
read $fh, (my $read), $read_until or die "Unable to read";
$result .= $read;
read $fh, $read, 2 or die "Unable to read";
$result .= pack 'v', $value;
$result .= join '', <$fh>;
${$superdata} = $result;
close $fh;
}
sub set_flag_id {
my $save = shift;
my $superdata = shift;
my $id = shift;
my $to_set = shift;
my $offset = int( $id / 8 ) + $FLAGS_OFFSET;
my $result = '';
open my $fh, '<', $superdata;
read $fh, my ($read), $offset;
$result .= $read;
read $fh, $read, 1;
$read = unpack 'C', $read;
if ($to_set) {
$result .= pack 'C', ( $read | ( 1 << ( $id & 7 ) ) );
}
else {
$result .= pack 'C', ( $read & ~( 1 << ( $id & 7 ) ) );
}
$result .= join '', <$fh>;
${$superdata} = $result;
close $fh;
}
sub check_flag_id {
my $save = shift;
my $superdata = shift;
my $id = shift;
my $offset = int( $id / 8 ) + $FLAGS_OFFSET;
my $flags_offset = unpack "x@{[$offset]} C", ${$superdata};
return ( $flags_offset >> ( $id & 7 ) ) & 1;
}
sub change_gender {
my $save = shift;
my $gender = shift;
my $section = _find_section_save( $save, $TRAINER_INFO );
my $new_data = '';
my $data = $section->{data};
open my $fh, '<', \$data;
read $fh, my $read, 8;
$new_data .= $read;
$new_data .= pack 'c', $gender;
read $fh, $read, 1;
$new_data .= join '', <$fh>;
$section->{data} = $new_data;
}
sub _recalculate_checksum {
my $section = shift;
my $data = $section->{data};
my $section_id = $section->{id};
my $size = $CHECKSUM_BYTES{$section_id};
my $checksum = 0;
open my $fh, '<', \$data;
for ( my $i = 0 ; $i < $size ; $i += 4 ) {
my $readed = '';
read $fh, $readed, 4;
my $to_add = unpack 'V', $readed;
$checksum = _sum_u32( $checksum, $to_add );
}
my $final_checksum = _sum_u32_to_u16( $checksum, $checksum >> 16 );
$section->{checksum} = $final_checksum;
}
use Inline C => <<'EOF';
unsigned int
_sum_u32(unsigned int a, unsigned int b) {
return a + b;
}
unsigned short
_sum_u32_to_u16(unsigned int a, unsigned int b) {
return (short) a + b;
}
unsigned short
_sum_u16(unsigned short a, unsigned short b) {
return (unsigned short) a + b;
}
EOF
sub _find_section_save {
my $save = shift;
my $section_id = shift;
for my $section (@$save) {
return $section if $section_id == $section->{id};
}
}
sub _find_sections_save {
my $save = shift;
my @section_ids = @_;
my @return;
for my $section_id (@section_ids) {
push @return, _find_section_save( $save, $section_id );
}
return @return;
}
sub find_current_save_index {
my @saves = @_;
my $max_index;
my $max_save_pos;
for my $pos ( 0 .. 1 ) {
my $save = $saves[$pos];
my $section = _find_section_save( $save, $TRAINER_INFO );
my $index = $section->{save_index};
( ( $max_index, $max_save_pos ) = ( $index, $pos ) ), next
if !defined $max_index;
if ( $index > $max_index ) {
( $max_index, $max_save_pos ) = ( $index, $pos );
}
}
return $max_save_pos;
}
sub _print_sections_debug {
my @saves = map {
[
map {
{ %$_ }
} @$_
]
} @_;
for my $save (@saves) {
say "PRINTING SAVE";
for my $section (@$save) {
say "\tPRINTING SECTION";
for my $key (@ORDER_SECTION_WITHOUT_DATA) {
say "\t\t$key = @{[sprintf('%x', $section->{$key})]}";
}
}
}
}
sub get_saves {
my @saves_raw = @_;
my @saves;
for my $save_raw (@saves_raw) {
push @saves, _get_sections($save_raw);
}
return @saves;
}
sub _get_sections {
my $content = shift;
my $sections = [];
for ( 0 .. 13 ) {
my $section;
( $content, $section ) = _get_section($content);
push @$sections, $section;
}
return $sections;
}
sub _get_section {
my $content = shift;
my $data = substr $content, 0, $SECTION_DATA_SIZE;
$content = substr $content, $SECTION_AFTER_DATA_PADDING;
my $section_id = substr $content, 0, $SECTION_ID_SIZE;
$content = substr $content, $SECTION_ID_SIZE;
my $checksum = substr $content, 0, $SECTION_CHECKSUM_SIZE;
$content = substr $content, $SECTION_CHECKSUM_SIZE;
my $signature = substr $content, 0, $SECTION_SIGNATURE_SIZE;
$content = substr $content, $SECTION_SIGNATURE_SIZE;
my $save_index = substr $content, 0, $SECTION_SAVE_INDEX_SIZE;
$content = substr $content, $SECTION_SAVE_INDEX_SIZE;
$data = substr $data, 0, $CHECKSUM_BYTES{ unpack 'v', $section_id };
return (
$content,
{
save_index => unpack( 'V', $save_index ),
signature => unpack( 'V', $signature ),
checksum => unpack( 'v', $checksum ),
id => unpack( 'v', $section_id ),
data => $data,
}
);
}
sub check_correct_size {
my @sections_raw = @_;
my $sum = 0;
for my $section (@sections_raw) {
$sum += length $section;
}
die "Incorrect size" if $sum / 1024 != 128;
}
sub read_save {
my $file = shift;
my @sections;
my $extra;
open my $fh, '<', $file or die "Unable to read $file";
my $contents = join '', <$fh>;
for ( 0 .. 1 ) {
push @sections, substr $contents, 0, $SAVE_SIZE;
$contents = substr $contents, $SAVE_SIZE;
}
$extra = $contents;
close $fh;
return ( @sections, $extra );
}
1;