Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Text Tags with Tk::Hlist ??

by reaper9187 (Scribe)
on Aug 21, 2014 at 15:37 UTC ( [id://1098240]=perlquestion: print w/replies, xml ) Need Help??

reaper9187 has asked for the wisdom of the Perl Monks concerning the following question:

Hi Fellow Monks,

I'm here to seek your guidance on using tags to bind text in Tk::Hlist.
Here is a small snippet of code of what I'm trying to achieve. 
#!/usr/bin/perl
use strict;
use Tk;
use Tk::HList;

my $mw = MainWindow->new();
$mw->resizable(0,0);

#create some sample data 
my %data;
my $tag = "tag000";

foreach (0..100) {
      $data{$_}{'name'} = 'name'.$_;
      $data{$_}{'id'} =   rand(time);
      $data{$_}{'priority'} =  int rand 50;
}
#get random list of keys 
my @keys = keys %data;

################# 

my $h = $mw->Scrolled( 'HList',
                       -header => 1,
                       -columns => 3,
                       -width => 40,
                       -height => 40,
                       -takefocus => 1,
                       -background => 'steelblue',
                       -foreground =>'snow',
                       -selectmode => 'single',
                       -selectforeground => 'pink',
                       -selectbackground => 'black',
                #       -browsecmd => \&browseThis, 
                   )->pack(-side => "left", -anchor => "n");

$h->header('create', 0, -text => '   Name  ',
                        -borderwidth => 3,
                        -headerbackground => 'steelblue',
                        -relief => 'raised');

$h->header('create', 1, -text => '      ID      ',
                        -borderwidth => 3,
                        -headerbackground => 'lightsteelblue',
                        -relief => 'raised');

$h->header('create', 2, -text => '  Priority  ',
                        -borderwidth => 3,
                        -headerbackground => 'lightgreen',
                        -relief => 'raised');


foreach (@keys) {
     my $e = $h->addchild(""); #will add at end 

     $h->itemCreate ($e, 0,
           -itemtype => 'text',
           -text => $data{$_}{'name'},
            );

     $h->itemCreate($e, 1,
           -itemtype => 'text',
           -text => $data{$_}{'id'},
         );

     $h->itemCreate($e, 2,
           -itemtype => 'text',
           -text => $data{$_}{'priority'},
         );
         
    $h->tagConfigure( $tag, -foreground => 'blue' );
            $h->tagBind( $tag,
                '<Any-Enter>' => [ \&manipulate_link, $tag, 'raised', 
+'hand2' ]
            );
            $h->tagBind( $tag,
                '<Any-Leave>' => [ \&manipulate_link, $tag, 'flat', 'x
+term' ] );
            $h->tagBind( $tag,
                '<Button-1>' => [ \&manipulate_link, $tag, 'sunken' ] 
+);
            $h->tagBind( $tag,
                '<ButtonRelease-1>' =>
                  [ \&manipulate_link, $tag, 'raised', undef, \&printm
+e ] );
            $tag++;           

}

my $button = $mw->Button(-text => 'exit',
                         -command => sub{exit})->pack;

my $sortid = $mw->Button(-text => 'Sort by Id',
                         -command => [\&sort_me,1] )->pack;

my $sortpriority = $mw->Button(-text => 'Sort by Priority',
                         -command => [\&sort_me,2] )->pack;


MainLoop;
######################################################### 
sub sort_me{
  my $col = shift;

  my @entries = $h->info('children');
  my @to_be_sorted =();

 foreach my $entry(@entries){
           push @to_be_sorted,
           [ $h->itemCget($entry,0,'text'),
             $h->itemCget($entry,1,'text'),
             $h->itemCget($entry,2,'text'),
           ];
           }

  my @sorted = sort{ $a->[$col] cmp $b->[$col]  || #primary sort ascii
+ 
                     $a->[1] <=> $b->[1]           #secondary sort num
+eric 
                       } @to_be_sorted;

my $entry = 0;
  foreach my $aref (@sorted){
#    print $aref->[0],' ',$aref->[1],' ',$aref->[1],"\n"; 
    $h->itemConfigure( $entry, 0, 'text' => $aref->[0] );
    $h->itemConfigure( $entry, 1, 'text' => $aref->[1] );
    $h->itemConfigure( $entry, 2, 'text' => $aref->[2] );
    $entry++;
  }

$mw->update;
}

sub printme {
    local ($,) = " ";
    print "printme:", @_, "\n";
}

sub manipulate_link {

    # manipulate the link as you press the mouse key

    my ($a)      = shift;
    my ($tag)    = shift;
    my ($relief) = shift;
    my ($cursor) = shift;
    my ($after)  = shift;

    # by configuring the relief (to simulate a button press)
    $a->tagConfigure( $tag, -relief => $relief, -borderwidth => 1 );

    # by changing the cursor between hand and xterm
    $a->configure( -cursor => $cursor ) if ($cursor);

    # and by scheduling the specified action to run "soon"
    if ($after) {
        my ($s) = $a->get( $a->tagRanges($tag) );
        $mw->after( 200, [ $after, $a, $s, $tag, @_ ] ) if ($after);
    }
}
__END__

[download]
When I run the code, it gives me the following error : 
Failed to AUTOLOAD 'Tk::HList::tagConfigure' at F:/Installation_Direct
+ory/Dwimpe
rl/perl/site/lib/Tk/Derived.pm line 469

[download]
Any idea on how I can overcome this issue ?

Replies are listed 'Best First'.
Re: Text Tags with Tk::Hlist ??
by zentara (Archbishop) on Aug 21, 2014 at 16:45 UTC
    The Hlist widget needs to use Tk::ItemStyle instead of tags. It is one of the problems with Tk, that the interface is not totally standard across widgets. Try this: 
    #!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::HList;
use Tk::ItemStyle;

my $mw = MainWindow->new();

my $green = $mw->ItemStyle(
    'text',
    -stylename => 'green',
    -bg        => 'green',
    -fg        => 'black',
);


$mw->optionAdd("*background", 'red');
$mw->optionAdd("*foreground", 'blue');

my $hlist;

$hlist = $mw->HList(
    -itemtype   => 'text',
    -selectmode => 'single',
)->pack(-fill=>'both',-expand=>1);

$hlist->columnWidth(0, -char, 90);
                    
for (1..1000) {
    $hlist->add($_, 
    -text=>$_);
 }


for (my $i = 1 ; $i < 1000  ; $i += 2){
    $hlist->entryconfigure( $i, -style => 'green' );
}

MainLoop;

    [download]
    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]
Re: Text Tags with Tk::Hlist ??
by reaper9187 (Scribe) on Aug 21, 2014 at 17:58 UTC
    Thank you very much zentara for your quick help. I am aware of the Tk::Itemstyle technique to 'condition' the Hlist widget. However, it does not provide options for callbacks on the specified widget (or maybe I'm wrong).

    Is it possible to include a callback to a subroutine for the Hlist item on a row basis ?? Say for example, I would like to display details of the current entry (like row no,etc).
[reply]
      You are looking for the -browsecmd. With the HList, you usually have to devise a system of looping thru all possible selections. For a fully functional example of using the HList, ItemStyle with images, and looping thru entries, see ztkdb-sql where it's all done. A similar, but smaller version is at ztkdb.

      What you have to watch out for, is that HList keeps an internal counter of added entries, and you need to learn to reuse them by reconfiguring them with $hlist->selectionSet( 0 ), or whichever row you want to modify. This is important in paging. If you don't use selectionSet(), you risk the internal counter continually increasing and causing unwanted memory gains.

      Finally, carefully read thru the perldoc for Tk::HList, and see all it's methods, they are not easy to understand until you practice using them. 

      #!/usr/bin/perl
use Tk;
use Tk::HList;
use YAML;

$top = new MainWindow;

$hlist = $top->Scrolled("HList",
   -header => 1,
   -columns => 4,
   -scrollbars => 'osoe',
   -command => sub{print 1},
   -width => 70,
   -selectbackground => 'SeaGreen3',
   -browsecmd => \&browseThis,
         )->pack(-expand => 1, -fill => 'both');

$hlist->header('create', 0, -text => 'From');
$hlist->header('create', 1, -text => 'Subject');
$hlist->header('create', 2, -text => 'Date');
$hlist->header('create', 3, -text => 'Size');

$hlist->add(0);
$hlist->itemCreate(0, 0, -text => "eserte\@cs.tu-berlin.de");
$hlist->itemCreate(0, 1, -text => "Re: HList?");
$hlist->itemCreate(0, 2, -text => "1999-11-20");
$hlist->itemCreate(0, 3, -text => "1432");

$hlist->add(1);
$hlist->itemCreate(1, 0, -text => "dummy\@foo.com");
$hlist->itemCreate(1, 1, -text => "Re: HList?");
$hlist->itemCreate(1, 2, -text => "1999-11-21");
$hlist->itemCreate(1, 3, -text => "2335");


MainLoop;

sub browseThis{
     for my $column (0..3){
       print $hlist->itemCget( $hlist->selectionGet, $column, 'text' )
+, "\n";
     }
}


=head1

  my $listArrayRef = [];

  my @selectedindices = $hlist->info('selection');

  foreach my $r (@selectedindices) {
     push @{$listArrayRef}, getRowArrayRef($hlist, $r);
     print Dump(@{$listArrayRef}),"\n";
   }

  sub getRowArrayRef {
    my ($hlist, $r) = @_;
    my @row;
   foreach my $c  (0 .. $hlist->cget(-columns) -1) {
     push @row, $hlist->itemCget($r, $c, '-text');
   } 
   return \@row;
  }    

}
=cut

      [download]
      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]
Re: Text Tags with Tk::Hlist ??
by reaper9187 (Scribe) on Aug 21, 2014 at 19:18 UTC
    Thank you very much zentara..!! Gosh. I have so much to learn..!!
[reply]
      Don't feel too bad, the HList widget is a hard to understand beast. :-)

      To give you a heads up, try to look at the HList indices as places to display your data, NOT store your data. The data should be stored in some other hash or array, and the HList is just used to display them. Similar in idea to the Model-View-Controller MVC concepts of modern gui's like gtk+.

      Here is a little example that should teach you alot about what happens internally with the HList indices counter. 

      #!/usr/bin/perl
use strict;
use Tk;
use Tk::HList;

my $mw = MainWindow->new();

#create some sample data
my %data;

foreach (0..100) {
      $data{$_}{'name'} = 'name'.$_;
      $data{$_}{'id'} =   rand(time);
      $data{$_}{'priority'} =  int rand 50;
}
#get random list of keys
my @keys = keys %data; 

#################

my $h = $mw->Scrolled( 'HList', 
                       -header => 1,
                       -columns => 3,
                       -width => 40,
                       -height => 40,
                       -takefocus => 1,
                       -background => 'steelblue',
                   -foreground =>'snow',
               -selectmode => 'single',
                       -selectforeground => 'pink',
                       -selectbackground => 'black',
                #       -browsecmd => \&browseThis,
                   )->pack(-side => "left", -anchor => "n");

$h->header('create', 0, -text => '   Name  ',
                        -borderwidth => 3,
                        -headerbackground => 'steelblue',
            -relief => 'raised');

$h->header('create', 1, -text => '      ID      ',
                        -borderwidth => 3,
                        -headerbackground => 'lightsteelblue',
                    -relief => 'raised');

$h->header('create', 2, -text => '  Priority  ',
                        -borderwidth => 3,
                        -headerbackground => 'lightgreen',
                    -relief => 'raised');


foreach (@keys) {
     my $e = $h->addchild(""); #will add at end
        
     $h->itemCreate ($e, 0,
           -itemtype => 'text',
           -text => $data{$_}{'name'},
            );
                        
     $h->itemCreate($e, 1,
           -itemtype => 'text',
           -text => $data{$_}{'id'},
         );

     $h->itemCreate($e, 2,
           -itemtype => 'text',
           -text => $data{$_}{'priority'},
         );

}

my $button = $mw->Button(-text => 'exit',
                         -command => sub{exit})->pack;

my $sortid = $mw->Button(-text => 'Sort by Id',
                         -command => [\&sort_me,1] )->pack;

my $sortpriority = $mw->Button(-text => 'Sort by Priority',
                         -command => [\&sort_me,2] )->pack;


$mw->Button(-text => 'Add Long String',
                         -command => [\&longadd] )->pack;


MainLoop;
#########################################################

sub longadd{
     my $e = $h->addchild(""); #will add at end
        
     $h->itemCreate ($e, 0,
           -itemtype => 'text',
           -text => 'longname',
            );
                        
     $h->itemCreate($e, 1,
           -itemtype => 'text',
           -text => time.time.time,
         );

     $h->itemCreate($e, 2,
           -itemtype => 'text',
           -text => 5,
         );



}

sub sort_me{
  my $col = shift;

  my @entries = $h->info('children');
  my @to_be_sorted =();

 foreach my $entry(@entries){
           push @to_be_sorted,
       [ $h->itemCget($entry,0,'text'),
         $h->itemCget($entry,1,'text'),
         $h->itemCget($entry,2,'text'),
       ];
           }

  my @sorted = sort{ $a->[$col] cmp $b->[$col]  || #primary sort ascii
                     $a->[1] <=> $b->[1]           #secondary sort num
+eric
                       } @to_be_sorted;
            
my $entry = 0;
  foreach my $aref (@sorted){
#    print $aref->[0],' ',$aref->[1],' ',$aref->[1],"\n";
    $h->itemConfigure( $entry, 0, 'text' => $aref->[0] );  
    $h->itemConfigure( $entry, 1, 'text' => $aref->[1] ); 
    $h->itemConfigure( $entry, 2, 'text' => $aref->[2] ); 
    $entry++;
  }

$mw->update;
}

      [download]
      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://1098240]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others browsing the Monastery: (9)
As of 2024-04-23 13:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found