Multi column option menu

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

I am using PerlTK to build a GUI for a programmable keyboard. The script has a TK has a widget for each key on the keyboard. Each key has over 100 legal values. I have found this list to be too long for optionmenu type widget. So I borrowed the 'native_optionmenu' widget from the mastering Perl/TK book Chapter 12. The widget is similiar to optionmenu but allows for multiple columns.

A reduced version of my script that instantiates just one widget:

use Tk 800.000;
use strict;
my $width=45; # just right for 4 capital letters
my $height=30;
my @key_array = ();
@key_array =           split (//, "abcdefghijklmnopqrstuvwxyz");
@key_array = (@key_array, split (//, "0123456789" ) );
@key_array = (@key_array, qw(F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12) )
+;
@key_array = (@key_array, qw(F13 F14 F15 F16 F17 F18 F19 F20 F21 F22 F
+23 F24) );
@key_array = (@key_array, qw(Esc Bksp Del Ins Home End PgUp PgDn CapLk
+ Enter) );
@key_array = (@key_array, qw(Shift Ctrl Alt UpArr DnArr LtArr RtArr Pa
+use) );

my $vvalue="";

my $mw = MainWindow->new;
my $code_font = $mw->fontCreate('code', -family => 'ariel', -size => 1
+0);
native_optionmenu( $mw, \$vvalue)->place( -width =>  $width, -height =
+> $height);
MainLoop;

sub native_optionmenu {

    my($parent, $varref, ) = @_;

    my @optionvals = @key_array;

    my $mb = $parent->Menubutton(
        -textvariable       => $varref,
        -indicatoron        => 0,
        -relief             => 'raised',
        -borderwidth        => 2,
        -highlightthickness => 2,
        -anchor             => 'c',
        -direction          => 'flush',
        -font          => $code_font,
    );
    my $menu = $mb->Menu(-tearoff => 0);
    $mb->configure(-menu => $menu);

    my $ii =0;
    foreach (@optionvals) {
        $menu->radiobutton(
            -label     => $_,
            -variable  => $varref,
        );
        $menu->entryconfigure($ii, -columnbreak => 1) unless $ii++ % 2
+6;
    }
   $mb;

} # end native_optionmenu
[download]

My PerlTK script has several Notebook tabs. Each tab has around 50 native_optionmenu button and each button has greater than 40 widgets.

My issue is when I get up to around 170 instances of native_optionmenu (across multiple tabs), then active perl on windows XP goes crazy. My widgets disappear. Clicking on the notebook tabs causes widgets to appear OUTSIDE the TK GUI window.

I am looking for suggestions on how to improve the performance. I think the issue is just too many widgets. I think if the native_optionmenu sub called another sub that poped up the window, then the performance would be better. I am not good enough yet with PerlTK to make the tweak. I am looking for tips.

In my perl script where I call the native_optionmenu, If replaces the call to 'Button' and the problem goes away.

Works: $$win->Button( -textvariable => \$vvalue$layout $layer $finger $direction)->place(-x => $colpos, -y => $rowpos, -width => $width, -height => $height);

Buggy behavior: native_optionmenu( $$win, \$vvalue$layout $layer $finger $direction)->place(-x => $colpos, -y => $rowpos, -width => $width, -height => $height);

Suggestions?

Comment on Multi column option menu Download Code

Replies are listed 'Best First'.
Re: Multi column option menu by zentara (Cardinal) on Dec 05, 2013 at 14:21 UTC
I am looking for suggestions on how to improve the performance. I think the issue is just too many widgets...... My issue is when I get up to around 170 instances of native_optionmenu (across multiple tabs), then active perl on windows XP goes crazy. My widgets disappear. If I were you, I would switch to a Tk::Canvas. The canvas would be a single widget, and it can handle many items ( canvas widgets) with more control too, such as various enter-leave-focus bindings which you can do with the canvas. The canvas also has a "tags" method, with which you can do many tricks with the items, like raise or lower them, etc. For instance, see Tk Virtual Keyboard If you wish to stick with the option_menu method, I suggest just having only 1 option_method widget, and change the options as needed for each invocation. Here is a simple example of how to change options. #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new(); my @opt1 = ('a'..'m'); my @opt2 = ('n'.. 'z'); my $var = 'a'; my $tvar = 'a'; my $opt = $mw->Optionmenu( -command => \&show_choice, -variable => \$var, -textvariable => \$tvar, -options => \@opt1, )->pack; $mw->Button(-text=>'Change Options',-command=>[\&change_ops, $opt])->p +ack; $mw->Button(-text=>'Exit', -command=>sub{$mw->destroy})->pack; MainLoop; sub show_choice { print "got: ", shift, "\n" } sub change_ops { my $op = shift; $tvar = 'n'; $op->configure( -options => \@opt2 ); } [download] I'm not really a human, but I play one on earth. Old Perl Programmer Haiku ................... flash japh	[reply] [d/l]

Replies are listed 'Best First'.

Re: Multi column option menu
by zentara (Cardinal) on Dec 05, 2013 at 14:21 UTC

I am looking for suggestions on how to improve the performance. I think the issue is just too many widgets...... My issue is when I get up to around 170 instances of native_optionmenu (across multiple tabs), then active perl on windows XP goes crazy. My widgets disappear.

If I were you, I would switch to a Tk::Canvas. The canvas would be a single widget, and it can handle many items ( canvas widgets) with more control too, such as various enter-leave-focus bindings which you can do with the canvas. The canvas also has a "tags" method, with which you can do many tricks with the items, like raise or lower them, etc. For instance, see Tk Virtual Keyboard

If you wish to stick with the option_menu method, I suggest just having only 1 option_method widget, and change the options as needed for each invocation. Here is a simple example of how to change options.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = MainWindow->new();

my @opt1 = ('a'..'m');
my @opt2 = ('n'.. 'z');
my $var = 'a';
my $tvar = 'a';

my $opt = $mw->Optionmenu(
                          -command => \&show_choice,
                          -variable => \$var,
                          -textvariable => \$tvar,
                          -options => \@opt1,
                         )->pack;


$mw->Button(-text=>'Change Options',-command=>[\&change_ops, $opt])->p
+ack;

$mw->Button(-text=>'Exit', -command=>sub{$mw->destroy})->pack;

MainLoop;

sub show_choice
{
    print "got: ", shift, "\n"
}

sub change_ops
{
    my $op = shift;
    $tvar = 'n';
    $op->configure( -options => \@opt2 );
}
[download]

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

[reply]
[d/l]