1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
|
#!/usr/bin/perl
# Demo script using PDL::IO::HDF5 and Tk to show an HDF5 file structure
#
use Tk;
use PDL::IO::HDF5::tkview;
use PDL::IO::HDF5;
use Tk::Balloon;
my $maxElements = 50; # Largest Array (in number of elements) that we
# will try to show in a popup balloon
my $filename = shift @ARGV || 'varlen.hdf5';
my $mw = MainWindow->new;
my $b = $mw->Balloon;
my $h5 = new PDL::IO::HDF5($filename); # open HDF5 file object
my $tkview = new PDL::IO::HDF5::tkview( $mw, $h5);
my $tree = $tkview->{hl};
my $lastItem = '';
my $mouseItem;
my ($pointerX,$pointerY);
my @BBox = (0,0,0,0);
$b->attach($tree,
-balloonposition => 'mouse',
-postcommand => sub {
#print "Box for $item is ".join(", ",@BBox)."\n";
#print "Box for $mouseItem is ".join(", ",@BBox)."\n";
#print "y = $pointerY\n";
if( ($pointerY >= $BBox[1] ) && ($pointerY <= $BBox[3]) && # Popup balloon if withing bounding box
$mouseItem =~ /$;_Dset(.+)$/ ){ # and a dataset item
my $datasetName = $1;
my $text = $tree->entrycget($mouseItem,'-text');
my $elements = 1;
if( $text =~ /\: Dims (.+)$/ ){
my @dims = split(',',$1);
my $message;
foreach (@dims){
$elements *= $_;
}
}
if( $elements > $maxElements){
$message = "$elements Elements: Too Big To Display";
}
else{
my $group = $tree->entrycget($mouseItem,'-data');
my $PDL = $group->dataset($datasetName)->get;
$message = "$PDL";
}
$b->{"clients"}{$tree}{-balloonmsg} = $message;
return 1;
}
0;
},
-motioncommand => sub {
# my $e = $tree->XEvent;
# print "xevent is a ".ref($e)."\n";
($pointerX,$pointerY) = $tree->pointerxy;
$pointerX -= $tree->rootx;
$pointerY -= $tree->rooty;
$mouseItem = $tree->nearest($pointerY);
# print "MouseItem = '$mouseItem'\n";
my $infoBBox = $tree->infoBbox($mouseItem);
# print "infoBBox = '$infoBBox'\n";
return 1 unless defined($infoBBox);
if( ref($infoBBox)){ # Handle the different ways that
# tk does the bounding box for 800.015 and 800.018, etc
@BBox = @$infoBBox;
}
else{
@BBox = split(' ', $infoBBox);
}
# print "Bbox = ".join(", ",@BBox)."\n";
# print "lastItem = '$lastItem', mouseItem = '$mouseItem'\n";
if( ( $lastItem eq $mouseItem ) &&
($pointerY >= $BBox[1] ) && ($pointerY <= $BBox[3]) ){
# Same item, and withing it's bounding box don't cancel the Balloon
0;
}
else{
# New item - cancel it so a new balloon will
# be posted
$lastItem = $mouseItem;
1;
}
}
);
MainLoop;
|