view release on metacpan or  search on metacpan

Tk/Scope.pm  view on Meta::CPAN

package Tk::Scope;
use strict;
use Tk;
use Tk::widgets qw(Canvas Scrollbar DialogBox);
use Audio::Data;
use base qw(Tk::Derived Tk::Canvas);
use File::Temp qw(tempfile);

Construct Tk::Widget 'Scope';

sub ClassInit
{
 my ($class,$mw) = @_;
 
 $mw->bind($class,'<4>',[Wheel => -1, Ev('x')]); 
 $mw->bind($class,'<5>',[Wheel => 1, Ev('x')]); 
 
 $mw->bind($class,'<1>',[Cursor => 1,Ev('x')]); 
 $mw->bind($class,'<B1-Motion>',[Cursor => 2,Ev('x')]); 
 $mw->bind($class,'<ButtonRelease-1>',[Range => Ev('x'),-rangecmd => 1,2,Ev('s')]); 

 $mw->bind($class,'<3>',[Cursor => 'z1',Ev('x')]); 
 $mw->bind($class,'<B3-Motion>',[Cursor => 'z2',Ev('x')]); 
 $mw->bind($class,'<ButtonRelease-3>',[Range => Ev('x'),-zoomcmd => 'z1','z2',Ev('s')]); 
 
 $mw->bind($class,'<Configure>','scheduleRedisplay');
 $mw->bind($class,'<Print>','Print');
 return $class;
}
 
sub Wheel
{
 my ($c,$n,$x) = @_;
 $c->xview(scroll => $n*0.1, 'pages');
}

sub doZoom
{
 my ($c,$t1,$t2,$s) = @_; 
 # warn "Zoom '$s' $t1 -> $t2\n";
 if ($s =~ /Shift/)
  {
   my $s = $c->start;
   my $e = $c->end;
   my $w = $e-$s;               # width now
   my $dt = $t2-$t1;
   my $l1 = $w*$w/$dt;
   my $s1 = $s - ($t1-$s)*$w/$dt;
   $s1 = 0 if ($s1 < 0);
   my $e1 = $s1+$l1;
   $e1 = $c->xmax if ($e1 > $c->xmax);
   $c->start($s1); 
   $c->end($e1); 
  }
 else
  { 
   $c->start($t1); 
   $c->end($t2); 
  } 
}
 
sub Range
{
 my ($c,$x,$callback,$n,$m,@args) = @_;
 $m = 1 if ($m eq '2' && !$c->cget('-range1'));
 $c->Cursor($m,$x);