Re^5: Tk::grid -sticky option not stretching frames

Hi, personally I prefer Tk over anything, because it is so simple. My next preference is Gtk2, because the documentation is good. Gtk2 is already being replaced by Gtk3 ( and now Gtk4), but 3 and 4 have a drawback in Perl because they use Glib::Object::Introspection to auto-generate the Perl .so file interface, and there are no real good auto-generated docs, as in Gtk2. Gtk2 is still the basic libs for apps like firefox, so it is definitely not obsolete, and will be around as a standard for a long time. Myself, I don't go for Wx, because I find it's syntax too much like C++, but the general wisdom is to use Wx if you want cross-platform apps.

As far as speeding up Tk goes, I find that the fewer the widgets you use, the faster it will run. That usually brings you down to using 1 widget, the Tk::Canvas. You can make any type of application you want on a Tk::Canvas, and with the proper use of tags, you can make giant programs that will run very fast, principally because there is only the Canvas widget handling all the events. If you want to try making Canvas based widgets, see Tk::CanvasDirTree and Tk-CanvasDirTree which is a simple Canvas app I wrote to show how easy it is to put your own Canvas ideas into your own widget.

If I was asked to make an app, the first thing I would choose would be the Tk::Canvas, because it gives you full control over all the bindings, is very easy to use, and is fast. There are some drawbacks, like no transparency in colors, and you have to manually make you own text areas and buttons, but once you get the hang of it, it's fairly easy.

Here is a huge Canvas which takes maybe 15 seconds to build on my computer, but once it is displayed, it is quite responsive. See how it works for you. I have 1000 rows of active areas with 72 elements each, for a total of 72000 active areas, to which you can add all sorts of enter/leave, mouse click bindings, and balloons.

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

# the left side canvas

#####  play with this number 1000 to add or reduce canvas size #######
+############

my @chs = (0..1000);  # ascending order
my $num_channels = scalar @chs;

my $mw =  new MainWindow();
$mw->geometry("600x400+200+200");

$mw->fontCreate('big',
   -family=>'arial',
  -weight=>'bold',
  -size=>int(-18*18/14));

$mw->fontCreate('medium',
   -family=>'arial',
   -weight=>'bold',
   -size=>int(-12*12/10));

$mw->fontCreate('small',
   -family=>'arial',
   -weight=>'normal',
   -size=>int(-10*10/10));


my $topframe = $mw->Frame(-bg=>'grey45')->pack();
my $infolab = $topframe->Label(-text =>'Some Info',
                               -bg=>'grey45',
                               -fg=>'lightgreen',
                                )->pack();

my $midframe = $mw->Frame(-bg=>'grey45')->pack();
my $midframel = $midframe->Frame(-bg=>'grey45')
                   ->pack(-side=>'left',-expand=>1,-fill=>'y');
my $midframer = $midframe->Frame(-bg=>'grey45')
                   ->pack(-side=>'right');

my $botframe = $mw->Frame(-bg=>'grey45')->pack();

my $canvast = $midframer->Scrolled('Canvas',
             -bg =>'lightyellow',
             -width=>2400,
             -height=>25,
         -scrollregion=>[-10,0,7250,25],
         -scrollbars =>'e',
         -xscrollincrement => 1,
         ) ->pack(-side=>'top');

my $canvasp = $midframer->Scrolled('Canvas',
             -bg =>'lightsteelblue',
             -width=>2400,
             -height=> 50 * $num_channels,
             -scrollregion=>[-10,0,7250,(50 * $num_channels)],
             -scrollbars=>'se',
         -xscrollincrement => 1,
         -yscrollincrement => 1,
         ) ->pack(-side=>'bottom',-fill=>'both');

#need real canvas for binding
my $realcan = $canvasp->Subwidget("scrolled");

my $canvasd = $midframel->Canvas(
             -bg =>'grey45',
             -width=>75,
             -height=>25,
         ) ->pack(-side=>'top');

my $canvass = $midframel->Scrolled('Canvas',
             -bg =>'lightsteelblue',
             -width=>75,
             -height=> 50 * $num_channels,
             -scrollregion=>[0,0,75,(50 * $num_channels)],
             -scrollbars =>'s',
         -yscrollincrement => 1,
         ) ->pack(-side=>'top');


my $xscroll = $canvasp->Subwidget("xscrollbar");
my $yscroll = $canvasp->Subwidget("yscrollbar");
$xscroll->configure(-troughcolor =>'grey45',
                    -activebackground =>'lightseagreen',
            -background =>'lightseagreen',
            -command => \&xscrollit,
            );
$yscroll->configure(-troughcolor =>'grey45',
                    -activebackground =>'lightseagreen',
            -background => 'lightseagreen',
            -command => \&yscrollit,
            );

#hidden and disabled scrollbars
my $xscroll1 = $canvass->Subwidget("xscrollbar");
my $yscroll1 = $canvast->Subwidget("yscrollbar");
$xscroll1->configure(-troughcolor =>'grey45',
                    -activebackground =>'grey45',
            -background =>'grey45',
            -highlightcolor =>'grey45',
            -highlightbackground => 'grey45',
            -elementborderwidth => 0,
            -relief => 'flat',
            );

$yscroll1->configure(-troughcolor =>'grey45',
                    -activebackground =>'grey45',
            -background =>'grey45',
            -highlightcolor =>'grey45',
            -highlightbackground => 'grey45',
            -elementborderwidth => 0,
            -relief => 'flat',
            );

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

#create timebar and markers

for(0..24000){
  if( $_ % 100 == 0){
      $canvast->createLine($_,0,$_,10);
      $canvast->createText($_,20,-text=>$_);
      next;
   }
}

