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