File Coverage

blib/lib/Audio/SID.pm

Criterion	Covered	Total	%
statement	18	639	2.8
branch	0	394	0.0
condition	0	222	0.0
subroutine	6	42	14.2
pod	36	36	100.0
total	60	1333	4.5

package Audio::SID;

require 5;

use Carp;
use strict;
use vars qw($VERSION);
use FileHandle;
use Digest::MD5;
use Encode;

$VERSION = "4.00";

# These are the recognized field names for a SID file. They must appear in
# the order they appear in a SID file.
# 'flags', 'startPage' and 'pageLength' is valid for v2 only.
# 'secondSIDAddress' is valid for v3+ only, 'thirdSIDAddress' is valid for
# v4+ only. In addition, these last two fields are replaced with 'reserved' for
# v2 only.
my (@SIDfieldNames) = qw(magicID version dataOffset loadAddress initAddress
                         playAddress songs startSong speed title author
                         released flags startPage pageLength secondSIDAddress
                         thirdSIDAddress reserved data);

# Additional data stored in the class that are not part of the SID file
# format are: FILESIZE, FILENAME, and the implicit REAL_LOAD_ADDRESS.
#
# PADDING is used to hold any extra bytes that may be between the standard
# SID header and the data (usually happens when dataOffset is more than
# 0x007C).

# Constants for individual fields inside 'flags'.
my $MUSPLAYER_OFFSET = 0; # Bit 0.
my $PLAYSID_OFFSET   = 1; # Bit 1. (PSID v2NG only)
my $C64BASIC_OFFSET  = 1; # Bit 1. (RSID only)
my $CLOCK_OFFSET     = 2; # Bits 2-3.
my $SIDMODEL_OFFSET  = 4; # Bits 4-5.
my $SECOND_SIDMODEL_OFFSET = 6; # Bits 6-7.
my $THIRD_SIDMODEL_OFFSET  = 8; # Bits 8-9.

sub new {
    my $type = shift;
    my %params = @_;
    my $class = ref($type) || $type;
    my $self = {};

    bless ($self, $class);

    $self->initialize();

    $self->{validateWrite} = 0;

    if (defined($_[0])) {
        # Read errors are taken care of by read().
        return ($self->read(%params) ? $self : undef);
    }

    return $self;
}

sub initialize() {
    my ($self) = $_[0];

    # Initial SID data.
    $self->{SIDdata} = {
        magicID => 'RSID',
        version => 4,
        dataOffset => 0x7C,
        loadAddress => 0,
        initAddress => 0,
        playAddress => 0,
        songs => 1,
        startSong => 1,
        speed => 0,
        title => '',
        author => '',
        released => '20?? ',
        flags => 0,
        startPage => 0,
        pageLength => 0,
        secondSIDAddress => 0,
        thirdSIDAddress => 0,
        reserved => undef,
        data => '',
    };

    $self->{PADDING} = '';

    $self->{FILESIZE} = 0x7C;
    $self->{FILENAME} = '';
}

sub read {
    my $self = shift;
    my $filename;
    my $filedata;
    my $hdr;
    my $i;
    my ($size, $totsize);
    my $data;
    my $FH;
    my ($SID, $version, $dataOffset);
    my @hdr;
    my $hdrlength;

    # Check parameters.

    if (($_[0] =~ /^\-filedata$/i) and defined($_[1])) {
        $filedata = $_[1];
    }
    elsif (($_[0] =~ /^\-file(name)|(handle)$/i) and defined($_[1])) {
        $filename = $_[1];
    }
    elsif (defined($_[0]) and !defined($_[1])) {
        $filename = $_[0];
    }
    elsif (defined($_[0])) {
        confess("Unknown parameter '$_[0]'!");
        $self->initialize();
        return undef;
    }

    unless (defined($filedata)) {
        # Either a scalar filename (or nothing) was passed in, in which case
        # we'll open it, or a filehandle was passed in, in which case we just
        # skip the following step.

        if (ref(\$filename) ne "GLOB") {

            $filename = $self->{FILENAME} unless (defined($filename));

            unless ($filename) {
                confess("No filename was specified");
                $self->initialize();
                return undef;
            }

            unless ($FH = new FileHandle ("< $filename")) {
                confess("Error opening $filename");
                $self->initialize();
                return undef;
            }
        }
        else {
            $FH = $filename;
        }

        # Just to make sure...
        binmode $FH;
        seek($FH,0,0);

        $size = read ($FH, $hdr, 8);
    }
    else {
        $hdr = substr($filedata, 0, 8);
        $size = length($hdr);
    }

    unless ($size) {
#        confess("Error reading $filename");
        $self->initialize();
        return undef;
    }

    $totsize += $size;

    ($SID, $version, $dataOffset) = unpack ("A4nn", $hdr);

    unless ( (($SID eq 'PSID') and (($version >= 1) and ($version <= 4))) or
            (($SID eq 'RSID') and ($version >= 2) and ($version <=4)) ) {
        # Not a valid SID file recognized by this class.
#        confess("File $filename is not a valid SID file");
        $self->initialize();
        return undef;
    }

    # Valid SID file.

    $self->{SIDdata}{magicID} = $SID;
    $self->{SIDdata}{version} = $version;
    $self->{SIDdata}{dataOffset} = $dataOffset;

    # Slurp up the rest of the header.
    unless (defined($filedata)) {
        $size = read ($FH, $hdr, $dataOffset-8);
    }
    else {
        $hdr = substr($filedata, 8, $dataOffset-8);
        $size = length($hdr);
    }

    # If the header is not as big as indicated by the dataOffset,
    # we have a problem.
    if ($size != ($dataOffset-8)) {
#        confess("Error reading $filename - incorrect header");
        $self->initialize();
        return undef;
    }

    $totsize += $size;

    $hdrlength = 2*5+4+32*3;
    (@hdr) = unpack ("nnnnnNA32A32A32", substr($hdr,0,$hdrlength));

    if ($version == 1) {
        # SID v1 doesn't have these fields.
        $self->{SIDdata}{flags} = undef;
        $self->{SIDdata}{startPage} = undef;
        $self->{SIDdata}{pageLength} = undef;
        $self->{SIDdata}{secondSIDAddress} = undef;
        $self->{SIDdata}{thirdSIDAddress} = undef;
        $self->{SIDdata}{reserved} = undef;
    }

    if ($version >= 2) {
        # SID v2+ has 3 more fields.

        my @temphdr;
        (@temphdr) = unpack ("nCC", substr($hdr,$hdrlength,2+1+1));
        push (@hdr, @temphdr);
        $hdrlength += 2+1+1;

        if ($version == 2) {
            # SID v2 doesn't have these fields.
            $self->{SIDdata}{secondSIDAddress} = undef;
            $self->{SIDdata}{thirdSIDAddress} = undef;

            # But it has this field (for backwards compatibility).
            $self->{SIDdata}{reserved} = unpack("n",substr($hdr,$hdrlength,1));
            $hdrlength += 2;
        }
    }

    if ($version >= 3) {
        # SID v3+ has 1 more field.
        my @temphdr;
        (@temphdr) = unpack ("C", substr($hdr,$hdrlength,1));
        push (@hdr, @temphdr);
        $hdrlength += 1;

        if ($version == 3) {
            # SID v3 doesn't have these fields.
            $self->{SIDdata}{thirdSIDAddress} = undef;

            # But it has this field.
            $self->{SIDdata}{reserved} = unpack("C",substr($hdr,$hdrlength,1));
            $hdrlength += 1;
        }
    }

    if ($version >= 4) {
        # SID v4+ has 1 more field.
        my @temphdr;
        (@temphdr) = unpack ("C", substr($hdr,$hdrlength,1));
        push (@hdr, @temphdr);
        $hdrlength += 1;

        if ($version == 4) {
            # SID v4 doesn't have these fields.
            $self->{SIDdata}{reserved} = undef;
        }
    }

    # Store header info.
    for ($i=0; $i <= $#hdr; $i++) {
        $self->{SIDdata}{$SIDfieldNames[$i+3]} = $hdr[$i];
    }

    # Put the rest into PADDING. This might put nothing in it!
    $self->{PADDING} = substr($hdr,$hdrlength);

    # Read the C64 data - can't be more than 64KB + 2 bytes load address.
    unless (defined($filedata)) {
        $size = read ($FH, $data, 65536+2);
    }
    else {
        $data = substr($filedata, $dataOffset);
        $size = length($data);
    }

    # We allow a 0 length data.
    unless (defined($size)) {
#        confess("Error reading $filename");
        $self->initialize();
        return undef;
    }

    $totsize += $size;

    if ((ref(\$filename) ne "GLOB") and !defined($filedata)) {
        $FH->close();
        $self->{FILENAME} = $filename;
    }

    $self->{SIDdata}{data} = $data;

    $self->{FILESIZE} = $totsize;

    return 1;
}

