1#!/usr/bin/perl -w 2 3use strict; 4 5require Math::BigInt; 6 7my $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 19die $usage unless @ARGV == 6; 20 21my %formats = ( 'aiff'=>1, 'wave'=>1, 'wave64'=>1, 'rf64'=>1 ); 22my %sampletypes = ( 'zero'=>1, 'rand'=>1 ); 23my @channelmask = ( 0, 1, 3, 7, 0x33, 0x607, 0x60f, 0, 0 ); #@@@@@@ need proper masks for 7,8 24 25my ($format, $bps, $channels, $samplerate, $samples, $sampletype) = @ARGV; 26my $bigsamples = new Math::BigInt $samples; 27 28die $usage unless defined $formats{$format}; 29die $usage unless $bps == 8 || $bps == 16 || $bps == 24 || $bps == 32; 30die $usage unless $channels >= 1 && $channels <= 8; 31die $usage unless $samplerate >= 0 && $samplerate <= 4294967295; 32die $usage unless defined $sampletypes{$sampletype}; 33 34# convert bits-per-sample to bytes-per-sample 35$bps /= 8; 36 37my $datasize = $samples * $bps * $channels; 38my $bigdatasize = $bigsamples * $bps * $channels; 39 40my $padding = int($bigdatasize & 1); # for aiff/wave/rf64 chunk alignment 41my $padding8 = 8 - int($bigdatasize & 7); $padding8 = 0 if $padding8 == 8; # for wave64 alignment 42# wave-ish file needs to be WAVEFORMATEXTENSIBLE? 43my $wavx = ($format eq 'wave' || $format eq 'wave64' || $format eq 'rf64') && ($channels > 2 || ($bps != 8 && $bps != 16)); 44 45# write header 46 47if ($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} 66elsif ($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} 141else { 142 die; 143} 144 145# write sample data 146 147if ($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} 159elsif ($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} 168else { 169 die; 170} 171 172# write padding 173if ($format eq 'wave64') { 174 print pack("x[$padding8]") if $padding8; 175} 176else { 177 print "\x00" if $padding; 178} 179 180exit 0; 181 182sub 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 194sub 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} 212