#!perl -w
$|=1;
package BaseAudioFile;
use strict;
sub parsespec { # writer spec
    my ($class, $spec, @params)= @_;


    if ($spec =~ /^(\d+):(\d+):(\d+):(.*?)(?::(\d+))?$/) {
        my ($samplerate, $bitspersample, $channels, $filename, $startoffset)= ($1, $2, $3, $4, $5);

        my %params= (
            samplerate=>$samplerate,
            bitspersample=>$bitspersample,
            channels=>$channels,
            startoffset=>$startoffset||0
        );
        #printf("fmt1: %s with %s %s\n", $class, "@params", join " ", map { "$_=$params{$_}" } keys %params );
        return $class->new($filename, @params, %params);
    }
    elsif ($spec =~ /^(.*?)(?::(\w+=\w+(?:,\w+=\w+)*))?$/) {
        my ($filename, $optionstring)= ($1, $2);
        my %params;
        if ($optionstring) {
            for (split /,/, $optionstring) {
                if (/(\w+)=(\w+)/) {
                    $params{$1}= $2;
                }
            }
        }
        #printf("fmt2: %s with %s %s\n", $class, "@params", join " ", map { "$_=$params{$_}" } keys %params );
        return $class->new($filename, @params, %params);
    }
    else {
        print("fmt3: $class with @params\n");
        return $class->new($spec, @params);
    }
}

##############################################################
##############################################################
package BaseReader;
use strict;
our @ISA= qw(BaseAudioFile);
use IO::File;
sub getreader {
    my ($filename, @params)= @_;

    if ($filename =~ /\.raw/) {
        return RawReader->parsespec($filename, @params);
    }
    elsif ($filename =~ /\.wav/) {
        return WavReader->parsespec($filename, @params);
    }
    else {
        die "unknown filetype: $filename\n";
    }
}
sub readchannel {
    my ($self, $offset, $nsamples, $channel)= @_;

    die "invalid channel nr: $channel\n"
        unless ($channel>=0 || $channel<$self->{channels});

    $self->{fh}->seek($self->{dataoffset} + ($offset+$self->{startoffset})*$self->{bytespersample}, SEEK_SET);
    my $data;
    my $n= $self->{fh}->read($data, $nsamples*$self->{bytespersample});

    die "read error: $!\n"
        if (!defined $n);

    return undef if ($n==0);

    die "file truncated\n"
        if ($n % $self->{bytespersample});

    $nsamples= $n/$self->{bytespersample};

    my @samples= unpack($self->{bitspersample}==8?"c*"
                        :$self->{bitspersample}==16?"s*"
                        :$self->{bitspersample}==32?"l*"
                        :"", $data);

    die "internalerror\n" unless (@samples);

    if ($self->{channels}==1) {
        return \@samples;
    }
    else {
        my @result;
        push @result, $samples[$_*$self->{channels}+$channel] for (0..$nsamples-1);
        return \@result;
    }
}

sub close {
    my ($self)= @_;
    return unless ($self->{fh});
    $self->{fh}->close();
    delete $self->{fh};
}
##############################################################
package RawReader;
use strict;
our @ISA= qw(BaseReader);
use IO::File;

sub new {
    my ($class, $filename, %params)= @_;

    my $fh= IO::File->new($filename, "r") or die "$filename: $!\n";
    binmode $fh;

    die "unsupported nr of bits per sample\n"
        if (!grep {$_==$params{bitspersample}} (8,16,32));

    $params{dataoffset}= 0;
    $params{bytespersample}=$params{channels}*$params{bitspersample}/8;
    my $self= bless {
        startoffset=>0,
        filename=>$filename,
        fh => $fh,
        %params,
    }, $class;

    return $self;
}

##############################################################
package WavReader;
use strict;
our @ISA= qw(BaseReader);
use IO::File;

sub new {
    my ($class, $filename, %params)= @_;

    my $fh= IO::File->new($filename, "r") or die "$filename: $!\n";
    binmode $fh;

    $params{dataoffset}= 0x2c;

    my $self= bless {
        startoffset=>0,
        filename=>$filename,
        fh => $fh,
        %params,
    }, $class;

    $self->readheader();
    return $self;
}

