view release on metacpan or  search on metacpan

lib/Archive/ByteBoozer.pm  view on Meta::CPAN

  my $initial_address = 0x2000;
  crunch(source => $original, target => $crunched, precede_initial_address => $initial_address);

  # Crunch data replacing the first two bytes with the new initial address first:
  my $initial_address = 0x4000;
  crunch(source => $original, target => $crunched, replace_initial_address => $initial_address);

  # Attach decruncher with the given execute program address:
  my $program_address = 0x0c00;
  crunch(source => $original, target => $crunched, attach_decruncher => $program_address);

  # Relocate compressed data to the given start address:
  my $start_address = 0x0800;
  crunch(source => $original, target => $crunched, relocate_output => $start_address);

  # Relocate compressed data to the given end address:
  my $end_address = 0x2800;
  crunch(source => $original, target => $crunched, relocate_output_up_to => $end_address);

  # Enable verbose output while crunching data:
  my $verbose = 1;
  crunch(source => $original, target => $crunched, verbose => $verbose);

=head1 DESCRIPTION

David Malmborg's "ByteBoozer" is a data cruncher for Commodore files written in C. In Perl the following operations are implemented via C<Archive::ByteBoozer> package:

=over

=item *
Reading data from any given C<IO::> interface (including files, scalars, etc.)

=item *
Packing data using the compression algorithm implemented via ByteBoozer

=item *
Writing data into any given C<IO::> interface (including files, scalars, etc.)

=back

=head1 METHODS

=cut

use bytes;
use strict;
use warnings;

use base qw( Exporter );
our %EXPORT_TAGS = ();
$EXPORT_TAGS{'crunch'} = [ qw(&crunch) ];
$EXPORT_TAGS{'all'} = [ @{$EXPORT_TAGS{'crunch'}} ];
our @EXPORT_OK = @{ $EXPORT_TAGS{'all'} };
our @EXPORT = qw();

our $VERSION = '0.10';

use Data::Dumper;
use IO::Scalar;
use Params::Validate qw(:all);
use Scalar::Util qw(looks_like_number refaddr);

require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);

=head2 crunch

In order to crunch the data, you are required to provide source and target C<IO::> interfaces:

  my $original = new IO::File "original.prg", "r";
  my $crunched = new IO::File "crunched.prg", "w";
  crunch(source => $original, target => $crunched);

Upon writing the data into the target C<IO::> interface current position in the stream will be reset to the initial position acquired before the subroutine call, which enables immediate access to the compressed data without the necessity of seeking t...

In addition to the source and target C<IO::> interfaces, which are mandatory arguments to the C<crunch> subroutine call, the following parameters are recognized:

=head3 attach_decruncher

C<attach_decruncher> enables to attach decruncher procedure with the given program start address:

  my $program_address = 0x0c00;
  crunch(source => $in, target => $out, attach_decruncher => $program_address);

This will create an executable BASIC file that is by default loaded into the memory area beginning at $0801 (assuming no output relocation has been requested), and jumping directly to the given execute program address of $0c00 upon completion of the ...

=head3 make_executable

C<make_executable> is an alias for C<attach_decruncher>:

  my $program_address = 0x3600;
  crunch(source => $in, target => $out, make_executable => $program_address);

=head3 relocate_output

C<relocate_output> is used for setting up a new start address of the compressed data (by default data is shifted and aligned to fill in the memory up to the address of $fff9):

    my $start_address = 0x0800;
    crunch(source => $in, target => $out, relocate_output => $start_address);

This will relocate compressed data to the given start address of $0800 by writing an appropriate information in the output stream.

=head3 relocate_output_up_to

C<relocate_output_up_to> is used for setting up a new start address of the compressed data by shifting it up to the given end address (by default data is shifted and aligned to fill in the memory up to the address of $fff9, however you might want to ...

  my $end_address = 0x2800;
  crunch(source => $original, target => $crunched, relocate_output_up_to => $end_address);

This will relocate compressed data to some address below $2800 by writing an appropriate information in the output stream.

In the above example the following assumptions are true: your source code or other used data begins at $2800 and you want to load your compressed soundtrack file somewhere between $1000 and $2800, however you may still want to execute your decrunchin...

C<relocate_output_up_to> and C<relocate_output> parameters are mutually exclusive. C<relocate_output_up_to> always takes precedence over C<relocate_output>.

=head3 precede_initial_address

C<precede_initial_address> adds given initial address at the beginning of an input stream, so this option can be used for setting up start address on the target device upon decrunching compressed data. If you are targetting a raw stream of bytes with...

    my $initial_address = 0x2000;
    crunch(source => $in, target => $out, precede_initial_address => $initial_address);

lib/Archive/ByteBoozer.pm  view on Meta::CPAN

    }
    return;
}

