#!/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_height, $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_height, $y+$ypad+$item_height);
    }
  }

  $draw_items = 0;
}

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

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 => "white");
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();
$top->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");

$top->bind('all', '<Button-1>', sub { scroll_on() });
$top->bind('all', '<Button-3>', sub { scroll_off() });

MainLoop;

##</code><code>##

#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}

package require Tk

set draw_items 1
proc update_fileview {} {
  variable item_height
  variable draw_items

  scroll_off
  hscroll_off

  set num_items 2000

  set canv_width [winfo width .canv]
  set canv_height [winfo height .canv]

  set canv_width2 [expr $canv_width - [winfo width .vscroll]]

  set canv_scroll_width $canv_width2

  set xpad [expr {$item_height / 20}]
  set ypad [expr {$item_height / 20}]
  set item_box_height [expr $item_height + $ypad * 2]
  set item_box_width [expr $item_height + $xpad * 2]

  set nitems_in_row [expr {$canv_width2 / $item_box_width}]

  if {$nitems_in_row < 1} {
    set nitems_in_row 1
    if {$item_box_width > $canv_width2} {
      set canv_scroll_width [expr $item_box_width + $xpad + [winfo width .vscroll]]
      hscroll_on
    }
  }

  set num_rows [expr {ceil("$num_items.0" / "$nitems_in_row.0")}]
  set canv_scroll_height [expr {$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"
  }
  
  set i 0
  set r 0
  set c 0

  for {} {$i < $num_items} {incr i} {

    set y [expr $r * $item_box_height]
    set x [expr $c * $item_box_width]

    if {$x + $item_box_width + $xpad > $canv_width2} {
      incr r
      if {$c != 0} {
        set c 0
        set y [expr $r * $item_box_height]
        set x [expr $c * $item_box_width]
        incr c
      }
    } else {
      incr c
    }

    if {$y + $item_box_height + $ypad > $canv_height} {
      scroll_on
    }
    if {$draw_items} {
      .canv create rectangle [expr $x + $xpad] [expr $y + $ypad] [expr $x + $xpad + $item_height] [expr $y + $ypad + $item_height] \
        -width 1m -outline #aaaaff -fill #6666aa -tags "item$i"
    } else {
      .canv moveto "item$i" [expr $x + $xpad] [expr $y + $ypad]
    }

  }

  set draw_items 0
#  set files [glob -nocomplain .* *]
#  set i [lsearch $files .]
#  set files [lreplace $files $i $i]
#  set i [lsearch $files ..]
#  set files [lsort [lreplace $files $i $i]]
}

proc scroll_on {} {
  raise .vscroll
}

proc scroll_off {} {
  lower .vscroll
}

proc hscroll_on {} {
  grid .hscroll
}

proc hscroll_off {} {
  grid remove .hscroll
}

canvas .canv -yscrollcommand ".vscroll set" -xscrollcommand ".hscroll set" -background white
scrollbar .vscroll -command ".canv yview"
scrollbar .hscroll -command ".canv xview" -orient horizontal

grid .canv -row 0 -column 0 -sticky nsew
grid .vscroll -row 0 -column 0 -sticky nse
grid .hscroll -row 1 -column 0 -sticky we
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1
grid rowconfigure . 1 -weight 0
lower .vscroll

bind .canv <Configure> update_fileview

set screen_height [winfo screenheight .]
set item_height [expr $screen_height / 10]
set min_item_offset [expr $item_height / 10]

set top_height [expr $screen_height / 2]
set top_width [expr {($top_height * 4) / 3}]
wm geometry . =${top_width}x$top_height

bind all <Button-1> scroll_on
bind all <Button-3> scroll_off