1 | $VERSION = '1.01'; |
1 | $VERSION = '1.1'; |
2 | |
2 | |
3 | pp_setversion $VERSION; |
3 | pp_setversion $VERSION; |
4 | pp_beginwrap (); # force error with older PPs |
4 | pp_beginwrap (); # force error with older PPs |
5 | |
5 | |
6 | pp_addpm {At => Top}, <<'EOD'; |
6 | pp_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 | |
18 | Oh well ;) Not much "introductury documentation" has been written yet! See |
18 | Oh well ;) Not much "introductory documentation" has been written yet :( |
19 | my other modules for even worse documentation ;) |
|
|
20 | |
19 | |
21 | =head2 NOTATION |
20 | =head2 NOTATION |
22 | |
21 | |
23 | Brackets around parameters indicate that the respective parameter is |
22 | Brackets around parameters indicate that the respective parameter is |
24 | optional and will be replaced with some default value when absent (or |
23 | optional and will be replaced with some default value when absent (or |
… | |
… | |
276 | |
275 | |
277 | =cut |
276 | =cut |
278 | |
277 | |
279 | sub describe_audio($) { |
278 | sub 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 | |
296 | Reads audio data into the piddle. Options can be anything, most useful values are |
295 | Reads audio data into the piddle. Options can be anything, most useful |
297 | C<filetype>, C<rate>, C<channels> and C<format>. |
296 | values are C<filetype>, C<rate>, C<channels> and C<format>. The returned |
|
|
297 | piddle is represents "time" in the outer dimension, and samples in the |
|
|
298 | inner (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 | |
306 | Writes a pdl as a file. The path is taken from the header (or the options), e.g.: |
307 | Writes 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 |
316 | sub raudio { |
317 | sub 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 | |
347 | sub _audio_make_plain { |
348 | sub _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 | |
356 | sub waudio { |
357 | sub 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 | |
… | |
… | |
391 | sub cut_leading_silence { |
395 | sub 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 | |
399 | sub cut_trailing_silence { |
403 | sub 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 | |
409 | sub cut_silence { |
413 | sub 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 | |
416 | for (@METHODS) { |
420 | for (@METHODS) { |
… | |
… | |
753 | in C<table>, linearly interpolating between successive points of the |
757 | in C<table>, linearly interpolating between successive points of the |
754 | C<waveform>. |
758 | C<waveform>. |
755 | |
759 | |
756 | =head2 partials2waveshape size*, partials, amplitudes, [phase], [fm_mod/] |
760 | =head2 partials2waveshape size*, partials, amplitudes, [phase], [fm_mod/] |
757 | |
761 | |
758 | Take a list (perl list or pdl) of (integer) C<partials> and a list of |
762 | Take a (perl or pdl) list of (integer) C<partials> and a list of |
759 | C<amplitudes> and generate a single wave shape that results by adding |
763 | C<amplitudes> and generate a single wave shape that results by adding |
760 | these partial sines. |
764 | these partial sines. |
761 | |
765 | |
762 | This could (and should) be used by the C<gen_from_table> generator. |
766 | This 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 | |
766 | Take a list (perl list or pdl) of (possibly noninteger) C<partials> and a |
770 | Take a (perl list or pdl) list of (possibly noninteger) C<partials> and a |
767 | list of C<amplitudes> and generate the waveform resulting by summing up |
771 | list of C<amplitudes> and generate the waveform resulting by summing up |
768 | all these partial sines. |
772 | all these partial sines. |
769 | |
773 | |
770 | =cut |
774 | =cut |
771 | |
775 | |
… | |
… | |
1209 | Calculates the optimal (in the Chebyshev/minimax sense) FIR filter |
1213 | Calculates the optimal (in the Chebyshev/minimax sense) FIR filter |
1210 | impulse response given a set of band edges, the desired reponse on those |
1214 | impulse response given a set of band edges, the desired reponse on those |
1211 | bands, and the weight given to the error in those bands, using the |
1215 | bands, and the weight given to the error in those bands, using the |
1212 | Parks-McClellan exchange algorithm. |
1216 | Parks-McClellan exchange algorithm. |
1213 | |
1217 | |
1214 | The first argument (the one with the funny name) sets the filter |
1218 | The first argument sets the filter size: C<design_remez_fir> returns as |
1215 | size: C<design_remez_fir> returns as many coefficients as specified via |
1219 | many coefficients as specified by this parameter. |
1216 | this parameter. |
|
|
1217 | |
1220 | |
1218 | C<bands> is a vector of band edge pairs (start - end), who specify the |
1221 | C<bands> is a vector of band edge pairs (start - end), which specify the |
1219 | start and end of the bands in the filter specification. These must be |
1222 | start and end of the bands in the filter specification. These must be |
1220 | non-overlapping and sorted in increasing order. Only values between C<0> |
1223 | non-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 | |
1223 | C<des> specifies the desired gain in these bands. |
1226 | C<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 | }, |
… | |
… | |
1626 | |
1629 | |
1627 | sub rfft { |
1630 | sub rfft { |
1628 | my $data = $_[0]; |
1631 | my $data = $_[0]; |
1629 | if (_fftw) { |
1632 | if (_fftw) { |
1630 | my $x = $data->r2C; |
1633 | my $x = $data->r2C; |
1631 | $x = PDL::FFTW::nfftw $x; |
1634 | $x = PDL::FFTW::fftw $x; |
1632 | $x; |
1635 | $x; |
1633 | } else { |
1636 | } else { |
1634 | require PDL::FFT; |
1637 | require PDL::FFT; |
1635 | my @fft = ($data->copy, $data->zeroes); |
1638 | my @fft = ($data->copy, $data->zeroes); |
1636 | PDL::FFT::fft(@fft); |
1639 | PDL::FFT::fft(@fft); |
… | |
… | |
1639 | } |
1642 | } |
1640 | |
1643 | |
1641 | sub irfft { |
1644 | sub irfft { |
1642 | if (_fftw) { |
1645 | if (_fftw) { |
1643 | $x = $_[0]->copy; |
1646 | $x = $_[0]->copy; |
1644 | $x = PDL::FFTW::infftw $x; |
1647 | $x = PDL::FFTW::ifftw $x; |
1645 | re $x / $x->getdim(1); |
1648 | re $x / $x->getdim(1); |
1646 | } else { |
1649 | } else { |
1647 | require PDL::FFT; |
1650 | require PDL::FFT; |
1648 | my @fft = $_[0]->xchg(0,1)->dog({Break => 1}); |
1651 | my @fft = $_[0]->xchg(0,1)->dog({Break => 1}); |
1649 | PDL::FFT::ifft(@fft); |
1652 | PDL::FFT::ifft(@fft); |
… | |
… | |
1653 | |
1656 | |
1654 | =head2 spectrum data, [norm], [window], [beta] |
1657 | =head2 spectrum data, [norm], [window], [beta] |
1655 | |
1658 | |
1656 | Returns the spectrum of a given pdl. If C<norm> is absent (or C<undef>), |
1659 | Returns the spectrum of a given pdl. If C<norm> is absent (or C<undef>), |
1657 | it returns the magnitude of the fft of C<data>. When C<norm> == 1 (or |
1660 | it returns the magnitude of the fft of C<data>. When C<norm> == 1 (or |
1658 | C<eq 'NORM'>, in any case), it returns the magnitude, normalized to be |
1661 | C<eq 'NORM'>, case-insensitive), it returns the magnitude, normalized to be |
1659 | between zero and one. If C<norm> == 0 (or C<eq 'dB'>, in any case), then |
1662 | between zero and one. If C<norm> == 0 (or C<eq 'dB'>, case-insensitive), then |
1660 | it returns the magnitude in dB. |
1663 | it returns the magnitude in dB. |
1661 | |
1664 | |
1662 | C<data> is multiplied with C<window> (if not C<undef>) before calculating |
1665 | C<data> is multiplied with C<window> (if not C<undef>) before calculating |
1663 | the fft, and usually contains a window created with C<gen_fft_window> |
1666 | the 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 | |
1672 | sub spectrum { |
1675 | sub 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 | |
1886 | pp_addpm {At => Bot}, <<'EOD'; |
1895 | pp_addpm {At => Bot}, <<'EOD'; |
1887 | |
1896 | |
1888 | =head1 AUTHOR |
1897 | =head1 AUTHOR |
1889 | |
1898 | |
1890 | Marc Lehmann <pcg@goof.com>. The ideas were mostly taken from common |
1899 | Marc Lehmann <schmorp@schmorp.de>. The ideas were mostly taken from common |
1891 | lisp music (CLM), by Bill Schottstaedt C<bil@ccrma.stanford.edu>. I also |
1900 | lisp music (CLM), by Bill Schottstaedt C<bil@ccrma.stanford.edu>. I also |
1892 | borrowed many explanations (and references) from the clm docs and some |
1901 | borrowed many explanations (and references) from the clm docs and some |
1893 | code from clm.c. Highly inspiring! |
1902 | code from clm.c. Highly inspiring! |
1894 | |
1903 | |
1895 | =head1 SEE ALSO |
1904 | =head1 SEE ALSO |