sub write {
    my $self = shift;
    my $filename;
    my $output;
    my @hdr;
    my $i;
    my $FH;

    # Check parameters.

    if (($_[0] =~ /^\-file(name)|(handle)$/i) and defined($_[1])) {
        $filename = $_[1];
    }
    elsif (defined($_[0]) and !defined($_[1])) {
        $filename = $_[0];
    }
    elsif (defined($_[0])) {
        confess("Unknown parameter '$_[0]'!");
        $self->initialize();
        return undef;
    }

    # Either a scalar filename (or nothing) was passed in, in which case
    # we'll open it, or a filehandle was passed in, in which case we just
    # skip the following step.

    if (ref(\$filename) ne "GLOB") {
        $filename = $self->{FILENAME} unless (defined($filename));

        unless ($filename) {
            confess("No filename was specified");
            return undef;
        }

        unless ($FH = new FileHandle ("> $filename")) {
            confess("Couldn't write $filename");
            return undef;
        }
    }
    else {
        $FH = $filename;
    }

    # Just to make sure...
    binmode $FH;
    seek($FH,0,0);

    if ($self->{validateWrite}) {
        $self->validate();
    }

    # SID files use ISO 8859-1 encoding for textual fields, not Unicode.
    foreach (qw/title author released/) {
        $self->{SIDdata}{$_} = encode("latin1", $self->{SIDdata}{$_});
    }

    for ($i=0; $i <= 11; $i++) {
        $hdr[$i] = $self->{SIDdata}{$SIDfieldNames[$i]};
    }

    $output = pack ("A4nnnnnnnNA32A32A32", @hdr);

    print $FH $output;

    # SID version 2+ has 3 more fields.
    if ($self->{SIDdata}{version} > 1) {
        $output = pack ("nCC", ($self->{SIDdata}{flags}, $self->{SIDdata}{startPage}, $self->{SIDdata}{pageLength}));
        print $FH $output;
    }

    if ($self->{SIDdata}{version} == 2) {
        # SID version 2 has the 'reserved' field.
        $output = pack ("n", ($self->{SIDdata}{reserved}));
        print $FH $output;
    }
    elsif ($self->{SIDdata}{version} == 3) {
        # SID version 3 has one more field.
        $output = pack ("CC", ($self->{SIDdata}{secondSIDAddress}, $self->{SIDdata}{reserved}));
        print $FH $output;
    }
    elsif ($self->{SIDdata}{version} == 4) {
        # SID version 4 has two more fields.
        $output = pack ("CC", ($self->{SIDdata}{secondSIDAddress}, $self->{SIDdata}{thirdSIDAddress}));
        print $FH $output;
    }

    print $FH $self->{PADDING};

    print $FH $self->{SIDdata}{data};

    if (ref(\$filename) ne "GLOB") {
        $FH->close();
    }
}

