Ookey I have found the mistake. To summarize, binding of 'Configure' event on canvas didn't work and vertical scrollbar wasn't displayed. The reason is the little exception in Canvas API according to which I can't call canvas binding as usual like

$canv->bind(...);

[download]

According to http://search.cpan.org/dist/Tk/pod/bind.pod#CAVEATS:

" Note that for the Canvas widget, the call to bind has to be fully qualified. This is because there is already a bind method for the Canvas widget, which binds individual canvas tags. $canvas->Tk::bind "

After fixing everything works fine.

Here is a fixed script:

#!/usr/bin/env perl

use Tk;
use strict;
use POSIX;

my $draw_items = 1;

sub update_fileview {
  scroll_off();
  hscroll_off();

  our $canv;
  our $vscroll;
  our $hscroll;
  our $item_height;

  my $num_items = 2000;

  my $canv_width = $canv->width;
  my $canv_height = $canv->height;

  my $canv_width2 = $canv_width - $vscroll->width;
  
  my $canv_scroll_width = $canv_width2;

  my $xpad = $item_height / 20;
  my $ypad = $item_height / 20;
  my $item_box_height = $item_height + $ypad * 2;
  my $item_box_width = $item_height + $xpad * 2;

  my $nitems_in_row = $canv_width2 / $item_box_width;

  if ($nitems_in_row < 1) {
    $nitems_in_row = 1;
    if ($item_box_width > $canv_width2) {
      $canv_scroll_width = $item_box_width + $xpad + $vscroll->width;
      hscroll_on();
    }
  }

  my $num_rows = ceil("$num_items.0" / "$nitems_in_row.0");
  my $canv_scroll_height = $num_rows * $item_box_height;

  if ($canv_scroll_height > $canv_height) {
    scroll_on();
    $canv->configure(-scrollregion => [0, 0, $canv_scroll_width, $canv
+_scroll_height] );
  } else {
    $canv->configure(-scrollregion => [0, 0, $canv_scroll_width, $canv
+_height] );
  }

  my $i = my $r = my $c = 0;

  for (; $i < $num_items; $i++) {
    our $y = $r * $item_box_height;
    our $x = $c * $item_box_width;

    if ($x + $item_box_width + $xpad > $canv_width2) {
      $r++;
      if ($c != 0) {
        $c = 0;
        $y = $r * $item_box_height;
        $x = $c * $item_box_width;
        $c++;
      }
    } else {
      $c++;
    }

    if ($y + $item_box_height + $ypad > $canv_height) {
      scroll_on();
    }
    if ($draw_items) {
      $canv->create('rectangle', $x+$xpad, $y+$ypad, $x+$xpad+$item_he
+ight, $y+$ypad+$item_height,
          -width   => '1m',
          -outline => '#aaaaff',
          -fill    => '#6666aa',
          -tags    => "item$i"
          );
    } else {
      $canv->coords("item$i", $x+$xpad, $y+$ypad, $x+$xpad+$item_heigh
+t, $y+$ypad+$item_height);
    }
  }

  $draw_items = 0;
}

sub scroll_on {
  our $vscroll;
  $vscroll->raise();
}

sub scroll_off {
  our $vscroll;
  $vscroll->lower();
}

sub hscroll_on {
  our $hscroll;
  $hscroll->grid();
}

sub hscroll_off {
  our $hscroll;
  $hscroll->gridRemove();
}


our $top = new MainWindow;
our $canv = $top->Canvas(-background => "blue");
our $vscroll = $top->Scrollbar(-command => ['yview', $canv]);
our $hscroll = $top->Scrollbar(
    -command => ['xview', $canv],
    -orient  => 'horizontal');
$canv->configure(
    -yscrollcommand => ['set', $vscroll],
    -xscrollcommand => ['set', $hscroll]);

$canv->grid(
    -row    => 0,
    -column => 0,
    -sticky => 'nsew');
$vscroll->grid(
    -row    => 0,
    -column => 0,
    -sticky => 'nse');
$hscroll->grid(
    -row    => 1,
    -column => 0,
    -sticky => 'we');
$top->gridRowconfigure( 0, -weight => 1);
$top->gridColumnconfigure(0, -weight => 1);
$top->gridRowconfigure(1, -weight => 0);
$vscroll->lower();
$canv->Tk::bind('<Configure>' => sub {
    update_fileview();
});

our $screen_height = $top->screenheight;
our $item_height = $screen_height / 10;
our $min_item_offset = $item_height / 10;

our $top_height = $screen_height / 2;
our $top_width = ($top_height * 4) / 3;
$top->geometry("=${top_width}x$top_height");

$canv->Tk::bind('<Button-1>', sub { scroll_on() });
$canv->Tk::bind('<Button-3>', sub { scroll_off() });

MainLoop;

[download]

In reply to Re: Simple PerlTk program working slow by dexahex
in thread Simple PerlTk program working slow by dexahex

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.