view release on metacpan or  search on metacpan

tkscope  view on Meta::CPAN

sub BORDER () { 2 }

$SIG{__DIE__} = \&Carp::confess;
# $SIG{INT} = \&Carp::confess;

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]);
$poles->create(line => [65,1,65,129]);



my $xfrm  = $mw->Scope(-border => BORDER, -relief => 'groove', -height => 200,
                       -yscale => undef,
		       -range1 => 0,
                       -access => 'dB',
                   #   -domain => 'frequency',
                      );
		
my $txt   = $mw->Scrolled(Text => -scrollbars => 's', -width => 25, -height => 14, -wrap => 'none');		
		
# Image at the back inside border
my $simg  = $mw->Photo(-height => 129, -width => 640);
$scope->create(image => [BORDER,BORDER], -anchor => 'nw', -image => $simg);

my $t_swav = $scope->trace(-fill => 'red');
my $t_owav = $over->trace(-fill => 'red');
		
my $t_fft = $xfrm->trace(-fill => 'orange');		
my $t_lpc = $xfrm->trace(-fill => 'blue');		
my $t_aux = $xfrm->trace(-fill => 'cyan');		

my $t_imp = $voice->trace(-fill => 'blue');
my $t_inv = $voice->trace(-fill => 'red');


my $canv  = $scope->Subwidget('scope');
$canv->Tk::bind('<2>',[\&Spectrum,Ev('x')]);
$canv->Tk::bind('<B2-Motion>',[\&Spectrum,Ev('x')]);

my $but   = create_buttons($mw);

my $row = 0;
$but->grid(-row => $row, -column => 0, -columnspan => 3, -sticky => 'ew');
$mw->gridRowconfigure($row++,-weight => 0);

$f->grid(-row => $row, -column => 0, -columnspan => 3, -sticky => 'ew');
$mw->gridRowconfigure($row++,-weight => 0);

$scope->grid(-row => $row, -column => 0, -columnspan => 3, -sticky => 'ew');
$mw->gridRowconfigure($row++,-weight => 0);

$poles->grid(-row => $row, -column => 0);
$voice->grid(-row => $row, -column => 1, -sticky => 'ew');
$over->grid(-row => $row, -column => 2, -sticky => 'ew', -columnspan => 2);
$mw->gridRowconfigure($row++,-weight => 0);

$txt->grid( -row => $row, -column => 0, -columnspan => 1,-sticky => 'nsew');
$xfrm->grid( -row => $row, -column => 1, -columnspan => 2,-sticky => 'nsew');
$mw->gridRowconfigure($row++,-weight => 1);

for my $c (0..2)
 {
  $mw->gridColumnconfigure($c,-weight => ($c) ? 1 : 0);
 }

$scope->configure(-command => [\&stats,$scope->Subwidget('scope'),$val,$over]);
$xfrm->configure(-command => [\&fstats,$xfrm,$val]);

$voice->configure(-command => [\&vstats,$voice,$val]);

$over->configure(-zoomcmd => [doZoom => $scope],
                 -rangecmd => [doZoom => $scope]);


if (@ARGV)
 {
  load(shift);
 }

MainLoop;

sub load
{
 my $file = shift;
 open(my $fh,"$file") || die "Cannot open $file:$!";
 binmode($fh);
 warn "Loading $file\n";
 my $au = Audio::Data->new(Load => $fh);
 if ($au)
  {
   my $dur = $au->duration;
   $scope->configure(-start => 0, -xmax => $dur, -end => $dur);
   $over->configure(-start => 0, -xmax => $dur, -end => $dur);
   $scope->traceconfigure($t_swav, -data => $au);
   $over->traceconfigure($t_owav, -data => $au);
   $mw->title($file);
   $val->{Samp} = $au->rate;
  }
 close($fh);
}

sub Load
{
 my $file = $mw->getOpenFile(-defaultextension => '.au',
                             -filetypes => [[ "Audio Files", [".au"],
			                    [ "All Files", '*']]
					   ],					
			     -initialdir => $lcwd);
 if ($file)
  {			
   $lcwd = dirname($file);			
   load($file);
  }			
}

sub Save
{
 my $t1 = $scope->cursor1;

tkscope  view on Meta::CPAN

  {
   push @but,$f->Label(-text => 'FFT_size',-justify => 'right',-anchor => 'e'); 		
   push @but,$f->Optionmenu(-variable => \$FFT_SIZE,
                            -options => [256,64,128,512,1024],
                            -command => sub { Spectrum($scope->Subwidget('scope')) }
			   ); 		
   $FFT_SIZE = 256;
  }
 if (1)
  {
   push @but,$f->Checkbutton(-text => "LPC", -variable => \$do_lpc,
                            -command => sub { Spectrum($scope->Subwidget('scope')) }
			   ); 		
   push @but,$f->Checkbutton(-text => "FFT", -variable => \$do_fft,
                            -command => sub { Spectrum($scope->Subwidget('scope')) }
			   ); 		
  }
		
 Tk::grid(@but,-sticky => 'nsew');
 for my $i (0..$#but)
  {
   $f->gridColumnconfigure($i,-weight => 1);
  }
 return $f;
}

sub create_labels
{
 my ($mw,$pairs,@other) = @_;
 my %values;
 my $f = $mw->Frame(-relief => 'groove', -border => 3);
 my @but;
 my @l1;
 my @l2;
 my @labels = @$pairs;
 while (@labels)
  {
   my ($start,$end) = splice(@labels,0,2);
   my $span = 1;
   foreach my $lab ($start,$end)
    {
     push(@l1,$f->Label(-text => $lab, -justify => 'center', -anchor => 'c', -relief => 'ridge'));
     $values{$lab} = 0;
     push(@l2,$f->Label(-textvariable => \$values{$lab},
                      -justify => 'center', -anchor => 'c',-relief => 'ridge'));
    }
   push(@but,$f->Button(-text => "$start-$end",
                        -command => [\&Play,\$values{$start},\$values{$end}])
       );
  }
 while (@other)
  {
   my $lab = shift(@other);
   push(@l1,$f->Label(-text => $lab, -justify => 'center', -anchor => 'c', -relief => 'ridge'));
   $values{$lab} = 0;
   push(@l2,$f->Label(-textvariable => \$values{$lab},
                      -justify => 'center', -anchor => 'c',-relief => 'ridge'));
  }
 Tk::grid(@l1,-sticky => 'nsew');
 Tk::grid(@l2,-sticky => 'nsew');
 Tk::grid(@but,-sticky => 'nsew',-columnspan => 2);
 for my $i (0..$#l1)
  {
   $f->gridColumnconfigure($i,-weight => 1);
  }
 return ($f,\%values);
}

sub Play
{
 my ($sp,$ep) = @_;
 my $svr = Audio::Play->new;
 if ($svr)
  {
   my $au = $scope->audio($$sp,$$ep);
   if ($au)
    {
     $svr->play($au);
    }
  }
 else
  {
   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;
 my $w = $img->cget('-width')-2*BORDER;
 my $n = $au->samples;
 my $step = int($n/$w);
 my $s = Audio::Data->new(rate => $au->rate);
 my ($max,$min);
 my $st = 0;
 # warn("N=$N w=$w step=$step\n");
 for (my $x = 0; $x < $w; $x++)