# Notice that if no specific fieldname is given and we are in array/hash
# context, all fields are returned!
sub get {
    my ($self, $fieldname) = @_;
    my %SIDhash;
    my $field;

    foreach $field (keys %{$self->{SIDdata}}) {
        $SIDhash{$field} = $self->{SIDdata}{$field};
    }

    # Strip off trailing NULLs.
    $SIDhash{title} =~ s/\x00*$//;
    $SIDhash{author} =~ s/\x00*$//;
    $SIDhash{released} =~ s/\x00*$//;

    return unless (defined(wantarray()));

    unless (defined($fieldname)) {
        # No specific fieldname is given. Assume user wants a hash of
        # field values.
        if (wantarray()) {
            return %SIDhash;
        }
        else {
            confess ("Nothing to get, not in array context");
            return undef;
        }
    }

    # Backwards compatibility.
    $fieldname = "released" if ($fieldname =~ /^copyright$/);
    $fieldname = "title" if ($fieldname =~ /^name$/);

    unless (grep(/^$fieldname$/, @SIDfieldNames)) {
        confess ("No such fieldname: $fieldname");
        return undef;
    }

    return $SIDhash{$fieldname};
}

sub getFileName {
    my $self = shift;

    return $self->{FILENAME};
}

sub getFileSize {
    my $self = shift;

    return $self->{FILESIZE};
}

sub getRealLoadAddress {
    my $self = shift;
    my $REAL_LOAD_ADDRESS;

    # It's a read-only "implicit" field, so we just calculate it
    # on the fly.
    if ($self->{SIDdata}{data} and $self->{SIDdata}{loadAddress} == 0) {
        $REAL_LOAD_ADDRESS = unpack("v", substr($self->{SIDdata}{data}, 0, 2));
    }
    else {
        $REAL_LOAD_ADDRESS = $self->{SIDdata}{loadAddress};
    }

    return $REAL_LOAD_ADDRESS;
}

sub getSpeed($) {
    my ($self, $songnumber) = @_;

    $songnumber = 1 if ((!defined($songnumber)) or ($songnumber < 1));

    if ($songnumber > $self->{SIDdata}{songs}) {
        confess ("Song number '$songnumber' is invalid!");
        return undef;
    }

    if ($self->isPlaySIDSpecific()) {
        $songnumber = $songnumber % 32;
    }
    else {
        $songnumber = 32 if ($songnumber > 32);
    }

    return (($self->{SIDdata}{speed} >> ($songnumber-1)) & 0x1);
}

sub getMUSPlayer {
    my $self = shift;

    return undef unless (defined($self->{SIDdata}{flags}));

    return (($self->{SIDdata}{flags} >> $MUSPLAYER_OFFSET) & 0x1);
}

sub isMUSPlayerRequired {
    my $self = shift;

    return $self->getMUSPlayer();
}

sub getPlaySID {
    my $self = shift;

    # All version 1 files are PlaySID specific.
    return 1 if ($self->{SIDdata}{version} == 1);

    # Check the PlaySID specific flag.

    return undef unless (defined($self->{SIDdata}{flags}));
    return undef if ($self->isRSID() );

    return (($self->{SIDdata}{flags} >> $PLAYSID_OFFSET) & 0x1);
}

sub isPlaySIDSpecific {
    my $self = shift;

    return $self->getPlaySID();
}

sub isRSID {
    my $self = shift;

    return ($self->{SIDdata}{magicID} eq 'RSID');
}

sub getC64BASIC {
    my $self = shift;

    # This is an RSID specific flag.
    return undef unless (defined($self->{SIDdata}{flags}));
    return undef unless ($self->isRSID() );

    return (($self->{SIDdata}{flags} >> $C64BASIC_OFFSET) & 0x1);
}

sub isC64BASIC {
    my $self = shift;

    return $self->getC64BASIC();
}

sub getClock {
    my $self = shift;

    return undef unless (defined($self->{SIDdata}{flags}));

    return (($self->{SIDdata}{flags} >> $CLOCK_OFFSET) & 0x3);
}

sub getClockByName {
    my $self = shift;
    my $clock;

    return undef unless (defined($self->{SIDdata}{flags}));

    $clock = $self->getClock();

    if ($clock == 0) {
        $clock = 'UNKNOWN';
    }
    elsif ($clock == 1) {
        $clock = 'PAL';
    }
    elsif ($clock == 2) {
        $clock = 'NTSC';
    }
    elsif ($clock == 3) {
        $clock = 'EITHER';
    }

    return $clock;
}

sub getSIDModel {
    my ($self, $sidNumber) = @_;

    return undef unless (defined($self->{SIDdata}{flags}));

    if (!defined($sidNumber) or ($sidNumber == 1)) {
        return (($self->{SIDdata}{flags} >> $SIDMODEL_OFFSET) & 0x3);
    }
    elsif ($sidNumber == 2) {
        return undef unless ($self->{SIDdata}{version} >= 3);

        return (($self->{SIDdata}{flags} >> $SECOND_SIDMODEL_OFFSET) & 0x3);
    }
    elsif ($sidNumber == 3) {
        return undef unless ($self->{SIDdata}{version} >= 4);

        return (($self->{SIDdata}{flags} >> $THIRD_SIDMODEL_OFFSET) & 0x3);
    }
}

sub getSIDModelByName {
    my ($self, $sidNumber) = @_;
    my $SIDModel;

    $SIDModel = $self->getSIDModel($sidNumber);

    return undef unless (defined($SIDModel));

    if ($SIDModel == 0) {
        $SIDModel = 'UNKNOWN';
    }
    elsif ($SIDModel == 1) {
        $SIDModel = '6581';
    }
    elsif ($SIDModel == 2) {
        $SIDModel = '8580';
    }
    elsif ($SIDModel == 3) {
        $SIDModel = 'EITHER';
    }

    return $SIDModel;
}

