#!/usr/bin/perl -w

use Tk;
use strict;

# Main program / GUI setup
my $mw = MainWindow->new;
my $c = $mw->Scrolled('Canvas', -width => 200, -height => 200)->grid;
$c->configure(-background =>'blue', -scrollregion => [ 0, 0, 500, 500 ]);

#Grid
$c->createGrid(0, 0, 10, 10);
$c->createGrid(0, 0, 100, 100, -lines => 1, -dash => '.-');

$c->pack(-expand => 1, -fill => 'both');

my $rect = $c->createRectangle(20, 20, 40, 40, 
    -outline => 'yellow', 
    -fill => 'yellow');
    
# get scrollbars
my $xscroll = $c->Subwidget("xscrollbar");
my $yscroll = $c->Subwidget("yscrollbar");

# create callbacks for scrollbars
$xscroll->configure(-command=>[\&scrolled,'x']);
$yscroll->configure(-command=>[\&scrolled,'y']);

MainLoop;

sub scrolled {
    my $dir = shift;  # what direction


    my (@xbefore,@ybefore);
    my (@xafter,@yafter);
    
    # debug statement
    print "${dir}scrolled: <",join("><",@_),">\n";

    # get data before moving 
    @xbefore = $c->xview();
    @ybefore = $c->yview();

    # move canvas
    if ($dir eq 'x') {$c->xview(@_)};
    if ($dir eq 'y') {$c->yview(@_)};

    # get data after moving
    @xafter=$c->xview();
    @yafter=$c->yview();
    
    # what is the scrollregion
    my @scrolls = $c->cget(-scrollregion);
    print "scrolled @scrolls\n";
    
    # movement in x direction is
    my $xmv = ($xafter[0] - $xbefore[0])*($scrolls[2]-$scrolls[0]);
    
    # movement in y direction is
    my $ymv = ($yafter[1] - $ybefore[1])*($scrolls[3]-$scrolls[1]);
    
    # move the rectangle to compensate for canvas move
    print "moving $xmv $ymv\n";
    $c->move($rect,$xmv,$ymv);
}