sub readheader {
    my ($self)= @_;
    my $hdrdata;
    $self->{fh}->seek(0, SEEK_SET);
    $self->{fh}->read($hdrdata, 0x2c);

    # 0x00 0 "RIFF"
    # 0x04 1 size of rest of file
    # 0x08 2 "WAVE"
    # 0x0C 3 "fmt "
    # 0x10 4 size of 'fmt' chunk == 0x10
    # 0x14 5 wFormatTag   1=PCM
    # 0x16 6 wChannels
    # 0x18 7 dwSamplesPerSec
    # 0x1C 8 dwAvgBytesPerSec
    # 0x20 9 wBytesPerSample = wChannels*bitspersample/8
    # 0x22 A wBitsPerSample = 
    # 0x24 B "data"
    # 0x28 C size of data chunk
    my @fields= unpack("a4Va4a4VvvVVvva4V", $hdrdata);

    die "$self->{filename}: invalid header: ", join(", ", @fields), "\n"
        unless ($fields[0] eq "RIFF" 
            && $fields[1]==$fields[12]+0x24
            && $fields[2] eq "WAVE"
            && $fields[3] eq "fmt "
            && $fields[4] == 0x10
            && $fields[5] == 1
            && $fields[9] == $fields[6]*$fields[10]/8
            && $fields[8]==$fields[9]*$fields[7]
            && $fields[11] eq "data");
    $self->{channels}= $fields[6];
    $self->{samplerate}= $fields[7];
    $self->{bytespersample}= $fields[9];
    $self->{bitspersample}= $fields[10];

    printf("wav: %d channels, %d bitspersample, %dHz, %d samples\n", 
        $self->{channels}, $self->{bitspersample}, $self->{samplerate},
        $fields[12]/$fields[9]);
    die "unsupported nr of bits per sample\n"
        if (!grep {$_==$self->{bitspersample}} (8,16,32));
}


##############################################################
##############################################################
package BaseWriter;
use strict;
our @ISA= qw(BaseAudioFile);
use IO::File;
use List::Util qw(min max);

sub getwriter {
    my ($filename, @params)= @_;

    if ($filename =~ /\.raw/) {
        return RawWriter->parsespec($filename, @params);
    }
    elsif ($filename =~ /\.wav/) {
        return WavWriter->parsespec($filename, @params);
    }
    else {
        die "unknown filetype: $filename\n";
    }
}
sub writechannels {
    my ($self, $offset, @channels)= @_;

    die "too many channels\n"
        unless (@channels<=$self->{channels});

    my $minsamples= min map { scalar @$_ } @channels;
    my $maxsamples= max map { scalar @$_ } @channels;
    if ($minsamples != $maxsamples) {
        if ($self->{truncate}) {
            $#_= $minsamples-1 for @channels;
        }
        else {
            for my $c (@channels) {
                $_=0 for @$c[@$c..$maxsamples-1];
            }
        }
        $#_= ($self->{truncate}?$minsamples:$maxsamples)-1 for @channels;
    }
    my $nsamples= $self->{truncate}?$minsamples:$maxsamples;

    my @samples;
    if ($self->{channels}==1) {
        @samples= @{$channels[0]};
    }
    else {
        for my $sample (0..$nsamples-1) {
            for my $ch (0..$self->{channels}-1) {
                push @samples, $ch<=$#channels ? $channels[$ch][$sample] : 0;
            }
        }
    }
    my $data= pack($self->{bitspersample}==8?"c*"
                        :$self->{bitspersample}==16?"s*"
                        :$self->{bitspersample}==32?"l*"
                        :"", @samples);

    $self->{fh}->seek($self->{dataoffset} + $offset*$self->{bytespersample}, SEEK_SET);
    $self->{fh}->print($data) or die "writing file: $!\n";
}

##############################################################
package RawWriter;
use strict;
our @ISA= qw(BaseWriter);
use IO::File;

