Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

problem with TK, tag, passing param with binding, destroying binds

by jsteng (Beadle)
on Apr 20, 2018 at 00:19 UTC ( [id://1213205]=perlquestion: print w/replies, xml ) Need Help??

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

This script displays an ROText, each line binded to Button1 and Double1
It is suppose to print the line number where the mouse clicks occurred
Yet It always print "200".

What is wrong here?
I am not seeing where I made a mistake.
Need help.
use strict; use warnings; use Tk; my $mw = MainWindow->new( -bg=> "#000000", -borderwidth=> 0); $mw->geometry( '1000x600' ); my $LB = $mw->Scrolled ( 'ROText', -bg => '#C0C0C0', -fg => '#000000', -selectforeground => '#000000', -selectbackground => '#C0C0C0', -font => 'Courier 16 normal', -relief => 'groove', -cursor => 'top_left_arrow', -scrollbars => 'e', )->pack( -side => 'right', -expand => 1, -fill => 'both', ); sub selectAccount { my $this = shift; print "select: $this\n"; } sub markAccount { my $this = shift; print "mark: $this\n"; } sub InitializeListBox { $LB->delete('1.0','end'); for (my $i=1; $i<200; $i++) { $LB->insert('end', $i x 10, "A$i" ); $LB->tag( 'bind', "A$i", '<Button-1>' => sub { &selectAccount +($i) } ); $LB->tag( 'bind', "A$i", '<Double-1>' => sub { &markAccount($ +i) } ); $LB->insert('end', "\n" ); } } InitializeListBox(); MainLoop;
Lastly, how do I delete/destroy these bindings like this?
$LB->tag( 'bind', "A$i", '<Button-1>'  => sub { &selectAccount($i) } );
Does deleting the text do the trick like this?
$LB->delete('1.0','end'); If not, how to properly destroy them, independently or whole?


thanks

Replies are listed 'Best First'.
Re: problem with TK, tag, passing param with binding, destroying binds
by tybalt89 (Monsignor) on Apr 20, 2018 at 00:59 UTC
    #!/usr/bin/perl # http://perlmonks.org/?node_id=1213205 use strict; use warnings; use Tk; my $mw = MainWindow->new( -bg=> "#000000", -borderwidth=> 0); $mw->geometry( '1000x600' ); my $LB = $mw->Scrolled ( 'ROText', -bg => '#C0C0C0', -fg => '#000000', -selectforeground => '#000000', -selectbackground => '#C0C0C0', -font => 'Courier 16 normal', -relief => 'groove', -cursor => 'top_left_arrow', -scrollbars => 'e', )->pack( -side => 'right', -expand => 1, -fill => 'both', ); sub selectAccount { my $this = shift; print "select: $this\n"; } sub markAccount { my $this = shift; print "mark: $this\n"; } sub InitializeListBox { $LB->delete('1.0','end'); #for (my $i=1; $i<200; $i++) { for my $i (1..200) { $LB->insert('end', $i x 10, "A$i" ); $LB->tag( 'bind', "A$i", '<Button-1>' => sub { selectAccount( +$i) } ); $LB->tag( 'bind', "A$i", '<Double-1>' => sub { markAccount($i +) } ); $LB->insert('end', "\n" ); } } InitializeListBox(); MainLoop;
      Why your code sub { selectAccount(+$i) } works?
      And why my code sub { &selectAccount(+$i) } did not?
      I took that code from a working script. I have always been using with the ampersand with binds.

      When to use with & and when not to use?


      Secondly, Am I doing it correctly: Tagging and Binding each line in that ROText?

      My goal is to bind Button-1 to a highlight a line. and to bind Double-1 to change color/font of the line.


      I have tried using Pane + Labels, Canvas but want to see alternatives and compare which is faster/efficient. Pane+Labels has the best quality, but suck in performance with long lists. Canvas still in the works. But ROText was my first iteration and it was fastest but suck in quality.


      My next goal is to have a multiple column ListView with same ability to highlight a single line and change font/color. Again, Pane+Label's performance was terrible though appearance great.
        #!/usr/bin/perl # http://perlmonks.org/?node_id=1213205 use strict; use warnings; use Tk; use Tk::ROText; my $mw = MainWindow->new( -bg=> "#000000", -borderwidth=> 0); $mw->geometry( '1000x600' ); my $LB = $mw->Scrolled ( 'ROText', -bg => '#C0C0C0', -fg => '#000000', -selectforeground => '#000000', -selectbackground => '#C0C0C0', -font => 'Courier 16 normal', -relief => 'groove', -cursor => 'top_left_arrow', -scrollbars => 'e', )->pack( -side => 'right', -expand => 1, -fill => 'both', ); sub selectAccount { my $this = shift; print "select: $this\n"; $LB->tagConfigure("A$_", -background => 'grey') for 1..200; $LB->tagConfigure("A$this", -background => 'yellow'); } sub markAccount { my $this = shift; print "mark: $this\n"; my $fontref = $LB->tagCget("A$this", -font); my $font = $fontref ? $$fontref : 'Courier 16 normal'; my $new = $font =~ /normal/ ? 'Courier 16 bold' : 'Courier 16 norm +al'; $LB->tagConfigure("A$this", -font => $new); } sub InitializeListBox { $LB->delete('1.0','end'); #for (my $i=1; $i<200; $i++) { for my $i (1..200) { $LB->insert('end', $i x 10, "A$i" ); $LB->tag( 'bind', "A$i", '<Button-1>' => sub { selectAccount( +$i) } ); $LB->tag( 'bind', "A$i", '<Double-1>' => sub { markAccount($i +) } ); $LB->insert('end', "\n" ); } } InitializeListBox(); MainLoop;
        Why your code sub { selectAccount(+$i) } works?
        And why my code sub { &selectAccount(+$i) } did not?
        ... I have always been using with the ampersand with binds.

        Further to tybalt89's reply...
        The  & (ampersand) has nothing to do with it. (Likewise the  + (plus) sign in front of the $i; I don't know where that came from.) The trick is to switch from your C-style  for (my $i=1; $i<200; $i++) { ... } loop to a Perl-style  for my $i (1..200) { ... } loop.

        In the C-style loop, the variable  $i is defined once and given many values, the last of which is 200 (because that's the value that finally fails the  $i<200 test). All the  sub { selectAccount($i) } and  sub { markAccount($i) } expressions symbolicly reference (if that's the right term) this single  $i variable which has only one final value. At the end of the  InitializeListBox() routine, the referential bindings "close" over the single  $i variable (with its single value) because all symbolic references to the variable are used within code references which are passed to another subroutine, tag(), and must therefore persist. (Again, I may not have quite the right terminology here, but that's the general idea.)

        In the Perl-style loop, the  $i variable is aliased to many different values. Each  sub { ... } expression symbolically references a different value via the  $i alias. All these different, individual values are then closed over. I think that's about right.

        See closure.

        As to your other, Tk-related questions, it's been a while since I've played with Tk very much and someone else could, I'm sure, give you much better answers with much less mental effort.

        Update: Made a few minor changes to wording in the interest, I hope, of clarity.


        Give a man a fish:  <%-{-{-{-<

        Never use & except in one very special rare case.

        The real fix was using for my $i (1..200) { instead of the C style for(;;).

Re: problem with TK, tag, passing param with binding, destroying binds
by Anonymous Monk on Apr 20, 2018 at 01:13 UTC

    Lastly, how do I delete/destroy these bindings like this?

    To unbind use tagDelete? bind again with callback as undef?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1213205]
Approved by stevieb
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (4)
As of 2024-04-24 19:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found