sub getSIDAddress($) {
    my ($self, $sidNumber) = @_;
    my $SIDAddressMiddle;
    my $fullSIDAddress;

    if (!defined($sidNumber) or ($sidNumber == 1)) {
        # Original SID is always at $D400. This is implied, it's not contained
        # in SID file data at all - it's returned just for completeness.
        $SIDAddressMiddle = 0x40;
    }
    elsif ($sidNumber == 2) {
        # Second SID address is valid for v3+ only.
        return undef unless $self->{SIDdata}{version} >= 3;

        $SIDAddressMiddle = $self->{SIDdata}{secondSIDAddress};
    }
    elsif ($sidNumber == 3) {
        # Third SID address is valid for v4+ only.
        return undef unless $self->{SIDdata}{version} >= 4;

        $SIDAddressMiddle = $self->{SIDdata}{thirdSIDAddress};
    }

    $fullSIDAddress = 0xD000 + $SIDAddressMiddle * 0x10;

    return $fullSIDAddress;
}

# Notice that you have to pass in a hash (field-value pairs)!
sub set(@) {
    my ($self, %SIDhash) = @_;
    my $fieldname;
    my $paddinglength;
    my $i;
    my $version;
    my $offset;
    my $changePSIDSpecific = 0;

    foreach $fieldname (keys %SIDhash) {

        # Backwards compatibility.
        $fieldname = "released" if ($fieldname =~ /^copyright$/);
        $fieldname = "title" if ($fieldname =~ /^name$/);

        unless (grep(/^$fieldname$/, @SIDfieldNames)) {
            confess ("Not a supported fieldname: $fieldname");
            next;
        }

        # Do some basic sanity checking.

        if ($fieldname eq 'magicID') {
            if (($SIDhash{$fieldname} ne 'PSID') and ($SIDhash{$fieldname} ne 'RSID')) {
                confess ("Unrecognized magicID: $SIDhash{$fieldname}");
                next;
            }

            if ($SIDhash{$fieldname} ne $self->{SIDdata}{magicID}) {
                $changePSIDSpecific = 1;
            }
        }

        if ($fieldname eq 'version') {
            if (($SIDhash{$fieldname} < 1) or ($SIDhash{$fieldname} > 4)) {
                confess ("Invalid SID version number '$SIDhash{$fieldname}' - ignored");
                next;
            }
        }

        if (($self->{SIDdata}{version} < 2) and
            (($fieldname eq 'magicID') or ($fieldname eq 'flags') or ($fieldname eq 'reserved') or
             ($fieldname eq 'startPage') or ($fieldname eq 'pageLength'))) {

            confess ("Can't change '$fieldname' when SID version is set to 1");
            next;
        }

        if (($self->{SIDdata}{version} < 3) and
            (($fieldname eq 'secondSIDAddress') or ($fieldname eq 'thirdSIDAddress'))) {

            confess ("Can't change '$fieldname' when SID version is less than 3");
            next;
        }

        if (($self->{SIDdata}{version} < 4) and
            ($fieldname eq 'thirdSIDAddress')) {

            confess ("Can't change '$fieldname' when SID version is less than 4");
            next;
        }

        # SID files use ISO 8859-1 encoding for textual fields, not Unicode.
        if (($fieldname eq 'title') or ($fieldname eq 'author') or ($fieldname eq 'released')) {
            $SIDhash{$fieldname} = encode("latin1", $SIDhash{$fieldname});
        }

        $self->{SIDdata}{$fieldname} = $SIDhash{$fieldname};
    }

    if ($self->{SIDdata}{version} == 1) {
        # PSID v1 values are set in stone.
        $self->{SIDdata}{magicID} = 'PSID';
        $self->{SIDdata}{version} = 1;
        $self->{SIDdata}{dataOffset} = 0x76;
        $self->{SIDdata}{flags} = undef;
        $self->{SIDdata}{startPage} = undef;
        $self->{SIDdata}{pageLength} = undef;
        $self->{SIDdata}{reserved} = undef;
        $self->{PADDING} = '';
    }
    elsif (($self->{SIDdata}{version} >= 2) and ($self->{SIDdata}{version} <= 4)) {
        # In PSID v2NG/RSID we allow dataOffset to be larger than 0x7C.

        $self->{PADDING} = '';

        if ($self->{SIDdata}{dataOffset} <= 0x7C) {
            $self->{SIDdata}{dataOffset} = 0x7C;
        }
        else {
            $paddinglength = $self->{SIDdata}{dataOffset} - 0x7C;

            # Add as many zeroes as necessary.
            for ($i=1; $i <= $paddinglength; $i++) {
                $self->{PADDING} .= pack("C", 0x00);
            }
        }

        # Make sure these are not undef'd.
        unless (defined($self->{SIDdata}{flags})) {
            $self->{SIDdata}{flags} = 0;
        }

        unless (defined($self->{SIDdata}{startPage})) {
            $self->{SIDdata}{startPage} = 0;
        }

        unless (defined($self->{SIDdata}{pageLength})) {
            $self->{SIDdata}{pageLength} = 0;
        }

        if (($self->{SIDdata}{version} == 2) or ($self->{SIDdata}{version} == 3)) {
            unless (defined($self->{SIDdata}{reserved})) {
                $self->{SIDdata}{reserved} = 0;
            }
        }

        if ($self->{SIDdata}{version} >= 3) {
            unless (defined($self->{SIDdata}{secondSIDAddress})) {
                $self->{SIDdata}{secondSIDAddress} = 0;
            }
            $self->{SIDdata}{thirdSIDAddress} = undef;
        }

        if ($self->{SIDdata}{version} >= 4) {
            unless (defined($self->{SIDdata}{thirdSIDAddress})) {
                $self->{SIDdata}{thirdSIDAddress} = 0;
            }
            $self->{SIDdata}{reserved} = undef;
        }

        if ($changePSIDSpecific) {
            # Zero this flag only if 'flags' is not explicitly set at the same time.
            if (!$SIDhash{'flags'}) {
                if ($self->isRSID() ) {
                    $self->setC64BASIC(0);
                }
                else {
                    $self->setPlaySID(0);
                }
            }
        }

        # RSID values are set in stone.
        if ($self->isRSID() ) {
            $self->{SIDdata}{playAddress} = 0;
            $self->{SIDdata}{speed} = 0;

            # The preferred way is for loadAddress to be 0. The data is
            # prepended by those 2 bytes if it needs to be changed.

            if ($self->{SIDdata}{loadAddress} != 0) {
                $self->{SIDdata}{data} = pack("v", $self->{SIDdata}{loadAddress}) . $self->{SIDdata}{data};
                $self->{SIDdata}{loadAddress} = 0;
            }

            # initAddress must be 0 if the C64 BASIC flag is set.
            if ($self->getC64BASIC() ) {
                $self->{SIDdata}{initAddress} = 0;
            }
        }
    }

    $self->{FILESIZE} = $self->{SIDdata}{dataOffset} + length($self->{PADDING}) +
        length($self->{SIDdata}{data});

    return 1;
}