=head
for(0..7200){
       
      if( $_ % 300 == 0){
         my $time =  $_ / 300;
         my $padded = ("0" x (2-length( $time ))).$time;
         $canvast->createLine($_,0,$_,12,-width=> 4 );
         $canvast->createText($_, 20, -text=> "$padded:00" );
 
      }elsif( $_ % 150 == 0){
          my $time =  ($_ - 150) / 300;
          my $padded = ("0" x (2-length( $time ))).$time;
         
         $canvast->createLine($_,0,$_,10,-width => 2);
         $canvast->createText($_, 20, -text=> "$padded:30" );
      
      }elsif( $_ % 75 == 0){
         $canvast->createLine($_,0,$_,6,-width => 1);
         
      }      
 
}
=cut

#--create left side station boxes---------------------------------
#need to store y pixel locations to fill in data in an orderly manner
my %slots;  #used to hold locations for main data positions

foreach my $slotnum (0 .. $num_channels){
   my $ch = shift @chs;

   $slots{$slotnum}{'channel'} = $ch;
   $slots{$slotnum}{'top'} =  2 + $slotnum * 50;
   $slots{$slotnum}{'bottom'} = 48 + $slotnum * 50;
   $slots{$slotnum}{'toptext'} = 15 + $slotnum * 50;
   $slots{$slotnum}{'midtext'} = 30 + $slotnum * 50;
   $slots{$slotnum}{'bottext'} = 45 + $slotnum * 50;

   $canvass->createRectangle(0, 2 + $slotnum * 50, 75, 48 + $slotnum *
+ 50 ,
              -fill =>'#f4dae4',
            );
   
   $canvass->createText(38, 15 + $slotnum * 50,
              -text => $ch ,
              -font => 'big',
        );
  
   $canvass->createText(38, 35 + $slotnum * 50,
              -text => $ch ,
              -font => 'medium',
          -fill => 'blue'
        );
}

#########################################
# now fill in some data
 
foreach my $slotnum (0 .. $num_channels){
    
    for(0..24000){
         if( $_ % 100 == 0){
             
        # actually you should do a bbox of the text below
        # to find the rect boundaries, but I cheat here
        # and hardwire in a 60 pixel width 
        my $rect = $canvasp->createRectangle($_- 30 ,$slots{$slotnum}{
+'top'} - 2,
                                      $_+ 30 ,$slots{$slotnum}{'bottom
+'} - 2,
              -fill =>'#dddddd',
              -tags => ['rect',$_,$slotnum],
            );
             
         my $text = $canvasp->createText( $_, $slots{$slotnum}{'midtex
+t'},
                  -text=>  $slotnum.'-'.$_,
                  -tags => ['text',$_,$slotnum]
                  );
             next;
          
          }
     }

}

# add some bindings
$realcan->bind("rect", "<Enter>", 
         sub { $realcan->itemconfigure("current", -fill => '#ffffff');
+ });
# When the mouse is not over, color it grey.
$realcan->bind("rect", "<Leave>",
         sub { $realcan->itemconfigure("current", -fill => '#dddddd');
+ });

#get info on left mouse click
$realcan->bind('rect',"<1>",sub {  
     my $item = $realcan->find('withtag','current');
     my (@tags) = $realcan->gettags($item);
     print join '-',@tags,"\n";
});

MainLoop;

#########
sub xscrollit{
 my $fraction = $_[1];
 $canvast->xviewMoveto($fraction);
 $canvasp->xviewMoveto($fraction);
}
########################################
sub yscrollit{
  my $fraction = $_[1];
  $canvass->yviewMoveto($fraction);
  $canvasp->yviewMoveto($fraction);

}
[download]

I'm not really a human, but I play one on earth. ..... an animated JAPH

Comment on Re^5: Tk::grid -sticky option not stretching frames Download Code

Replies are listed 'Best First'.
Re^6: Tk::grid -sticky option not stretching frames by boleary (Scribe) on Nov 15, 2018 at 02:27 UTC
that's pretty cool, I will take a look in depth at it... One thing I will try... I will add 1000 OptionMenus to your canvas in place of those rectangles and see how much longer it takes to build :) Thanks for all your insight... I have used many of your posts in the past to find solutions to my Tk problems and I really appreciate it. Hopefully I'll get to the point where I can provide the same kind of help every now and again	[reply]
Re^7: Tk::grid -sticky option not stretching frames by zentara (Archbishop) on Nov 15, 2018 at 13:19 UTC
Hi, I'm glad I could help you. To go further, in my previous reply I suggested for responsiveness, try to stick to one widget, like the canvas. If you go and try to add 1000 OptionMenus to the Canvas, it will quite possibly slow things up, because all those extra widgets need event handling. There is a good solution though, by popping up toplevel windows to handle your OptionMenus. So in the example I gave, you would add a right-click binding to each active area, when the right-click is processed, it pops open a separate toplevel window containing your OptionMenu. You load the OptionMenu dynamically from a big hash of data. Then REUSE the OptionMenu by deleting all it's current options, and reloading it when it needs to be used again. So, the overall idea is to make a single reusable toplevel window ( or popup ), with a single reusable OptionMenu, which you dynamically reconfigure with appropriate data on each use. This way, you stay responsive, AND MORE IMPORTANTLY, you don't start getting unwanted memory gains from repeated toplevel creations. Always think in terms of reusing widgets if possible, as that keeps the memory footprint under control. As a quick example, here is a reusable toplevel that you could use. See Re: opening multiple sub-windows in perl tk I'm not really a human, but I play one on earth. ..... an animated JAPH	[reply]


go ahead... be a heretic
	PerlMonks