Audio
view release on metacpan or search on metacpan
Data/Data.pm view on Meta::CPAN
of resulting All-Pole filter. 0'th Element is I<not> a filter coefficent
(there is no A[0] in such a filter) - but is a measure of the "error"
in the matching process. I<$auto> is an output argument and returns
computed autocorrelation. I<$refl> is also output and are so-called
reflection coefficents used in "lattice" realization of the filter.
(Code for this lifted from "Festival" speech system's speech_tools.)
=item $auto = $audio->autocorrelation($LENGTH)
Returns an (unscaled) autocorrelation function - can be used to cause
peaks when data is periodic - and is used as a precursor to LPC analysis.
=back 4
=head2 Operators
B<Audio::Data> also provides overloaded operators where the B<Audio::Data> object
is treated as a vector in a mathematical sense. The other operand of an
operator can either be another B<Audio::Data> or a scalar which can be
Tk/Scope.pm view on Meta::CPAN
sub Range
{
my ($c,$x,$callback,$n,$m,@args) = @_;
$m = 1 if ($m eq '2' && !$c->cget('-range1'));
$c->Cursor($m,$x);
unless($n =~ /^\d+$/)
{
$c->itemconfigure($c->{"c$n"},-state => 'hidden');
$c->itemconfigure($c->{"c$m"},-state => 'hidden');
}
if (($n eq '1' && !$c->cget('-range1')) || ($c->{"cursor$n"} != $c->{"cursor$m"}))
{
my ($t1,$t2) = ($c->{"cursor$n"},$c->{"cursor$m"});
($t2,$t1) = ($t1,$t2) if $t1 > $t2;
$c->Callback($callback => $t1,$t2,@args);
}
}
sub Cursor
{
my ($c,$n,$x) = @_;
$c->Tk::focus;
$n = 1 if ($n eq '2' && !$c->cget('-range1'));
if (@_ > 2)
{
$c->{"cursor$n"} = $c->x2val($x);
$c->Callback(-command => "cursor$n");
}
unless (exists $c->{"c$n"})
{
my @args;
push(@args,-dash => '.') unless $n =~ /^\d+$/;
$c->{"c$n"} = $c->create(line => [0,0,0,0],@args);
}
if ($c->{xmax} && defined $c->{"cursor$n"})
{
$x = $c->val2x($c->{"cursor$n"});
my $w = $c->Width;
my $h = $c->Height;
if ($x >= 0 && $x <= $w)
{
$c->coords($c->{"c$n"},[$x,0,$x,$h]);
$c->itemconfigure($c->{"c$n"},-state => 'normal');
}
else
{
$c->itemconfigure($c->{"c$n"},-state => 'hidden');
Tk/Scope.pm view on Meta::CPAN
my ($sc,$key,$val) = @_;
if (@_ > 2)
{
# warn "$key = $val\n";
$sc->{$key} = $val;
$sc->scheduleRedisplay($key);
}
return $sc->{$key};
}
foreach my $meth (qw(yscale start end xmax cursor1 cursor2))
{
no strict 'refs';
my $key = $meth;
*$meth = sub { shift->attrib($key => @_) };
}
sub audio
{
my ($sc,$t1,$t2,@tr) = @_;
(@tr) = keys %{$sc->{trace}} unless @tr;
Tk/Scope.pm view on Meta::CPAN
delete $sc->{redisplay};
# warn "Redisplay $why\n";
my $w = $sc->Width;
my $h = $sc->Height/2;
my $dur = $sc->{xmax};
$sc->Callback(-xscrollcommand => $sc->start/$dur,$sc->end/$dur) if $dur;
foreach my $n (1,2)
{
$sc->Cursor($n) if exists $sc->{"cursor$n"};
}
foreach my $tr (keys %{$sc->{trace}})
{
my $ys = $sc->{yscale};
my $data = $sc->{trace}{$tr};
my $rate = $data->samples/$sc->{xmax};
next unless $rate;
my @coord;
my $acc = $sc->cget('-access');
Tk/Scope.pm view on Meta::CPAN
return @list;
}
sub Print
{
my ($c) = @_;
my $d = $c->DialogBox(-buttons => [qw(Ok Cancel)],
-title => 'Print Options',
-popover => 'cursor', -popanchor => 'nw');
my $ps = page_sizes();
my $psize = 'A4';
my $mode = 'color';
my $path = 'plot.ps';
my $what = 'All';
my $printer = 'File';
my @lopts = (-anchor => 'e', -justify => 'right');
Tk::grid(
$d->add('Label',-text => 'Print:',@lopts),
# $d->add('Optionmenu', -variable => \$what, -options => ['Window','All']),
my $FFT_SIZE = 256;
my $LPC_POLES = 10;
my $do_fft = 1;
my $do_lpc = 1;
my $mw = MainWindow->new;
my $menu = $mw->menu;
my ($f,$val) = create_labels($mw,[qw(0 xmax start end cursor1 cursor2)],qw(Freq Samp F0));
my $scope = $mw->Scrolled(Scope => -relief => 'ridge', -border => 2,
-width => 640, -height => 129);
my $over = $mw->Scope(-border => 2,-relief => 'ridge', -height => 128, -width => 320);
my $voice = $mw->Scope(-relief => 'ridge', -width => 256, -height => 128);
my $poles = $mw->Canvas(-width => 130, -height => 130);
$poles->create(oval => [1,1,129,129]);
$poles->create(line => [1,65,129,65]);
-initialdir => $lcwd);
if ($file)
{
$lcwd = dirname($file);
load($file);
}
}
sub Save
{
my $t1 = $scope->cursor1;
my $t2 = $scope->cursor2;
if (!defined $t1)
{
$t1 = $scope->start;
$t2 = $scope->end;
$scope->configure(-cursor1 => $t1, -cursor2 => $t2);
}
my $file = $mw->getSaveFile(-defaultextension => '.au',
-filetypes => [[ "Audio Files", [".au"],
[ "All Files", '*']]
],
-initialdir => $scwd);
if ($file)
{
$scwd = dirname($file);
save($file,$t1,$t2);
my ($tr) = $scope->traces;
return unless defined $tr;
my $r = $scope->tracecget($tr,'-data')->rate;
my $t;
if (@_ > 1)
{
$t = $c->x2val($x);
}
else
{
$t = ($scope->cursor1+$scope->cursor2)/2;
}
my $dt = ($FFT_SIZE/2+1)/$r;
my $t1 = $t - $dt;
my $t2 = $t + $dt;
$scope->cursor1($t1);
$scope->cursor2($t2);
my $au = $scope->audio($t1,$t2,$tr);
spectrum($au,$xfrm,$t_fft,$t_lpc);
}
sub create_buttons
{
my $f = $mw->Frame(-relief => 'groove', -border => 3);
my @but;
push @but,$f->Button(-text => 'Spectogram', -command => sub {
my $au = $scope->audio($scope->start,$scope->end);
warn "Cannot open audio:$!";
}
}
sub fstats
{
my ($xfrm,$val) = @_;
my $max = $xfrm->xmax;
return unless defined $max;
$val->{Samp} = sprintf("%5d",$max*2);
my $f = $xfrm->cursor1;
return unless defined $f;
$val->{Freq} = sprintf("%5d",$f);
}
sub vstats
{
my ($voice,$val) = @_;
my $t1 = $voice->cursor1;
return unless defined $t1;
my $t2 = $voice->cursor2;
return unless defined $t1;
return unless $t2 != $t1;
$val->{F0} = sprintf("%5d",1/($t2-$t1));
}
sub spectogram
{
my ($raw,$img) = @_;
my $au = $raw->difference;
my $N = ($img->cget('-height')-1)*2;
$c = sprintf("#%02X%02X%02X",$c,$c,$c);
$img->put([[$c]], -to => $x, (@amp-1-$y));
}
}
}
sub stats
{
my ($scope,$val,$over) = @_;
$over->cursor1($scope->start);
$over->cursor2($scope->end);
# warn "$scope ".$scope->Width.' '.$scope->Height."\n";
$simg->configure(-width => $scope->Width);
foreach my $meth (keys %$val)
{
next unless ($meth && $meth =~ /^[a-z]/);
if ($scope->can($meth))
{
my $v = $scope->$meth();
$val->{$meth} = (defined $v) ? sprintf("%10g",$v) : (' ' x 10);
( run in 0.632 second using v1.01-cache-2.11-cpan-4d50c553e7e )