ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PDL-Audio/audio.pd
(Generate patch)

Comparing PDL-Audio/audio.pd (file contents):
Revision 1.3 by root, Tue Dec 28 01:39:43 2004 UTC vs.
Revision 1.8 by root, Tue Nov 8 18:48:47 2005 UTC

1$VERSION = '1.01'; 1$VERSION = '1.1';
2 2
3pp_setversion $VERSION; 3pp_setversion $VERSION;
4pp_beginwrap (); # force error with older PPs 4pp_beginwrap (); # force error with older PPs
5 5
6pp_addpm {At => Top}, <<'EOD'; 6pp_addpm {At => Top}, <<'EOD';
… …
13 use PDL; 13 use PDL;
14 use PDL::Audio; 14 use PDL::Audio;
15 15
16=head1 DESCRIPTION 16=head1 DESCRIPTION
17 17
18Oh well ;) Not much "introductury documentation" has been written yet! See 18Oh well ;) Not much "introductory documentation" has been written yet :(
19my other modules for even worse documentation ;)
20 19
21=head2 NOTATION 20=head2 NOTATION
22 21
23Brackets around parameters indicate that the respective parameter is 22Brackets around parameters indicate that the respective parameter is
24optional and will be replaced with some default value when absent (or 23optional and will be replaced with some default value when absent (or
… …
276 275
277=cut 276=cut
278 277
279sub describe_audio($) { 278sub describe_audio($) {
280 my $pdl = shift; 279 my $pdl = shift;
281 my ($samples, $channels) = $pdl->dims; 280 my ($channels, $samples) = $pdl->dims;
282 my $chan = $channels < 2 ? "mono" : 281 my $chan = $channels < 2 ? "mono" :
283 $channels == 2 ? "stereo" : 282 $channels == 2 ? "stereo" :
284 $channels == 4 ? "quad channel" : 283 $channels == 4 ? "quad channel" :
285 "$channel channel"; 284 "$channels channel";
286 my $desc = "$chan sound with $samples samples"; 285 my $desc = "$chan sound with $samples samples";
287 $desc .= sprintf ", original name \"%s\"", $pdl->path if $pdl->path; 286 $desc .= sprintf ", original name \"%s\"", $pdl->path if $pdl->path;
288 $desc .= sprintf ", type %d (%s)", $pdl->filetype, sound_type_name($pdl->filetype) if $pdl->filetype; 287 $desc .= sprintf ", type %d (%s)", $pdl->filetype, sound_type_name($pdl->filetype) if $pdl->filetype;
289 $desc .= sprintf ", rate %d/s (duration %.2fs)", $pdl->rate, $samples/$pdl->rate if $pdl->rate; 288 $desc .= sprintf ", rate %d/s (duration %.2fs)", $pdl->rate, $samples/$pdl->rate if $pdl->rate;
290 $desc .= sprintf ", format %d (%s)", $pdl->format, sound_format_name($pdl->format) if $pdl->format; 289 $desc .= sprintf ", format %d (%s)", $pdl->format, sound_format_name($pdl->format) if $pdl->format;
291 $desc; 290 $desc
292} 291}
293 292
294=head2 raudio path, [option-hash], option => value, ... 293=head2 raudio path, [option-hash], option => value, ...
295 294
296Reads audio data into the piddle. Options can be anything, most useful values are 295Reads audio data into the piddle. Options can be anything, most useful
297C<filetype>, C<rate>, C<channels> and C<format>. 296values are C<filetype>, C<rate>, C<channels> and C<format>. The returned
297piddle is represents "time" in the outer dimension, and samples in the
298inner (i.e. scalars for mono files, 2-vectors for stereo files).
298 299
299 # read any file 300 # read any file
300 $pdl = raudio "file.wav"; 301 $pdl = raudio "file.wav";
301 # read a file. if it is a raw file preset values 302 # read a file. if it is a raw file preset values
302 $pdl = raudio "file.raw", filetype => FILE_RAW, rate => 44100, channels => 2; 303 $pdl = raudio "file.raw", filetype => FILE_RAW, rate => 44100, channels => 2;
… …
304=head2 waudio pdl, [option-hash], option => value, ... 305=head2 waudio pdl, [option-hash], option => value, ...
305 306
306Writes a pdl as a file. The path is taken from the header (or the options), e.g.: 307Writes a pdl as a file. The path is taken from the header (or the options), e.g.:
307 308
308 # write a file, using the header of another piddle 309 # write a file, using the header of another piddle
309 $pdl->waudio($orig_file->gethdr); 310 $pdl->waudio ($orig_file->gethdr);
310 # write pdl as au file, take rate from the header 311 # write pdl as au file, take rate from the header
311 $pdl->waudio(path => "piddle.au", filetype => FILE_AU, format => FORMAT_16_LINEAR; 312 $pdl->waudio (path => "piddle.au", filetype => FILE_AU, format => FORMAT_16_LINEAR;
312 313
313=cut 314=cut
314 315
315# read a sound file 316# read a sound file
316sub raudio { 317sub raudio {
… …
339 (close_sound_input $fd) >= 0 or barf "$path: ".audio_error_name audio_error; 340 (close_sound_input $fd) >= 0 or barf "$path: ".audio_error_name audio_error;
340 $pdl = $pdl->short->xchg(0,1); 341 $pdl = $pdl->short->xchg(0,1);
341 $pdl = $pdl->clump(2) if $channels == 1; 342 $pdl = $pdl->clump(2) if $channels == 1;
342 $pdl->sever; 343 $pdl->sever;
343 $pdl->sethdr(\%hdr); 344 $pdl->sethdr(\%hdr);
344 $pdl; 345 $pdl
345} 346}
346 347
347sub _audio_make_plain { 348sub _audio_make_plain {
348 my $pdl = shift; 349 my $pdl = shift;
349 if ($pdl->getndims == 1) { 350 if ($pdl->getndims == 1) {
350 ($pdl, 1, $pdl->getdim(0)); 351 ($pdl, 1, $pdl->getdim(0))
351 } else { 352 } else {
352 ($pdl->xchg(0,1)->clump(-1), ($pdl->dims)[1,0]); 353 ($pdl->xchg(0,1)->clump(-1), $pdl->dims)
353 } 354 }
354} 355}
355 356
356sub waudio { 357sub waudio {
357 my $pdl = shift; 358 my $pdl = shift;
… …
362 $hdr{format} ||= FORMAT_16_LINEAR; 363 $hdr{format} ||= FORMAT_16_LINEAR;
363 $hdr{rate} ||= 44100; 364 $hdr{rate} ||= 44100;
364 365
365 ($pdl, $channels, $frames) = _audio_make_plain $pdl->convert(long); 366 ($pdl, $channels, $frames) = _audio_make_plain $pdl->convert(long);
366 367
368 1 <= $channels && $channels <= 2
369 or croak "can only write mono or stereo (one or two channel) files, not $channels channel files\n";
370
367 my $fd = open_sound_output $hdr{path}, $hdr{rate}, $channels, $hdr{format}, $hdr{filetype}, $hdr{comment}; 371 my $fd = open_sound_output $hdr{path}, $hdr{rate}, $channels, $hdr{format}, $hdr{filetype}, $hdr{comment};
368 $fd >= 0 or barf "$hdr{$path}: ".audio_error_name audio_error; 372 $fd >= 0 or barf "$hdr{$path}: ".audio_error_name audio_error;
369 $pdl->clump(-1)->write_sound($fd, $channels, $frames) 373 $pdl->clump(-1)->write_sound($fd, $channels, $frames)
370 >= 0 or barf "$path: ".audio_error_name audio_error; 374 >= 0 or barf "$path: ".audio_error_name audio_error;
371 (close_sound_output $fd, mus_samples2bytes $hdr{format}, $frames) 375 (close_sound_output $fd, mus_samples2bytes $hdr{format}, $frames * $channels)
372 >= 0 or barf "$hdr{$path}: ".audio_error_name audio_error; 376 >= 0 or barf "$hdr{$path}: ".audio_error_name audio_error;
373} 377}
374 378
375=head2 cut_leading_silence pdl, level 379=head2 cut_leading_silence pdl, level
376 380
… …
391sub cut_leading_silence { 395sub cut_leading_silence {
392 my $pdl = shift; 396 my $pdl = shift;
393 my $level = 1*shift; 397 my $level = 1*shift;
394 my $skip = which (abs($pdl) > $level); 398 my $skip = which (abs($pdl) > $level);
395 $skip = $skip->nelem ? $skip->at(0) : 0; 399 $skip = $skip->nelem ? $skip->at(0) : 0;
396 $pdl->slice("$skip:-1"); 400 $pdl->slice("$skip:-1")
397} 401}
398 402
399sub cut_trailing_silence { 403sub cut_trailing_silence {
400 my $pdl = shift; 404 my $pdl = shift;
401 my $level = 1*shift; 405 my $level = 1*shift;
402 $level = 400000; 406 $level = 400000;
403 my $skip = which (abs($pdl) > $level); 407 my $skip = which (abs($pdl) > $level);
404 $skip = $skip->nelem ? $skip->at(-1) : -1; 408 $skip = $skip->nelem ? $skip->at(-1) : -1;
405 $skip-- if $skip > 0; 409 $skip-- if $skip > 0;
406 $pdl->slice("0:$skip"); 410 $pdl->slice("0:$skip")
407} 411}
408 412
409sub cut_silence { 413sub cut_silence {
410 $_[0]->cut_leading_silence($_[1]) 414 $_[0]->cut_leading_silence($_[1])
411 ->cut_trailing_silence($_[1]); 415 ->cut_trailing_silence($_[1])
412} 416}
413 417
414# have we been a bad boy? 418# have we been a bad boy?
415 419
416for (@METHODS) { 420for (@METHODS) {
… …
753in C<table>, linearly interpolating between successive points of the 757in C<table>, linearly interpolating between successive points of the
754C<waveform>. 758C<waveform>.
755 759
756=head2 partials2waveshape size*, partials, amplitudes, [phase], [fm_mod/] 760=head2 partials2waveshape size*, partials, amplitudes, [phase], [fm_mod/]
757 761
758Take a list (perl list or pdl) of (integer) C<partials> and a list of 762Take a (perl or pdl) list of (integer) C<partials> and a list of
759C<amplitudes> and generate a single wave shape that results by adding 763C<amplitudes> and generate a single wave shape that results by adding
760these partial sines. 764these partial sines.
761 765
762This could (and should) be used by the C<gen_from_table> generator. 766This could (and should) be used by the C<gen_from_table> generator.
763 767
764=head2 gen_from_partials duration*, frequency/, partials, amplitudes, [phase], [fm_mod/] 768=head2 gen_from_partials duration*, frequency/, partials, amplitudes, [phase], [fm_mod/]
765 769
766Take a list (perl list or pdl) of (possibly noninteger) C<partials> and a 770Take a (perl list or pdl) list of (possibly noninteger) C<partials> and a
767list of C<amplitudes> and generate the waveform resulting by summing up 771list of C<amplitudes> and generate the waveform resulting by summing up
768all these partial sines. 772all these partial sines.
769 773
770=cut 774=cut
771 775
… …
1209Calculates the optimal (in the Chebyshev/minimax sense) FIR filter 1213Calculates the optimal (in the Chebyshev/minimax sense) FIR filter
1210impulse response given a set of band edges, the desired reponse on those 1214impulse response given a set of band edges, the desired reponse on those
1211bands, and the weight given to the error in those bands, using the 1215bands, and the weight given to the error in those bands, using the
1212Parks-McClellan exchange algorithm. 1216Parks-McClellan exchange algorithm.
1213 1217
1214The first argument (the one with the funny name) sets the filter 1218The first argument sets the filter size: C<design_remez_fir> returns as
1215size: C<design_remez_fir> returns as many coefficients as specified via 1219many coefficients as specified by this parameter.
1216this parameter.
1217 1220
1218C<bands> is a vector of band edge pairs (start - end), who specify the 1221C<bands> is a vector of band edge pairs (start - end), which specify the
1219start and end of the bands in the filter specification. These must be 1222start and end of the bands in the filter specification. These must be
1220non-overlapping and sorted in increasing order. Only values between C<0> 1223non-overlapping and sorted in increasing order. Only values between C<0>
1221(0 Hz) and C<0.5> (the Nyquist frequency) are allowed. 1224(0 Hz) and C<0.5> (the Nyquist frequency) are allowed.
1222 1225
1223C<des> specifies the desired gain in these bands. 1226C<des> specifies the desired gain in these bands.
… …
1500 $beta = 2.5 unless defined $beta; 1503 $beta = 2.5 unless defined $beta;
1501 1504
1502 $size = $size->getdim(0) if ref $size; 1505 $size = $size->getdim(0) if ref $size;
1503 $size > 2 or barf "fft window size too small"; 1506 $size > 2 or barf "fft window size too small";
1504 1507
1505 my $midn = $size >> 1; 1508 my $midn = $size >> 1;
1506 my $midm1 = ($size-1) >> 1; 1509 my $midm1 = ($size-1) >> 1;
1507 my $midp1 = ($size+1) >> 1; 1510 my $midp1 = ($size+1) >> 1;
1508 my $dur = zeroes $size; 1511 my $dur = zeroes $size;
1509 my $sf = ($size-1)/$size; 1512 my $sf = ($size-1)/$size;
1510 %fft_window = ( 1513 %fft_window = (
1511 RECTANGULAR => sub { 1514 RECTANGULAR => sub {
1512 $dur->ones 1515 $dur->ones
1513 }, 1516 },
… …
1653 1656
1654=head2 spectrum data, [norm], [window], [beta] 1657=head2 spectrum data, [norm], [window], [beta]
1655 1658
1656Returns the spectrum of a given pdl. If C<norm> is absent (or C<undef>), 1659Returns the spectrum of a given pdl. If C<norm> is absent (or C<undef>),
1657it returns the magnitude of the fft of C<data>. When C<norm> == 1 (or 1660it returns the magnitude of the fft of C<data>. When C<norm> == 1 (or
1658C<eq 'NORM'>, in any case), it returns the magnitude, normalized to be 1661C<eq 'NORM'>, case-insensitive), it returns the magnitude, normalized to be
1659between zero and one. If C<norm> == 0 (or C<eq 'dB'>, in any case), then 1662between zero and one. If C<norm> == 0 (or C<eq 'dB'>, case-insensitive), then
1660it returns the magnitude in dB. 1663it returns the magnitude in dB.
1661 1664
1662C<data> is multiplied with C<window> (if not C<undef>) before calculating 1665C<data> is multiplied with C<window> (if not C<undef>) before calculating
1663the fft, and usually contains a window created with C<gen_fft_window> 1666the fft, and usually contains a window created with C<gen_fft_window>
1664(using C<beta>). If C<window> is a string, it is handed over to 1667(using C<beta>). If C<window> is a string, it is handed over to
… …
1671 1674
1672sub spectrum { 1675sub spectrum {
1673 my ($data, $norm, $window, $beta) = @_; 1676 my ($data, $norm, $window, $beta) = @_;
1674 my $len; 1677 my $len;
1675 if (defined $window) { 1678 if (defined $window) {
1676 $window = gen_fft_window ($data->getdim(0), $window, $beta) unless ref $window; 1679 $window = gen_fft_window ($data->getdim (0), $window, $beta) unless ref $window;
1677 $data = $data * $window; 1680 $data = $data * $window;
1678 $len = $window->getdim(0); 1681 $len = $window->getdim (0);
1679 } else { 1682 } else {
1680 $len = $data->getdim(0); 1683 $len = $data->getdim (0);
1681 } 1684 }
1682 $data = rfft ($data->slice("0:".($len-1))->sever)->slice(",0:".int($len/2))->Cr2p->slice("(0)"); 1685 $data = rfft (
1686 $data->slice ("0:" . ($len - 1))
1687 ->sever
1688 )
1689 ->slice (",0:" . int ($len / 2))
1690 ->PDL::Complex::Cr2p
1691 ->slice ("(0)");
1683 if ($norm == 1 || lc $norm eq "norm") { 1692 if ($norm == 1 || lc $norm eq "norm") {
1684 $data / max $data; 1693 $data / max $data;
1685 } elsif (($norm =~ /^[.0]+$/) || (lc $norm eq "db")) { 1694 } elsif (($norm =~ /^[.0]+$/) || (lc $norm eq "db")) {
1686 log (1e-37 + $data / max $data) * (20 / log 10); 1695 log (1e-37 + $data / max $data) * (20 / log 10);
1687 } else { 1696 } else {
… …
1885 1894
1886pp_addpm {At => Bot}, <<'EOD'; 1895pp_addpm {At => Bot}, <<'EOD';
1887 1896
1888=head1 AUTHOR 1897=head1 AUTHOR
1889 1898
1890Marc Lehmann <pcg@goof.com>. The ideas were mostly taken from common 1899Marc Lehmann <schmorp@schmorp.de>. The ideas were mostly taken from common
1891lisp music (CLM), by Bill Schottstaedt C<bil@ccrma.stanford.edu>. I also 1900lisp music (CLM), by Bill Schottstaedt C<bil@ccrma.stanford.edu>. I also
1892borrowed many explanations (and references) from the clm docs and some 1901borrowed many explanations (and references) from the clm docs and some
1893code from clm.c. Highly inspiring! 1902code from clm.c. Highly inspiring!
1894 1903
1895=head1 SEE ALSO 1904=head1 SEE ALSO

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines