view release on metacpan or  search on metacpan

tkscope  view on Meta::CPAN

   my $lpc;
   if (1)
    {
#    my ($auto,$ref);
     my $levinson = $window->lpc($LPC_POLES,$auto,$ref);
     roots(levinson => $levinson);
     inverse($raw,$levinson);
#    impulse($levinson);
     $levinson *= -1;
     $levinson->[0] = 1.0;
     $levinson->length($FFT_SIZE);
     # Take fft - gives transfer func of inverse filter (1-Sigma(An*z**-n))
     # so to approx filter take reciprocal of each point
     my $lpc = 1.0/$levinson->fft($FFT_SIZE);
     $lpc->length($FFT_SIZE/2);
     $xfrm->traceconfigure($t_lpc,-data => $lpc, -state => 'normal');
    }
   if (0)
    {
     my $auto = $window->autocorrelation($LPC_POLES);
#    $auto *= ($window->samples-$LPC_POLES);
     my $durbin   = $auto->durbin;
     my $gain = $durbin->[0];
     warn "gain = $gain\n";
     roots(durbin => $durbin);
     $durbin *= -1;
     $durbin->[0] = 1.0;
     $durbin->length($FFT_SIZE);
     # Take fft - gives transfer func of inverse filter (1-Sigma(An*z**-n))
     # so to approx filter take reciprocal of each point
     my $lpc = 1.0/$durbin->fft($FFT_SIZE);
     $lpc->length($FFT_SIZE/2);
     $xfrm->traceconfigure($t_aux,-data => $lpc, -state => 'normal');
    }
  }
 else
  {
   $xfrm->traceconfigure($t_lpc,-state => 'hidden');
  }
 my $d = $au->rate/2;
 $xfrm->configure(-xmax => $d, -end => $d, -start => 0);
}


sub inverse
{
 my ($au,$lpc) = @_;
 my @a = map { -$_ } $lpc->data;
 my $rate = $lpc->rate;
 my $n = @a-1;
 $au->length($FFT_SIZE);
 my $filter = Audio::Filter::FIR->new(rate => $rate);
 $filter->data(@a);
 $filter->[0] = 1;
 $filter->length(2*$n+1);
 my $response = Audio::Data->new(rate => $rate);
 $response .= $filter->process($au);
 my $dur = $response->duration/2;

 $voice->configure(-start => 0, -end => $dur, -xmax => $dur, -yscale => undef);
 $voice->traceconfigure($t_inv,-data => $response->timerange($dur,2*$dur));
# my $fresp = $response->fft($FFT_SIZE);
# $fresp->length($FFT_SIZE/2);
# $xfrm->traceconfigure($t_aux,-data => $fresp, -state => 'normal');
}

sub impulse
{
 my $lpc = shift;
 my $rate = $lpc->rate;
 my @a = $lpc->data;
 my $n = @a-1;
 my $filter = Audio::Filter::AllPole->new(rate => $rate);
 $filter->data(@a);
 # 0'th entry is gain or error or other "junk".
 $filter->[0] = 1;
 $filter->length(2*$n+1);
 my $response = Audio::Data->new(rate => $rate);
 # No feed it an impulse i.e. ...
 $response .= $filter->process(1);    # ... 1 at time 0 and ...
 for my $i (1..$FFT_SIZE-1)
  {
   $response .= $filter->process(0);  # ... 0 otherwise
  }
 my $dur = $response->duration;
 $voice->configure(-start => 0, -end => $dur, -xmax => $dur, -yscale => undef);
 $voice->traceconfigure($t_imp,-data => $response);
 my $fresp = $response->fft($FFT_SIZE);
 $fresp->length($FFT_SIZE/2);
 $xfrm->traceconfigure($t_aux,-data => $fresp, -state => 'normal');
}

my @formant;
my @pole;
sub pole_pair
{
 my @colours = qw(red darkgreen blue magenta brown black);
 my ($rate,$k,$f,$b,$r,$i) = @_;
 my $d = $r*$r+$i*$i;
 my $fresp;

 # chr(0xb1) is +/- sign
 $txt->insert('end',sprintf("f=%5.0fHz bw=%4.0fHz %.3g %+.3g%c%.3gi\n",
              $f,$b,1/sqrt($d),$r,0xb1,$i),["f$k"]);


 my $zr = 64*$r/$d;
 my $zi = 64*$i/$d;

 unless ($pole[$k])
  {
   my $col  = $colours[$k % @colours];
   $txt->tagConfigure("f$k",-foreground => $col);
   my $p = $poles->create(oval =>[0,0,0,0],-fill => $col, -outline => $col);
   my $m = $poles->create(oval =>[0,0,0,0],-fill => $col, -outline => $col);
   $pole[$k] =[$p,$m];
  }

 $poles->coords($pole[$k][0],[65+$zr-1,65+$zi-1,65+$zr+1,65+$zi+1]);
 $poles->coords($pole[$k][1],[65+$zr-1,65-$zi-1,65+$zr+1,65-$zi+1]);
 $poles->itemconfigure($pole[$k][0],-state => 'normal');