view release on metacpan or  search on metacpan

Tk/Scope.pm  view on Meta::CPAN

 my $id;
 if (exists $args{-data})
  {
   my $data = delete $args{-data};
   $id = $sc->create('line',[0,0,0,0],%args);
   $sc->traceconfigure($id,-data => $data);
  }
 else
  {
   $id = $sc->create('line',[0,0,0,0],%args);
  } 
 return $id;
}

sub traceconfigure
{
 my ($sc,$id,%args) = @_;
 if (exists $args{-data})
  {
   my $data = delete $args{-data};
   $sc->{trace}{$id} = $data;
   $sc->scheduleRedisplay('data');
  } 
 $sc->itemconfigure($id,%args) if keys %args; 
}

sub tracecget
{
 my ($sc,$id,$key) = @_;
 return $sc->{trace}{$id} if $key eq '-data';
 return $sc->itemcget($id,$key); 
}

sub attrib
{
 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;
 my @result;
 
 foreach my $tr (@tr)
  {
   my $data = $sc->{trace}{$tr}->timerange($t1,$t2);
   return $data unless wantarray;
   push @result,$data;
  }
 return @result; 
}

sub Redisplay
{
 my ($sc,$why) = @_;
 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');
   my $ds = ($sc->x2val(1)-$sc->start)*$rate;
   my $yb = $h;
   if ($ds > 1)
    {
     # several samples in one pixel
     # warn "$ds = max/min\n"; 
     unless (defined $ys)
      {
       my ($max,$min) = $data->bounds($sc->x2val(0),$sc->x2val($w-1));
       $ys = ($max == $min) ? -1 : -2/($max-$min);  
       $yb = 2*$h-($min*$h*$ys);
      }
     for my $x (0..$w-1)
      {
       my $t  = $sc->x2val($x);
       my $t1 = $sc->x2val($x+1);
       my $samp = int($t*$rate);
       my ($max,$min);
       if ($acc eq 'FETCH')
        {
	 ($max,$min) = $data->bounds($t,$t1);
         $max = $max*$h*$ys+$yb;
         $min = $min*$h*$ys+$yb;
	}
       else 
        { 
         while ($t < $t1)
          {
           my $v = $data->$acc($samp);
           $v = 0 unless defined $v;