#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::Tree;
use Tk::Balloon;

my $mw = MainWindow->new();

my $mess = '';

my $h = $mw->Scrolled(
   'Tree',
   -scrollbars => 'ose',
   -selectmode => 'extended'
)->pack( -side => 'top', -fill => 'both', -expand => 1 );
my %help;

for my $top ( 1 .. 3 ) {
   $h->add( $top, -text => $top );

   for ( 1 .. 3 ) {
      $h->add( "$top.$_", -text => "$top.$_" );
      $help{ $top . '.' . $_ } = "help_$top.$_";
      print "$top$_\n";

   }
}

my $b = $mw->Balloon( -initwait => 0 );

$b->attach(
   $h->Subwidget( 'scrolled' ),
   -balloonposition => 'mouse',

#-msg=>\%help);
   -msg           => \$mess,
   -motioncommand => sub {
      my ( $lb, $x, $y ) = @_;
      $x -= $h->Subwidget( 'scrolled' )->rootx;
      $y -= $h->Subwidget( 'scrolled' )->rooty;

#print "$x $y\n";
      my $index = $h->Subwidget( 'scrolled' )->nearest( $y );
      print "$index\n";

      if ( $index ) {
         $mess = $help{ $index };    # put the balloon msg here
         0;                          # show balloon
      }
   }
);

MainLoop();