sub setFileName($) {
    my ($self, $filename) = @_;

    $self->{FILENAME} = $filename;
}

sub setSpeed($$) {
    my ($self, $songnumber, $value) = @_;

    unless (defined($songnumber)) {
        confess ("No song number was specified!");
        return undef;
    }

    unless (defined($value)) {
        confess ("No speed value was specified!");
        return undef;
    }

    if (($songnumber > $self->{SIDdata}{songs}) or ($songnumber < 1)) {
        confess ("Song number '$songnumber' is invalid!");
        return undef;
    }

    if (($value ne 0) and ($value ne 1)) {
        confess ("Specified value '$value' is invalid!");
        return undef;
    }

    $songnumber = 1 if ($songnumber < 1);

    if (($self->{SIDdata}{version} == 1) or $self->isPlaySIDSpecific()) {
        $songnumber = $songnumber % 32;
    }
    else {
        $songnumber = 32 if ($songnumber > 32);
    }

    # First, clear the bit in question.
    $self->{SIDdata}{speed} &= ~(0x1 << ($songnumber-1));

    # Then set it.
    $self->{SIDdata}{speed} |= ($value << ($songnumber-1));
}

sub setMUSPlayer($) {
    my ($self, $MUSplayer) = @_;

    unless (defined($self->{SIDdata}{flags})) {
        confess ("Cannot set this field when SID version is 1!");
        return undef;
    }

    if (($MUSplayer ne 0) and ($MUSplayer ne 1)) {
        confess ("Specified value '$MUSplayer' is invalid!");
        return undef;
    }

    # First, clear the bit in question.
    $self->{SIDdata}{flags} &= ~(0x1 << $MUSPLAYER_OFFSET);

    # Then set it.
    $self->{SIDdata}{flags} |= ($MUSplayer << $MUSPLAYER_OFFSET);
}

sub setPlaySID($) {
    my ($self, $PlaySID) = @_;

    if ($self->isRSID() ) {
        confess ("Cannot set this field for RSID!");
        return undef;
    }

    unless (defined($self->{SIDdata}{flags})) {
        confess ("Cannot set this field when SID version is 1!");
        return undef;
    }

    if (($PlaySID ne 0) and ($PlaySID ne 1)) {
        confess ("Specified value '$PlaySID' is invalid!");
        return undef;
    }

    # First, clear the bit in question.
    $self->{SIDdata}{flags} &= ~(0x1 << $PLAYSID_OFFSET);

    # Then set it.
    $self->{SIDdata}{flags} |= ($PlaySID << $PLAYSID_OFFSET);
}

sub setC64BASIC($) {
    my ($self, $C64BASIC) = @_;

    unless ($self->isRSID() ) {
        confess ("Cannot set this field for PSID!");
        return undef;
    }

    unless (defined($self->{SIDdata}{flags})) {
        confess ("Cannot set this field when SID version is 1!");
        return undef;
    }

    if (($C64BASIC ne 0) and ($C64BASIC ne 1)) {
        confess ("Specified value '$C64BASIC' is invalid!");
        return undef;
    }

    # First, clear the bit in question.
    $self->{SIDdata}{flags} &= ~(0x1 << $C64BASIC_OFFSET);

    # Then set it.
    $self->{SIDdata}{flags} |= ($C64BASIC << $C64BASIC_OFFSET);

    if ($C64BASIC) {
        $self->{SIDdata}{initAddress} = 0;
    }
}

sub setClock($) {
    my ($self, $clock) = @_;

    unless (defined($self->{SIDdata}{flags})) {
        confess ("Cannot set this field when SID version is 1!");
        return undef;
    }

    if (($clock < 0) or ($clock > 3)) {
        confess ("Specified value '$clock' is invalid!");
        return undef;
    }

    # First, clear the bits in question.
    $self->{SIDdata}{flags} &= ~(0x3 << $CLOCK_OFFSET);

    # Then set them.
    $self->{SIDdata}{flags} |= ($clock << $CLOCK_OFFSET);
}

sub setClockByName($) {
    my ($self, $clock) = @_;

    unless (defined($self->{SIDdata}{flags})) {
        confess ("Cannot set this field when SID version is 1!");
        return undef;
    }

    if ($clock =~ /^(unknown|none|neither)$/i) {
        $clock = 0;
    }
    elsif ($clock =~ /^PAL$/i) {
        $clock = 1;
    }
    elsif ($clock =~ /^NTSC$/i) {
        $clock = 2;
    }
    elsif ($clock =~ /^(any|both|either)$/i) {
        $clock = 3;
    }
    else {
        confess ("Specified value '$clock' is invalid!");
        return undef;
    }

    $self->setClock($clock);
}

