Popup labels in Tk::Canvas?

[Josef Möllers]

Hi,

I've hacked up a small script which takes lines of numbers (sar output)
and draws a histogram of the values found in one of the columns (I used
it to check for anomalies in the sar output).
I'd like to add some popup labels to the bars displayed, i.e. if I move
the mouse cursor over one of the bars, a small window should appear
telling me the value of the bar.
Any suggestion how this might be done?

The code is attached.

--
Josef Möllers (Pinguinpfleger bei FSC)
If failure had no penalty success would not be a prize
-- T. Pratchett

#! /usr/bin/perl -w

use Getopt::Std;
use Tk;

my %opts;
getopts('c:s:', \%opts);
my $column = $opts{'c'} || 0;
my $separator = $opts{'s'} || '\s+';

my @data = ();
my $max = undef;
my $min = undef;
while (<STDIN>) {
print;
next if /^\s*#/;
chomp;
@values = split /$separator/;
$v = $values[$column];
next unless (defined($v) && $v =~ m/^\d+(\.\d*)?$/);
push @data, $v;
$max = $v if (!defined($max) || $v > $max);
$min = $v if (!defined($min) || $v < $min);
}
my $range = $max - $min;
$range = 1 unless $range;
my $sum = 0;
foreach (@data) {
$_ = (($_ - $min) * 100) / $range;
$sum += $_;
}
my $nsamples = scalar @data;
my $linewidth = int(1000 / $nsamples);

my $top = new MainWindow;
my $c = $top->Canvas(-width => $nsamples * $linewidth,
-height => 100,
-state => 'normal');
$c->pack(-side => 'top');
for (my $i = 0; $i < $nsamples; $i++) {
$c->createLine($i*$linewidth, 100, $i*$linewidth, 100-$data[$i], -width => $linewidth, -fill => 'black');
}
my $avg = $sum / $nsamples;
$c->createLine(0, 100-$avg, $nsamples*$linewidth-1, 100-$avg, -fill => 'red');
MainLoop;

 

[Jack Challen]

I've hacked up a small script which takes lines of numbers (sar output)
and draws a histogram of the values found in one of the columns (I used
it to check for anomalies in the sar output).
I'd like to add some popup labels to the bars displayed, i.e. if I move
the mouse cursor over one of the bars, a small window should appear
telling me the value of the bar.
Any suggestion how this might be done?

Use a Tk::Balloon widget.

FWIW, I'd change the average line so that it's a running average
(calculated again for each sample).

Code included below. I've hacked it about a bit, and I think there might
be an off-by-one error between the bars' values and the values in the
balloons. The essence of the code is there though.

--------

#! /usr/bin/perl -w

use strict;
use Getopt::Std;
use Tk;
use Tk::Balloon;

my %opts;
getopts('c:s:', \%opts);
my $column = $opts{'c'} || 0;
my $separator = $opts{'s'} || '\s+';

my @data = ();
my $max = undef;
my $min = undef;
while (<STDIN>) {
print;
next if /^\s*#/;
chomp;
my @values = split /$separator/;
my $v = $values[$column];
next unless (defined($v) && $v =~ m/^\d+(\.\d*)?$/);
push @data, $v;
$max = $v if (!defined($max) || $v > $max);
$min = $v if (!defined($min) || $v < $min);
}
my $range = $max - $min;
$range = 1 unless $range;
my $sum = 0;

my @original_values = @data;
foreach (@data) {
$_ = (($_ - $min) * 100) / $range;
$sum += $_;
}
my $nsamples = scalar @data;
my $linewidth = int(1000 / $nsamples);

my $top = new MainWindow;
my $c = $top->Canvas(-width => $nsamples * $linewidth,
-height => 100,
-state => 'normal');
$c->pack(-side => 'top');

my $balloon = $c->Balloon;

my %messages;

for (my $i = 0; $i < $nsamples; $i++) {
$c->createLine($i*$linewidth, 100, $i*$linewidth, 100-$data[$i],
-width => $linewidth, -fill => 'black', -tag => $i);
$messages{$i} = $original_values[$i];
}

$balloon->attach($c, -balloonposition => 'mouse', -msg => \%messages);

my $avg = $sum / $nsamples;
$c->createLine(0, 100-$avg, $nsamples*$linewidth-1, 100-$avg, -fill => 'red');
MainLoop;

 

[Josef Möllers]

Use a Tk::Balloon widget.

FWIW, I'd change the average line so that it's a running average
(calculated again for each sample).

Code included below. I've hacked it about a bit, and I think there might
be an off-by-one error between the bars' values and the values in the
balloons. The essence of the code is there though.

Thanks, exactly what I was after.

Josef