sub new {
    my ($class, $filename, %params)= @_;

    my $fh= IO::File->new($filename, "w") or die "$filename: $!\n";
    binmode $fh;

    die "unsupported nr of bits per sample\n"
        if (!grep {$_==$params{bitspersample}} (8,16,32));

    $params{dataoffset}= 0;
    $params{bytespersample}=$params{channels}*$params{bitspersample}/8;
    my $self= bless {
        filename=>$filename,
        fh => $fh,
        %params,
    }, $class;

    return $self;
}
sub close {
    my ($self)= @_;
    return unless ($self->{fh});
    $self->{fh}->close();
    delete $self->{fh};
}

##############################################################
package WavWriter;
use strict;
our @ISA= qw(RawWriter);
use IO::File;

sub new {
    my ($class, @params)= @_;

    my $self= $class->SUPER::new(@params);
    $self->{dataoffset}= 0x2c;

    $self->writeheader();
    return $self;
}
sub DESTROY {
    my ($self)= @_;
    $self->close();
}
sub close {
    my ($self)= @_;
    return unless ($self->{fh});
    my $offset= $self->{fh}->tell();

    $self->{fh}->seek(4, SEEK_SET);
    $self->{fh}->print(pack("V", $offset-8));

    $self->{fh}->seek(0x28, SEEK_SET);
    $self->{fh}->print(pack("V", $offset-0x2c));

    $self->{fh}->seek(0, SEEK_END);

    $self->SUPER::close();
}
sub writeheader {
    my ($self)= @_;
    my $hdrdata = pack("a4Va4a4VvvVVvva4V", 
        "RIFF", 0x24, "WAVE", "fmt ", 0x10, 1,
        $self->{channels},
        $self->{samplerate},
        $self->{samplerate}*$self->{bytespersample}, 
        $self->{bytespersample},
        $self->{bitspersample},
        "data", 0
    );
    
    $self->{fh}->seek(0, SEEK_SET);
    $self->{fh}->print($hdrdata);
}

package main;
use strict;
use Getopt::Long;

my $truncate= 0;

sub usage {
return <<__EOF__
usage: cvwav [-p] [-t] <infile> [ , <infile> ] <outfile> [ , <outfile> ]
where infile is either a .wav, or a .raw 
specified as: 44100:16:1:filename.raw:0
   or as  filename.ext,keyword=value,...
where keyword is one of: samplerate,bitspersample,channels,startoffset
  -t: truncate to shortest in case of uneven inputs
  -p: pad to longest in case of uneven inputs [DEFAULT]
__EOF__
}
die usage() if (@ARGV==0);

GetOptions(
    "t"=>\$truncate,
    "p"=>sub { $truncate=0; },
) or die usage();

my @innames;
my @outnames;
while (1) {
    push @innames, shift;
    last if (!@ARGV || $ARGV[0] ne ',');
    shift;
}
while (1) {
    push @outnames, shift;
    last if (!@ARGV || $ARGV[0] ne ',');
    shift;
}

if (@innames>1 && @outnames>1) {
    die "either specify multiple input names, or specify multiply output names\n";
}
my @readers= map { BaseReader::getreader($_) } @innames;
my $channels;
if (@outnames>1) {
    # 1 reader: split over multiple writers
    $channels=1;
}
else {
    # 1 writer: combine all readers channels
    $channels=0;
    $channels+= $_->{channels} for (@readers);
}
my @writers= map { BaseWriter::getwriter($_, 
        samplerate=>$readers[0]->{samplerate}, 
        bitspersample=>$readers[0]->{bitspersample}, 
        channels=>$channels,
        truncate=>$truncate,
    ); } @outnames;

my $offset= 0;
my $channeldata;

while (1) {
    my @channeldata;
    for my $reader (@readers) {
        for my $channel (0..$reader->{channels}-1) {
            push @channeldata, $reader->readchannel($offset, 16384, $channel)
        }
    }
    last if grep { !defined $_ } @channeldata;
    for my $writer (@writers) {
        $writer->writechannels($offset, @channeldata[0..$writer->{channels}-1]);
        shift @channeldata for (0..$writer->{channels}-1);
    }
    $offset += 16384;
}
$_->close() for (@writers, @readers);


exit(0);