test/write_iff.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 require Math::BigInt;
   6
   7 my $usage = "
   8 $0 <format> <bps> <channels> <sample-rate> <#samples> <sample-type>
   9
  10      <format> is one of aiff,wave,wave64,rf64
  11         <bps> is 8,16,24,32
  12    <channels> is 1-8
  13 <sample-rate> is any 32-bit value
  14    <#samples> is 0-2^64-1
  15 <sample-type> is one of zero,rand
  16
  17 ";
  18
  19 die $usage unless @ARGV == 6;
  20
  21 my %formats = ( 'aiff'=>1, 'wave'=>1, 'wave64'=>1, 'rf64'=>1 );
  22 my %sampletypes = ( 'zero'=>1, 'rand'=>1 );
  23 my @channelmask = ( 0, 1, 3, 7, 0x33, 0x607, 0x60f, 0, 0 ); #@@@@@@ need proper masks for 7,8
  24
  25 my ($format, $bps, $channels, $samplerate, $samples, $sampletype) = @ARGV;
  26 my $bigsamples = new Math::BigInt $samples;
  27
  28 die $usage unless defined $formats{$format};
  29 die $usage unless $bps == 8 || $bps == 16 || $bps == 24 || $bps == 32;
  30 die $usage unless $channels >= 1 && $channels <= 8;
  31 die $usage unless $samplerate >= 0 && $samplerate <= 4294967295;
  32 die $usage unless defined $sampletypes{$sampletype};
  33
  34 # convert bits-per-sample to bytes-per-sample
  35 $bps /= 8;
  36
  37 my $datasize = $samples * $bps * $channels;
  38 my $bigdatasize = $bigsamples * $bps * $channels;
  39
  40 my $padding = int($bigdatasize & 1); # for aiff/wave/rf64 chunk alignment
  41 my $padding8 = 8 - int($bigdatasize & 7); $padding8 = 0 if $padding8 == 8; # for wave64 alignment
  42 # wave-ish file needs to be WAVEFORMATEXTENSIBLE?
  43 my $wavx = ($format eq 'wave' || $format eq 'wave64' || $format eq 'rf64') && ($channels > 2);
  44
  45 # write header
  46
  47 if ($format eq 'aiff') {
  48         die "sample data too big for format\n" if 46 + $datasize + $padding > 4294967295;
  49         # header
  50         print "FORM";
  51         print pack('N', 46 + $datasize + $padding);
  52         print "AIFF";
  53         # COMM chunk
  54         print "COMM";
  55         print pack('N', 18); # chunk size = 18
  56         print pack('n', $channels);
  57         print pack('N', $samples);
  58         print pack('n', $bps * 8);
  59         print pack_sane_extended($samplerate);
  60         # SSND header
  61         print "SSND";
  62         print pack('N', $datasize + 8); # chunk size
  63         print pack('N', 0); # ssnd_offset_size
  64         print pack('N', 0); # blocksize
  65 }
  66 elsif ($format eq 'wave' || $format eq 'wave64' || $format eq 'rf64') {
  67         die "sample data too big for format\n" if $format eq 'wave' && ($wavx?60:36) + $datasize + $padding > 4294967295;
  68         # header
  69         if ($format eq 'wave') {
  70                 print "RIFF";
  71                 # +4 for WAVE
  72                 # +8+{40,16} for fmt chunk
  73                 # +8 for data chunk header
  74                 print pack('V', 4 + 8+($wavx?40:16) + 8 + $datasize + $padding);
  75                 print "WAVE";
  76         }
  77         elsif ($format eq 'wave64') {
  78                 # RIFF GUID 66666972-912E-11CF-A5D6-28DB04C10000
  79                 print "\x72\x69\x66\x66\x2E\x91\xCF\x11\xD6\xA5\x28\xDB\x04\xC1\x00\x00";
  80                 # +(16+8) for RIFF GUID + size
  81                 # +16 for WAVE GUID
  82                 # +16+8+{40,16} for fmt chunk
  83                 # +16+8 for data chunk header
  84                 my $bigriffsize = $bigdatasize + (16+8) + 16 + 16+8+($wavx?40:16) + (16+8) + $padding8;
  85                 print pack_64('V', $bigriffsize);
  86                 # WAVE GUID 65766177-ACF3-11D3-8CD1-00C04F8EDB8A
  87                 print "\x77\x61\x76\x65\xF3\xAC\xD3\x11\xD1\x8C\x00\xC0\x4F\x8E\xDB\x8A";
  88         }
  89         else {
  90                 print "RF64";
  91                 print pack('V', 0xffffffff);
  92                 print "WAVE";
  93                 # ds64 chunk
  94                 print "ds64";
  95                 print pack('V', 28); # chunk size
  96                 # +4 for WAVE
  97                 # +(8+28) for ds64 chunk
  98                 # +8+{40,16} for fmt chunk
  99                 # +8 for data chunk header
 100                 my $bigriffsize = $bigdatasize + 4 + (8+28) + 8+($wavx?40:16) + 8 + $padding;
 101                 print pack_64('V', $bigriffsize);
 102                 print pack_64('V', $bigdatasize);
 103                 print pack_64('V', $bigsamples);
 104                 print pack('V', 0); # table size
 105         }
 106         # fmt chunk
 107         if ($format ne 'wave64') {
 108                 print "fmt ";
 109                 print pack('V', $wavx?40:16); # chunk size
 110         }
 111         else { # wave64
 112                 # fmt GUID 20746D66-ACF3-11D3-8CD1-00C04F8EDB8A
 113                 print "\x66\x6D\x74\x20\xF3\xAC\xD3\x11\xD1\x8C\x00\xC0\x4F\x8E\xDB\x8A";
 114                 print pack('V', 16+8+($wavx?40:16)); # chunk size (+16+8 for GUID and size fields)
 115                 print pack('V', 0);                  # ...is 8 bytes for wave64
 116         }
 117         print pack('v', $wavx?65534:1); # compression code
 118         print pack('v', $channels);
 119         print pack('V', $samplerate);
 120         print pack('V', $samplerate * $channels * $bps);
 121         print pack('v', $channels * $bps); # block align = channels*((bps+7)/8)
 122         print pack('v', $bps * 8); # bits per sample = ((bps+7)/8)*8
 123         if ($wavx) {
 124                 print pack('v', 22); # cbSize
 125                 print pack('v', $bps * 8); # validBitsPerSample
 126                 print pack('V', $channelmask[$channels]);
 127                 # GUID = {0x00000001, 0x0000, 0x0010, {0x80, 0x00, 0x00, 0xaa, 0x00, 0x38, 0x9b, 0x71}}
 128                 print "\x01\x00\x00\x00\x00\x00\x10\x00\x80\x00\x00\xaa\x00\x38\x9b\x71";
 129         }
 130         # data header
 131         if ($format ne 'wave64') {
 132                 print "data";
 133                 print pack('V', $format eq 'wave'? $datasize : 0xffffffff);
 134         }
 135         else { # wave64
 136                 # data GUID 61746164-ACF3-11D3-8CD1-00C04F8EDB8A
 137                 print "\x64\x61\x74\x61\xF3\xAC\xD3\x11\xD1\x8C\x00\xC0\x4F\x8E\xDB\x8A";
 138                 print pack_64('V', $bigdatasize+16+8); # +16+8 for GUID and size fields
 139         }
 140 }
 141 else {
 142         die;
 143 }
 144
 145 # write sample data
 146
 147 if ($sampletype eq 'zero') {
 148         my $chunk = 4096;
 149         my $buf = pack("x[".($channels*$bps*$chunk)."]");
 150         for (my $s = $samples; $s > 0; $s -= $chunk) {
 151                 if ($s < $chunk) {
 152                         print substr($buf, 0, $channels*$bps*$s);
 153                 }
 154                 else {
 155                         print $buf;
 156                 }
 157         }
 158 }
 159 elsif ($sampletype eq 'rand') {
 160         for (my $s = 0; $s < $samples; $s++) {
 161                 for (my $c = 0; $c < $channels; $c++) {
 162                         for (my $b = 0; $b < $bps; $b++) {
 163                                 print pack('C', int(rand(256)));
 164                         }
 165                 }
 166         }
 167 }
 168 else {
 169         die;
 170 }
 171
 172 # write padding
 173 if ($format eq 'wave64') {
 174         print pack("x[$padding8]") if $padding8;
 175 }
 176 else {
 177         print "\x00" if $padding;
 178 }
 179
 180 exit 0;
 181
 182 sub pack_sane_extended
 183 {
 184         my $val = shift;
 185         die unless $val > 0;
 186         my $shift;
 187         for ($shift = 0; ($val>>(31-$shift)) == 0; ++$shift) {
 188         }
 189         $val <<= $shift;
 190         my $exponent = 63 - ($shift + 32);
 191         return pack('nNN', $exponent + 16383, $val, 0);
 192 }
 193
 194 sub pack_64
 195 {
 196         my $c = shift; # 'N' for big-endian, 'V' for little-endian, ala pack()
 197         my $v1 = shift; # value, must be Math::BigInt
 198         my $v2 = $v1->copy();
 199         if ($c eq 'V') {
 200                 $v1->band(0xffffffff);
 201                 $v2->brsft(32);
 202         }
 203         elsif ($c eq 'N') {
 204                 $v2->band(0xffffffff);
 205                 $v1->brsft(32);
 206         }
 207         else {
 208                 die;
 209         }
 210         return pack("$c$c", 0+$v1->bstr(), 0+$v2->bstr());
 211 }