Rsaves/lib/Rsaves.pm

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 $VAR_MIRAGE_RND_H/;

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/
);

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_mirage_island_for_pokemon {
    my $save      = shift;
    my $pokemon = shift;
    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 $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;