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.7 by root, Thu Mar 3 17:36:58 2005 UTC vs.
Revision 1.8 by root, Tue Nov 8 18:48:47 2005 UTC

1$VERSION = '1.011'; 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';
… …
275 275
276=cut 276=cut
277 277
278sub describe_audio($) { 278sub describe_audio($) {
279 my $pdl = shift; 279 my $pdl = shift;
280 my ($samples, $channels) = $pdl->dims; 280 my ($channels, $samples) = $pdl->dims;
281 my $chan = $channels < 2 ? "mono" : 281 my $chan = $channels < 2 ? "mono" :
282 $channels == 2 ? "stereo" : 282 $channels == 2 ? "stereo" :
283 $channels == 4 ? "quad channel" : 283 $channels == 4 ? "quad channel" :
284 "$channel channel"; 284 "$channels channel";
285 my $desc = "$chan sound with $samples samples"; 285 my $desc = "$chan sound with $samples samples";
286 $desc .= sprintf ", original name \"%s\"", $pdl->path if $pdl->path; 286 $desc .= sprintf ", original name \"%s\"", $pdl->path if $pdl->path;
287 $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;
288 $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;
289 $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;
290 $desc; 290 $desc
291} 291}
292 292
293=head2 raudio path, [option-hash], option => value, ... 293=head2 raudio path, [option-hash], option => value, ...
294 294
295Reads 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
296C<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).
297 299
298 # read any file 300 # read any file
299 $pdl = raudio "file.wav"; 301 $pdl = raudio "file.wav";
300 # read a file. if it is a raw file preset values 302 # read a file. if it is a raw file preset values
301 $pdl = raudio "file.raw", filetype => FILE_RAW, rate => 44100, channels => 2; 303 $pdl = raudio "file.raw", filetype => FILE_RAW, rate => 44100, channels => 2;
… …
303=head2 waudio pdl, [option-hash], option => value, ... 305=head2 waudio pdl, [option-hash], option => value, ...
304 306
305Writes 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.:
306 308
307 # write a file, using the header of another piddle 309 # write a file, using the header of another piddle
308 $pdl->waudio($orig_file->gethdr); 310 $pdl->waudio ($orig_file->gethdr);
309 # write pdl as au file, take rate from the header 311 # write pdl as au file, take rate from the header
310 $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;
311 313
312=cut 314=cut
313 315
314# read a sound file 316# read a sound file
315sub raudio { 317sub raudio {
… …
338 (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;
339 $pdl = $pdl->short->xchg(0,1); 341 $pdl = $pdl->short->xchg(0,1);
340 $pdl = $pdl->clump(2) if $channels == 1; 342 $pdl = $pdl->clump(2) if $channels == 1;
341 $pdl->sever; 343 $pdl->sever;
342 $pdl->sethdr(\%hdr); 344 $pdl->sethdr(\%hdr);
343 $pdl; 345 $pdl
344} 346}
345 347
346sub _audio_make_plain { 348sub _audio_make_plain {
347 my $pdl = shift; 349 my $pdl = shift;
348 if ($pdl->getndims == 1) { 350 if ($pdl->getndims == 1) {
349 ($pdl, 1, $pdl->getdim(0)); 351 ($pdl, 1, $pdl->getdim(0))
350 } else { 352 } else {
351 ($pdl->xchg(0,1)->clump(-1), ($pdl->dims)[1,0]); 353 ($pdl->xchg(0,1)->clump(-1), $pdl->dims)
352 } 354 }
353} 355}
354 356
355sub waudio { 357sub waudio {
356 my $pdl = shift; 358 my $pdl = shift;
… …
361 $hdr{format} ||= FORMAT_16_LINEAR; 363 $hdr{format} ||= FORMAT_16_LINEAR;
362 $hdr{rate} ||= 44100; 364 $hdr{rate} ||= 44100;
363 365
364 ($pdl, $channels, $frames) = _audio_make_plain $pdl->convert(long); 366 ($pdl, $channels, $frames) = _audio_make_plain $pdl->convert(long);
365 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
366 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};
367 $fd >= 0 or barf "$hdr{$path}: ".audio_error_name audio_error; 372 $fd >= 0 or barf "$hdr{$path}: ".audio_error_name audio_error;
368 $pdl->clump(-1)->write_sound($fd, $channels, $frames) 373 $pdl->clump(-1)->write_sound($fd, $channels, $frames)
369 >= 0 or barf "$path: ".audio_error_name audio_error; 374 >= 0 or barf "$path: ".audio_error_name audio_error;
370 (close_sound_output $fd, mus_samples2bytes $hdr{format}, $frames) 375 (close_sound_output $fd, mus_samples2bytes $hdr{format}, $frames * $channels)
371 >= 0 or barf "$hdr{$path}: ".audio_error_name audio_error; 376 >= 0 or barf "$hdr{$path}: ".audio_error_name audio_error;
372} 377}
373 378
374=head2 cut_leading_silence pdl, level 379=head2 cut_leading_silence pdl, level
375 380
… …
390sub cut_leading_silence { 395sub cut_leading_silence {
391 my $pdl = shift; 396 my $pdl = shift;
392 my $level = 1*shift; 397 my $level = 1*shift;
393 my $skip = which (abs($pdl) > $level); 398 my $skip = which (abs($pdl) > $level);
394 $skip = $skip->nelem ? $skip->at(0) : 0; 399 $skip = $skip->nelem ? $skip->at(0) : 0;
395 $pdl->slice("$skip:-1"); 400 $pdl->slice("$skip:-1")
396} 401}
397 402
398sub cut_trailing_silence { 403sub cut_trailing_silence {
399 my $pdl = shift; 404 my $pdl = shift;
400 my $level = 1*shift; 405 my $level = 1*shift;
401 $level = 400000; 406 $level = 400000;
402 my $skip = which (abs($pdl) > $level); 407 my $skip = which (abs($pdl) > $level);
403 $skip = $skip->nelem ? $skip->at(-1) : -1; 408 $skip = $skip->nelem ? $skip->at(-1) : -1;
404 $skip-- if $skip > 0; 409 $skip-- if $skip > 0;
405 $pdl->slice("0:$skip"); 410 $pdl->slice("0:$skip")
406} 411}
407 412
408sub cut_silence { 413sub cut_silence {
409 $_[0]->cut_leading_silence($_[1]) 414 $_[0]->cut_leading_silence($_[1])
410 ->cut_trailing_silence($_[1]); 415 ->cut_trailing_silence($_[1])
411} 416}
412 417
413# have we been a bad boy? 418# have we been a bad boy?
414 419
415for (@METHODS) { 420for (@METHODS) {

Diff Legend

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