sub setSIDModel($) {
    my ($self, $SIDModel, $sidNumber) = @_;

    unless (defined($self->{SIDdata}{flags})) {
        confess ("Cannot set this field when SID version is 1!");
        return undef;
    }

    if (($SIDModel < 0) or ($SIDModel > 3)) {
        confess ("Specified value '$SIDModel' is invalid!");
        return undef;
    }

    if (!defined($sidNumber) or ($sidNumber == 1)) {
        # First, clear the bits in question.
        $self->{SIDdata}{flags} &= ~(0x3 << $SIDMODEL_OFFSET);

        # Then set them.
        $self->{SIDdata}{flags} |= ($SIDModel << $SIDMODEL_OFFSET);
    }
    elsif ($sidNumber == 2) {

        return undef unless ($self->{SIDdata}{version} >= 3);

        # First, clear the bits in question.
        $self->{SIDdata}{flags} &= ~(0x3 << $SECOND_SIDMODEL_OFFSET);

        # Then set them.
        $self->{SIDdata}{flags} |= ($SIDModel << $SECOND_SIDMODEL_OFFSET);
    }
    elsif ($sidNumber == 3) {
        return undef unless ($self->{SIDdata}{version} >= 4);

        # First, clear the bits in question.
        $self->{SIDdata}{flags} &= ~(0x3 << $THIRD_SIDMODEL_OFFSET);

        # Then set them.
        $self->{SIDdata}{flags} |= ($SIDModel << $THIRD_SIDMODEL_OFFSET);
    }
}

sub setSIDModelByName($) {
    my ($self, $SIDModel, $sidNumber) = @_;

    unless (defined($self->{SIDdata}{flags})) {
        confess ("Cannot set this field when SID version is 1!");
        return undef;
    }

    if ($SIDModel =~ /^(unknown|none|neither)$/i) {
        $SIDModel = 0;
    }
    elsif (($SIDModel =~ /^6581$/) or ($SIDModel == 6581)) {
        $SIDModel = 1;
    }
    elsif (($SIDModel =~ /^8580$/i) or ($SIDModel == 8580)) {
        $SIDModel = 2;
    }
    elsif ($SIDModel =~ /^(any|both|either)$/i) {
        $SIDModel = 3;
    }
    else {
        confess ("Specified value '$SIDModel' is invalid!");
        return undef;
    }

    return $self->setSIDModel($SIDModel, $sidNumber);
}

sub setSIDAddress($) {
    my ($self, $sidNumber, $fullSIDAddress) = @_;

    if (!defined($sidNumber) or ($sidNumber < 2) or ($sidNumber > 3)) {
        confess("Invalid SID number: '$sidNumber'!");
        return undef;
    }

    if (!defined($fullSIDAddress)) {
        confess("SID address was not specified!");
        return undef;
    }

    if ( (($sidNumber == 2) and ($self->{SIDdata}{version} < 3)) or
         (($sidNumber == 3) and ($self->{SIDdata}{version} < 4))
       ) {
        confess("SID address for SID number '$sidNumber' is not allowed to be set when SID version is $self->{SIDdata}{version} !");
        return undef;
    }

    if ($fullSIDAddress =~ /^\s*\$/) {
        # Convert C64-style hex string to hex number.
        $fullSIDAddress =~ s/^\s*\$//;
        $fullSIDAddress = hex($fullSIDAddress);
    }
    elsif ($fullSIDAddress =~ /^\s*0x/) {
        # Convert hex string to hex number.
        $fullSIDAddress = hex($fullSIDAddress);
    }

    if (($fullSIDAddress < 0xD420) or ($fullSIDAddress > 0xE000) or
        (($fullSIDAddress >= 0xD800) and ($fullSIDAddress < 0xDE00))) {
        confess(sprintf("SID address of '\$%04X' for SID number '%d' is not in the allowed range!", $fullSIDAddress, $sidNumber));
        return undef;
    }

    my $middleSIDAddress = ($fullSIDAddress & 0x0FF0) >> 4;

    if (($middleSIDAddress % 2) != 0) {
        confess(sprintf("The middle 2 digits of the SID address of '\$%04X' for SID number '%d' must be even!", $fullSIDAddress, $sidNumber));
        return undef;
    }

    if ($self->{SIDdata}{version} >= 4) {
        if (($sidNumber == 2) and ($self->{SIDdata}{thirdSIDAddress} == $middleSIDAddress)) {
            confess(sprintf("The SID address of '\$%04X' for SID number '%d' cannot be the same as for SID number 3!", $fullSIDAddress, $sidNumber));
            return undef;
        }

        if (($sidNumber == 3) and ($self->{SIDdata}{secondSIDAddress} == $middleSIDAddress)) {
            confess(sprintf("The SID address of '\$%04X' for SID number '%d' cannot be the same as for SID number 2!", $fullSIDAddress, $sidNumber));
            return undef;
        }
    }

    # If everything checks out, we can finally set the value.

    if ($sidNumber == 2) {
        $self->{SIDdata}{secondSIDAddress} = $middleSIDAddress;
    }
    elsif ($sidNumber == 3) {
        $self->{SIDdata}{thirdSIDAddress} = $middleSIDAddress;
    }
}

sub getFieldNames {
    my $self = shift;
    my (@SIDfields) = @SIDfieldNames;

    return (@SIDfields);
}

sub getMD5 {
    my ($self, $oldMD5) = @_;

    my $md5 = Digest::MD5->new;

    if (($self->{SIDdata}{loadAddress} == 0) and $self->{SIDdata}{data}) {
        $md5->add(substr($self->{SIDdata}{data},2));
    }
    else {
        $md5->add($self->{SIDdata}{data});
    }

    $md5->add(pack("v", $self->{SIDdata}{initAddress}));
    $md5->add(pack("v", $self->{SIDdata}{playAddress}));

    my $songs = $self->{SIDdata}{songs};
    $md5->add(pack("v", $songs));

    my $speed = $self->{SIDdata}{speed};

    for (my $songNo = 1; $songNo <= $songs; $songNo++) {
        my $speedFlag;
        if ($self->isRSID()) {
            $speedFlag = 60;
        }
        else {
            if ($self->getSpeed($songNo) == 1) {
                $speedFlag = 60;
            }
            else {
                $speedFlag = 0;
            }
        }

        $md5->add(pack("C",$speedFlag));
    }

    my $clock = $self->getClock();

    if (($self->{SIDdata}{version} > 1) and ($clock == 2) and !$oldMD5) {
        $md5->add(pack("C",$clock));
    }

    return ($md5->hexdigest);
}

