package Rsaves; use v5.34.1; use strict; use warnings; use feature 'signatures'; 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_MIRAGE_RND_H $VAR_CAVE_OF_ORIGIN_B4F_STATE $VARS_START/; use Rsaves::Constants::Global qw/$SAPPHIRE_VERSION $RUBY_VERSION $EMERALD_VERSION $FIRERED_VERSION $LEAFGREEN_VERSION $COLOSSEUM_VERSION/; use Rsaves::Constants::Firered::Flags qw/$FLAG_RECEIVED_AURORA_TICKET $FLAG_ENABLE_SHIP_BIRTH_ISLAND $FLAG_FOUGHT_DEOXYS $FLAG_DEOXYS_FLEW_AWAY/; use Rsaves::Constants::Firered::Vars qw/$VAR_MAP_SCENE_CERULEAN_CITY_RIVAL/; use Rsaves::Constants::MoveAttributes qw/get_move_attributes/; 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 enable_mirage_island_for_pokemon parse_version_name enable_deoxys_firered match_again_rival_firered_cerulean pokemon_fill_pp to_3rd_encoding translate_3rd_encoding/ ); 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_RUBY = hex '1220'; my $FLAGS_OFFSET_FIRERED = 0x0ee0; my $TRAINER_FLAG_START = hex '500'; my $NUMBER_OF_TRAINERS = 693; my $KEY_ITEMS_OFFSET_RUBY = 0x5b0; my $KEY_ITEMS_OFFSET_FIRERED = 0x03b8; my $MAX_KEY_ITEMS_RUBY = 20; my $MAX_KEY_ITEMS_FIRERED = 30; my $ITEM_EON_TICKET = 275; my $ITEM_AURORA_TICKET = 371; my $POKEMON_NAME_LENGTH = 10; my $OT_NAME_LENGTH = 7; my $BOX_NAME_LENGTH = 9; my $RUBY_VARS_START = 0x1340; my $FIRERED_VARS_START = 0x1000; 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 parse_version_name { my $version_name = shift; return if !defined $version_name; ( return ( { ruby => $RUBY_VERSION, sapphire => $SAPPHIRE_VERSION, emerald => $EMERALD_VERSION, firered => $FIRERED_VERSION, leafgreen => $LEAFGREEN_VERSION, }->{$version_name} ) ) or die "Unsupported version"; } sub pokemon_fill_pp($pokemon) { # Not taking pp bonuses in account, work for other day. for my $number_movement (0..3) { my $movement_id = $pokemon->{substructures}[1]{movements}[$number_movement]; my $pp = get_move_attributes($movement_id)->{'pp'}; $pokemon->{substructures}[1]{pp}[$number_movement] = $pp; } } 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}; my $nickname = $pokemon->{nickname}; if (length $nickname < 10) { $nickname .= chr(0xff); my $to_add = 10 - length $nickname; for (my $i = 0; $i < $to_add; $i++) { $nickname .= chr(int(rand(256))); } } print $fh $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; $substructures->[$i] = _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 = 0xffff & (( 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 = 0xBB; 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 $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) { for my $section (@$save) { die "Too much memory allocated" if length $content > 1000000; _recalculate_checksum($section); _save_section( \$content, $section ); } } $content .= $extra; open my $fh, '>', $filename; print $fh $content; close $fh; } sub enable_eon_ticket { my $save = shift; my $section0 = _find_section_save( $save, 0 ); die "This is not Pokémon Ruby or Sapphire" if !_is_ruby_or_sapphire( $section0->{version} ); 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 match_again_rival_firered_cerulean { my $save = shift; my $section0 = _find_section_save( $save, 0 ); my $version = $section0->{version}; die "This is not Pokemon Leafgreen or Firered" if !_is_leafgreen_or_firered($version); my $superdata = get_first_super_data($save); set_var( $save, $superdata, $VAR_MAP_SCENE_CERULEAN_CITY_RIVAL, 0 ); set_first_super_data($save, $superdata); } sub enable_deoxys_firered { my $save = shift; my $section0 = _find_section_save( $save, 0 ); die "This is not Pokemon Leafgreen or Firered" if !_is_leafgreen_or_firered( $section0->{version} ); my $superdata = get_first_super_data($save); set_flag_id( $save, $superdata, $FLAG_RECEIVED_AURORA_TICKET, 1 ); set_flag_id( $save, $superdata, $FLAG_ENABLE_SHIP_BIRTH_ISLAND, 1 ); set_flag_id( $save, $superdata, $FLAG_FOUGHT_DEOXYS, 0 ); set_flag_id( $save, $superdata, $FLAG_DEOXYS_FLEW_AWAY, 0 ); add_key_item( $save, $superdata, $ITEM_AURORA_TICKET ); set_first_super_data( $save, $superdata ); } sub enable_mirage_island_for_pokemon { my $save = shift; my $pokemon = shift; my $section0 = _find_section_save( $save, 0 ); die "This is not Pokémon Ruby or Sapphire" if !_is_ruby_or_sapphire( $section0->{version} ); my $superdata = get_first_super_data($save); my $personality = $pokemon->{personality}; my $substruct0 = find_pokemon_substruct( $pokemon->{substructures}, 0 ); say $substruct0->{species}; printf "%x\n", $personality & 0xffff; set_var( $save, $superdata, $VAR_MIRAGE_RND_H, $personality & 0xffff ); set_first_super_data( $save, $superdata ); } sub enable_rematch_main_legendary { my $save = shift; my $section0 = _find_section_save( $save, 0 ); die "This is not Pokémon Ruby or Sapphire" if !_is_ruby_or_sapphire( $section0->{version} ); 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 get_security_key { my $save = shift; my $section0 = _find_section_save( $save, 0 ); my $version = $section0->{version}; my $data = $section0->{data}; open my $fh, '<', \$data; if (_is_leafgreen_or_firered($version)) { read $fh, my $read, 0xf20; read $fh, $read, 4; return unpack 'V', $read; } elsif (_is_ruby_or_sapphire($version)) { return 0; } close $fh; die "Not implemented"; } sub add_key_item { my $save = shift; my $superdata = shift; my $item_id = shift; my $result = ''; my $section0 = _find_section_save( $save, 0 ); my $version = $section0->{version}; open my $fh, '<', $superdata; my $offset = $KEY_ITEMS_OFFSET_RUBY; my $max_key_items = $MAX_KEY_ITEMS_RUBY; if (_is_leafgreen_or_firered($version)) { $offset = $KEY_ITEMS_OFFSET_FIRERED; $max_key_items = $MAX_KEY_ITEMS_FIRERED; } read $fh, my ($read), $offset; $result .= $read; LOOP: { for my $i ( 0 .. $max_key_items - 1 ) { 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', get_security_key($save) ^ 1; last LOOP; } $result .= $read; read $fh, $read, 2; my $quantity = get_security_key($save) ^ (unpack 'v', $read); $result .= $read; if ( $found_item == $item_id ) { warn "$item_id already present with $quantity."; 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 $section0 = _find_section_save( $save, 0 ); my $version = $section0->{version}; my $read_until = ( ( $var - $Rsaves::Constants::Ruby::Vars::VARS_START ) * 2 ) + $RUBY_VARS_START; if (_is_leafgreen_or_firered($version)) { $read_until = ( ( $var - $Rsaves::Constants::Firered::Vars::VARS_START ) * 2 ) + $FIRERED_VARS_START; } if (_is_emerald($version)) { die "Not implemented."; } 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; my $section0 = _find_section_save( $save, 0 ); my $version = $section0->{version}; die "$value bigger than 0xffff" if $value > 0xffff; my $read_until = ( ( $var - $Rsaves::Constants::Ruby::Vars::VARS_START ) * 2 ) + $RUBY_VARS_START; if (_is_leafgreen_or_firered($version)) { $read_until = ( ( $var - $Rsaves::Constants::Firered::Vars::VARS_START ) * 2 ) + $FIRERED_VARS_START; } if (_is_emerald($version)) { die "Not implemented."; } 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 $section0 = _find_section_save( $save, 0 ); my $version = $section0->{version}; my $offset = int( $id / 8 ) + $FLAGS_OFFSET_RUBY; if ( _is_leafgreen_or_firered($version) ) { $offset = (int $id / 8 ) + $FLAGS_OFFSET_FIRERED; } 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 $section0 = _find_section_save( $save, 0 ); my $version = $section0->{version}; my $offset = int( $id / 8 ) + $FLAGS_OFFSET_RUBY; if ( _is_leafgreen_or_firered($version) ) { $offset = int ($id / 8 ) + $FLAGS_OFFSET_FIRERED; } 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 = 0xffffffff & ($checksum + $to_add); } my $final_checksum = (_hihalf_u32($checksum) + _lowhalf_u32($checksum)) & 0xffffffff; $section->{checksum} = $final_checksum; } 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 _is_ruby_or_sapphire { my $version = shift; return 1 if $version == $SAPPHIRE_VERSION; return 1 if $version == $RUBY_VERSION; return 0; } sub _is_emerald { my $version = shift; return 1 if $version == $EMERALD_VERSION; return 0; } sub _is_leafgreen_or_firered { my $version = shift; return 1 if $version == $FIRERED_VERSION; return 1 if $version == $LEAFGREEN_VERSION; return 0; } sub _is_supported_version { my $version = shift; return 1 if _is_emerald($version) || _is_ruby_or_sapphire($version) || _is_leafgreen_or_firered($version); return 0; } sub get_saves { my @saves_raw = @_[ 0, 1 ]; my $version = $_[2] // $RUBY_VERSION; die "Version not supported" if !_is_supported_version($version); my @saves; for my $save_raw (@saves_raw) { push @saves, _get_sections( $save_raw, $version ); } return @saves; } sub _get_sections { my $content = shift; my $version = shift; my $sections = []; for ( 0 .. 13 ) { my $section; ( $content, $section ) = _get_section( $content, $version ); push @$sections, $section; } return $sections; } sub _get_section { my $content = shift; my $version = 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, version => $version, } ); } 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;