Games::NES::ROM - View information about an NES game from a ROM file

    use Games::NES::ROM;

    # Read in the ROM without having to know its format
    my $rom = Games::NES::ROM->load( 'file.nes' );

    # Specifically read in an iNES file
    $rom = Games::NES::ROM::INES->new( filename => 'file.nes' );

    # Access the details
    print 'PRG Banks: ', $rom->prg_count, "\n";
    print 'CHR Banks: ', $rom->prg_count, "\n";
    # etc...

    # View the SHA-1 & CRC checksums
    print 'SHA1: ', $rom->sha1, "\n";
    print ' CRC: ', $rom->crc, "\n";

    perl Makefile.PL
    make
    make test
    make install

package Games::NES::ROM;

use Moose;
use Try::Tiny;
use FileHandle;

our $VERSION = '0.07';

has 'filename' => ( is => 'rw' );

has 'filehandle' => ( is => 'rw', isa => 'FileHandle', lazy_build => 1 );

has 'id' => ( is => 'ro' );

has 'title' => ( is => 'rw' );

has 'prg_banks' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );

has 'chr_banks' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );

has 'has_sram' => ( is => 'rw', isa => 'Bool', default => 0 );

has 'mirroring' => ( is => 'rw', isa => 'Int', default => 0 );

has 'mapper' => ( is => 'rw' );

sub _build_filehandle {
    my $self = shift;
    my $file = $self->filename;
    my $fh   = FileHandle->new( $file, '<' );

    die "Unable to open ${file}: $!" unless defined $fh;

    binmode( $fh );
    return $fh;
}

__PACKAGE__->meta->make_immutable;

sub load {
    my( $class, $file ) = @_;

    for( qw( INES UNIF ) ) {
        my $class = 'Games::NES::ROM::Format::' . $_;
        Class::MOP::load_class( $class );

        my $rom = try {
            $class->new( filename => $file );
        };

        return $rom if $rom;
    }

    die "${file} is not an NES rom";
}

sub prg_count {
    return scalar @{ shift->prg_banks };
}

sub chr_count {
    return scalar @{ shift->chr_banks };
}

sub sha1 {
    my $self = shift;
    require Digest::SHA1;
    return Digest::SHA1::sha1_hex( @{ $self->prg_banks }, @{ $self->chr_banks } );
}

sub crc {
    my $self = shift;
    require Digest::CRC;
    return Digest::CRC::crc32_hex( join( '', @{ $self->prg_banks }, @{ $self->chr_banks } ) );
}

sub sprite {
    my( $self, $chr, $offset ) = @_;

    die 'invalid CHR bank' if $chr > $self->chr_count - 1 or $chr < 0;
    die 'invalid sprite index' if $offset > 512 or $offset < 0;
    
    my $bank      = $self->chr_banks->[ $chr ];
    my $start     = 16 * $offset;
    my @channel_a = unpack( 'C*', substr( $bank, $start, 8 ) );
    my @channel_b = unpack( 'C*', substr( $bank, $start + 8, 8 ) );

    my $composite = '';

    for my $i ( 0..7 ) {
        for my $j ( reverse 0..7 ) {
            $composite .= pack( 'C', $self->_combine_bits( $channel_a[ $i ], $channel_b[ $i ], $j ) );
        }
    }
    
    return $composite;
}

sub _combine_bits {
    my $self = shift;
    my( $chan_a, $chan_b, $offset ) = @_;

    return ( ( $chan_a >> $offset ) & 1 ) | ( ( ( $chan_b >> $offset ) & 1 ) << 1 );
}

1;

__END__