1179 lines
36 KiB
Perl
1179 lines
36 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_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 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/
|
|
);
|
|
|
|
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_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 = 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 = 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 $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 $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;
|