sub alwaysValidateWrite($) {
    my ($self, $setting) = @_;

    $self->{validateWrite} = $setting;
}

sub validate {
    my $self = shift;
    my $field;
    my $MUSPlayer;
    my $PlaySID;
    my $C64BASIC;
    my $clock;
    my $SIDModel;
    my $secondSIDModel;
    my $thirdSIDModel;

    # Change to version v2.
    if ($self->{SIDdata}{version} < 2) {
#        carp ("Changing SID to v2");
        $self->{SIDdata}{version} = 2;
    }

    if ($self->isRSID() ) {
        $self->{SIDdata}{playAddress} = 0;
        $self->{SIDdata}{speed} = 0;
    }

    if ($self->{SIDdata}{dataOffset} != 0x7C) {
        $self->{SIDdata}{dataOffset} = 0x7C;
#        carp ("'dataOffset' was not 0x007C - set to 0x007C");
    }

    # Sanity check the fields.

    # Textual fields can't be longer than 32 chars.
    foreach $field (qw(title author released)) {

        # Strip trailing whitespace.
        $self->{SIDdata}{$field} =~ s/\s+$//;

        # Convert to ISO 8859-1 ASCII.
        $self->{SIDdata}{$field} = encode("latin1", $self->{SIDdata}{$field});

        # Take off any superfluous null-padding.
        $self->{SIDdata}{$field} =~ s/\x00+$//;

        if (length($self->{SIDdata}{$field}) > 32) {
            $self->{SIDdata}{$field} = substr($self->{SIDdata}{$field}, 0, 32);
#            carp ("'$field' field was longer than 32 chars - chopped to 32");
        }
    }

    # If this is an RSID, initAddress shouldn't be pointing to a ROM memory
    # area, or be outside the load range. Also, if the C64 BASIC flag is set,
    # initAddress must be 0.

    if ( ($self->isRSID() ) and
         ( ((($self->{SIDdata}{initAddress} > 0) and ($self->{SIDdata}{initAddress} < 0x07E8)) or
            (($self->{SIDdata}{initAddress} >= 0xA000) and ($self->{SIDdata}{initAddress} < 0xC000)) or
            (($self->{SIDdata}{initAddress} >= 0xD000) and ($self->{SIDdata}{initAddress} <= 0xFFFF)) or
             ($self->{SIDdata}{initAddress} < $self->getRealLoadAddress()) or
             ($self->{SIDdata}{initAddress} > ($self->getRealLoadAddress() + length($self->{SIDdata}{data}) - 3))
           ) or
           ($self->getC64BASIC() )
          )
       ) {

        $self->{SIDdata}{initAddress} = 0;

#        carp ("'initAddress' was invalid - set to 0");
    }

    # The preferred way is for loadAddress to be 0. It also shouldn't be less
    # than 0x07E8 in RSID files. The data is prepended by those 2 bytes if it
    # needs to be changed.

    if ($self->{SIDdata}{loadAddress} != 0) {

        # Load address must not be less than 0x07E8 in RSID files.
        if (($self->isRSID() ) and
            ($self->{SIDdata}{loadAddress} < 0x07E8) ) {

            $self->{SIDdata}{loadAddress} = 0x07E8;
        }

        $self->{SIDdata}{data} = pack("v", $self->{SIDdata}{loadAddress}) . $self->{SIDdata}{data};
        $self->{SIDdata}{loadAddress} = 0;
#        carp ("'loadAddress' was non-zero - set to 0");
    }

    # If this is a PSID, initAddress shouldn't be outside the load range.

    if ( (!$self->isRSID() ) and
         (($self->{SIDdata}{initAddress} < $self->getRealLoadAddress()) or
          ($self->{SIDdata}{initAddress} > ($self->getRealLoadAddress() + length($self->{SIDdata}{data}) - 3))
         )
       ) {

        $self->{SIDdata}{initAddress} = 0;

#        carp ("'initAddress' was invalid - set to 0");
    }

    # These fields should better be in the 0x0000-0xFFFF range!
    foreach $field (qw(loadAddress initAddress playAddress)) {
        if (($self->{SIDdata}{$field} < 0) or ($self->{SIDdata}{$field} > 0xFFFF)) {
#            confess ("'$field' value of $self->{SIDdata}{$field} is out of range");
            $self->{SIDdata}{$field} = 0;
        }
    }

    # These fields should better be in the 0x00-0xFF range!
    foreach $field (qw(startPage pageLength)) {
        if (!defined($self->{SIDdata}{$field}) or ($self->{SIDdata}{$field} < 0) or ($self->{SIDdata}{$field} > 0xFF)) {
#            confess ("'$field' value of $self->{SIDdata}{$field} is out of range");
            $self->{SIDdata}{$field} = 0;
        }
    }

    # This field's max is 256.
    if ($self->{SIDdata}{songs} > 256) {
        $self->{SIDdata}{songs} = 256;
#        carp ("'songs' was more than 256 - set to 256");
    }

    # This field's min is 1.
    if ($self->{SIDdata}{songs} < 1) {
        $self->{SIDdata}{songs} = 1;
#        carp ("'songs' was less than 1 - set to 1");
    }

    # If an invalid startSong is specified, set it to 1.
    if ($self->{SIDdata}{startSong} > $self->{SIDdata}{songs}) {
        $self->{SIDdata}{startSong} = 1;
#        carp ("Invalid 'startSong' field - set to 1");
    }

    unless ($self->isRSID() ) {
        # Only the relevant fields in 'speed' will be set.
        my $tempSpeed = 0;
        my $maxSongs = $self->{SIDdata}{songs};

        # There are only 32 bits in speed.
        if ($maxSongs > 32) {
            $maxSongs = 32;
        }

        for (my $i=0; $i < $maxSongs; $i++) {
            $tempSpeed += ($self->{SIDdata}{speed} & (1 << $i));
        }
        $self->{SIDdata}{speed} = $tempSpeed;
    }

    unless (defined($self->{SIDdata}{flags})) {
        $self->{SIDdata}{flags} = 0;
    }
    else {
        # Only the relevant fields in 'flags' will be set.
        $MUSPlayer = $self->isMUSPlayerRequired();
        $clock = $self->getClock();
        $SIDModel = $self->getSIDModel();
        $secondSIDModel = $self->getSIDModel(2);
        $thirdSIDModel = $self->getSIDModel(3);

        unless ($self->isRSID() ) {
            $PlaySID = $self->isPlaySIDSpecific();
        }
        else {
            $C64BASIC = $self->isC64BASIC();
        }

        $self->{SIDdata}{flags} = 0;

        $self->setMUSPlayer($MUSPlayer);
        $self->setClock($clock);
        $self->setSIDModel($SIDModel);

        if ($self->{SIDdata}{version} >= 3) {
            if (defined($secondSIDModel)) {
                $self->setSIDModel($secondSIDModel, 2);
            }
        }

        if ($self->{SIDdata}{version} >= 4) {
            if (defined($thirdSIDModel)) {
                $self->setSIDModel($thirdSIDModel, 3);
            }
        }

        unless ($self->isRSID() ) {
            $self->setPlaySID($PlaySID);
        }
        else {
            $self->setC64BASIC($C64BASIC);
        }
    }

    if (($self->{SIDdata}{startPage} == 0) or ($self->{SIDdata}{startPage} == 0xFF)) {
        $self->{SIDdata}{pageLength} = 0;
    }
    elsif ((($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1) > 0xFFFF) {
        $self->{SIDdata}{pageLength} = 0xFF - $self->{SIDdata}{startPage};
    }
    elsif ($self->{SIDdata}{pageLength} == 0) {
        $self->{SIDdata}{pageLength} = 1;
    }

    if ($self->isRSID() ) {

        # Reloc info must not overlap or encompass the ROM/IO and
        # reserved memory areas.

        # Is startPage within the ROM or reserved memory areas?
        if ( (($self->{SIDdata}{startPage} >= 0xA0) and ($self->{SIDdata}{startPage} < 0xC0)) or
             (($self->{SIDdata}{startPage} >= 0xD0) and ($self->{SIDdata}{startPage} < 0xFF)) or
             (($self->{SIDdata}{startPage} > 0x00) and ($self->{SIDdata}{startPage} < 0x04)) ) {

             $self->{SIDdata}{startPage} = 0xFF;
             $self->{SIDdata}{pageLength} = 0x00;
        }

        # Is the end of the relocation range within the ROM or reserved memory areas?
        if ( (( ($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 >= 0xA000) and ( ($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 < 0xC000)) or
             (( ($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 >= 0xD000) and ( ($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 <= 0xFFFF)) or
             (( ($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 > 0x0000) and  ( ($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 < 0x0400)) ) {

             $self->{SIDdata}{startPage} = 0xFF;
             $self->{SIDdata}{pageLength} = 0x00;
        }

        # Does the relocation range encompass a ROM area?
        if ( ($self->{SIDdata}{startPage} < 0xA0) and (($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 >= 0xC000) ) {

             $self->{SIDdata}{startPage} = 0xFF;
             $self->{SIDdata}{pageLength} = 0x00;
        }
    }

    # Relocation range must not overlap or encompass the load range.

    if ( (($self->{SIDdata}{startPage} << 8) >= $self->getRealLoadAddress()) and
         (($self->{SIDdata}{startPage} << 8) <= ($self->getRealLoadAddress() + length($self->{SIDdata}{data}) - 3)
         ) ) {

         $self->{SIDdata}{startPage} = 0xFF;
         $self->{SIDdata}{pageLength} = 0x00;
    }

    if ( (($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 >= $self->getRealLoadAddress()) and
         (($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 <= ($self->getRealLoadAddress() + length($self->{SIDdata}{data}) - 3))
       ) {

         $self->{SIDdata}{startPage} = 0xFF;
         $self->{SIDdata}{pageLength} = 0x00;
    }

    if ( (($self->{SIDdata}{startPage} << 8) < $self->getRealLoadAddress()) and
         (($self->{SIDdata}{startPage} << 8) + ($self->{SIDdata}{pageLength} << 8) - 1 > ($self->getRealLoadAddress() + length($self->{SIDdata}{data}) - 3))
       ) {

         $self->{SIDdata}{startPage} = 0xFF;
         $self->{SIDdata}{pageLength} = 0x00;
    }

    $self->{SIDdata}{reserved} = 0;

    if ($self->{SIDdata}{version} >= 3) {
       # The secondSIDAddress field is valid only for v3+.
        my $secondSIDAddress = $self->getSIDAddress(2);

        if ($secondSIDAddress) {
            # This function will also validate the value.
            my $result = $self->setSIDAddress(2, $secondSIDAddress);

            if (!$result) {
                # Value validation failed, set SID address to 0.
                $self->setSIDAddress(2, 0);
            }
        }
    }

    if ($self->{SIDdata}{version} >= 4) {
       # The thirdSIDAddress field is valid only for v4+.
        my $thirdSIDAddress = $self->getSIDAddress(3);

        if ($thirdSIDAddress) {
            # This function will also validate the value.
            my $result = $self->setSIDAddress(3, $thirdSIDAddress);

            if (!$result) {
                # Value validation failed, set SID address to 0.
                $self->setSIDAddress(3, 0);
            }
        }

        $self->{SIDdata}{reserved} = undef;
    }

    # The preferred way is to have no padding between the v2 header and the
    # C64 data.
    if ($self->{PADDING}) {
        $self->{PADDING} = '';
#        carp ("Invalid bytes were between the header and the data - removed them");
    }

    # Recalculate size.
    $self->{FILESIZE} = $self->{SIDdata}{dataOffset} + length($self->{PADDING}) +
        length($self->{SIDdata}{data});
}

1;

__END__