sub _attach_decruncher {
    my ($params) = @_;
    my $start_address = $params->{attach_decruncher} || $params->{make_executable} || 0;
    $params->{_start_address} = $start_address;
    return;
}

sub _precede_initial_address {
    my ($params) = @_;
    my $precede_initial_address = $params->{precede_initial_address};
    return unless defined $precede_initial_address;
    my @memory_address = _memory_address_bytes($precede_initial_address);
    substr $params->{_source_data}, 0, 0, join '', @memory_address;
    return;
}

sub _get_address_to_relocate_output_up_to {
    my ($params) = @_;
    my $data_length = length ($params->{_crunched_data}) - 0x02;
    my $relocate_output_up_to = $params->{relocate_output_up_to};
    my $address_to_relocate_data = $relocate_output_up_to - $data_length;
    return $address_to_relocate_data;
}

sub _relocate_output {
    my ($params) = @_;
    my $relocate_output = $params->{relocate_output};
    my $relocate_output_up_to = $params->{relocate_output_up_to};
    return unless defined $relocate_output || defined $relocate_output_up_to;
    my $address_to_relocate_data =
        defined $relocate_output_up_to ? _get_address_to_relocate_output_up_to($params) : $relocate_output;
    my @memory_address = _memory_address_bytes($address_to_relocate_data);
    substr $params->{_crunched_data}, 0, 2, join '', @memory_address;
    return;
}

sub _replace_initial_address {
    my ($params) = @_;
    my $replace_initial_address = $params->{replace_initial_address};
    return unless defined $replace_initial_address;
    my @memory_address = _memory_address_bytes($replace_initial_address);
    substr $params->{_source_data}, 0, 2, join '', @memory_address;
    return;
}

sub crunch {
    my $params = { @_ };
    validate(
        @_, {
            source                  => { type => HANDLE, isa => 'IO::Handle', callbacks => {
                is_not_the_same_as_target => sub { exists $_[1]->{target} && refaddr $_[0] != refaddr $_[1]->{target} },
            } },
            target                  => { type => HANDLE, isa => 'IO::Handle', callbacks => {
                is_not_the_same_as_source => sub { exists $_[1]->{source} && refaddr $_[0] != refaddr $_[1]->{source} },
            } },
            attach_decruncher       => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            make_executable         => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            precede_initial_address => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            relocate_output         => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            relocate_output_up_to   => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            replace_initial_address => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            verbose                 => { type => SCALAR, optional => 1, regex => qr/^\d+$/ },
        }
    );
    my $pos = _seek_and_tell($params->{source}, $params->{target});
    my $source_position = $pos->{source}->{get}->($params->{source});
    my $target_position = $pos->{target}->{get}->($params->{target});
    _read_file $params;
    _precede_initial_address $params;
    die "Error (I-3): no data to crunch in input stream, aborting" unless length $params->{_source_data} > 1;
    _replace_initial_address $params;
    _attach_decruncher $params;
    _crunch_data $params;
    _relocate_output $params;
    _write_file $params;
    $pos->{source}->{set}->($params->{source}, $source_position);
    $pos->{target}->{set}->($params->{target}, $target_position);
    if (defined $params->{verbose} && $params->{verbose} == 1) {
        printf("[Archive::ByteBoozer] Compressed %u bytes into %u bytes.\n", length $params->{_source_data}, length $params->{_crunched_data});
    }
    return;
}

sub _seek_and_tell {
    my ($source, $target) = @_;
    my $source_getpos = $source->can('getpos') || \&IO::Scalar::getpos;
    my $source_setpos = $source->can('setpos') || \&IO::Scalar::setpos;
    my $target_getpos = $target->can('getpos') || \&IO::Scalar::getpos;
    my $target_setpos = $target->can('setpos') || \&IO::Scalar::setpos;
    return {
        'source' => {
            'get' => $source_getpos,
            'set' => $source_setpos,
        },
        'target' => {
            'get' => $target_getpos,
            'set' => $target_setpos,
        }
    };
}

=head1 EXAMPLES

Compress a PRG file named "part-1.prg", replace its start address with $2000 (this is where the data will be uncompressed to), move all packed bytes to $f000 (this will be written into loading address of the output file), and save crunched data into ...

  use Archive::ByteBoozer qw/crunch/;

  my $source            = new IO::File "part-1.prg", "r";
  my $target            = new IO::File "part-1.crunched.prg", "w";
  my $unpacking_address = 0x2000;
  my $relocate_address  = 0xf000;

  crunch(
    source                  => $source,
    target                  => $target,
    replace_initial_address => $unpacking_address,
    relocate_output         => $relocate_address,
  );

=head1 BUGS