Hi tamaguchi,

I had to do a little research to be able to answer your Tk Mystery 2.  You see, I had noticed this behavior before, but I hadn't solved it myself, so I used your question as an excuse to go figure it out.  (I also needed a few minutes to test and verify it).

The answer is that you have to assign a variable to the actual Canvas object which is a Subwidget of the Scrolled object, and bind to it.  Then, when you pass the (x, y) coordinate pair, you need to use the Canvas methods canvasx() and canvasy() to convert them to the transformed (x, y) pair you will use.

Here is a rewrite of your code (well, originally mine :-)), which demonstrates this: 

#!/usr/bin/perl -w
 
use Tk;
use strict;
use warnings;
 
# Globals
 
my $scroll_x = 0;
my $scroll_y = 0;
 
my $b_button_1_down = 0;    # Is the left mouse button currently down?
my ($x0, $y0, $x1, $y1);    # Starting and ending (x,y) coordinates
my $rect_id = 0;            # Last rectangle drawn
 
# Main program / GUI setup
my $mw = MainWindow->new;
my $c = $mw->Scrolled('Canvas',
    -width        => 200,
    -height       => 200,
    -background   =>'blue',
    -scrollregion => [ 0, 0, 1500, 1000 ]
);
 
$c->pack(-expand => 1, -fill => 'both');
bind_left_mouse($c);
 
MainLoop;

 
# Subroutines
 
sub bind_left_mouse
{
    my ($c) = @_;
 
    # Create "callback"; subroutines which get called whenever the
    # corresponding event is triggered.  Note that Ev('x') and Ev('y')
    # will tell us, at the time they're used, what the current (x,y)
    # coordinate pair was.  Note, too, that we're now getting the actu
+al
    # Canvas object $cv from the Scrolled object $c, using the Subwidg
+et()
    # method, and using it for the binding, and as a parameter to each
+ of
    # the 3 callbacks.
    #
    my $cv = $c->Subwidget("canvas");
    my $cb1 = [ \&left_mouse_down,    $cv, Ev('x'), Ev('y')];
    my $cb2 = [ \&left_mouse_release, $cv, Ev('x'), Ev('y')];
    my $cb3 = [ \&left_mouse_moving,  $cv, Ev('x'), Ev('y')];
 
    # Bind the callbacks
    $cv->CanvasBind("<ButtonPress-1>",   $cb1);
    $cv->CanvasBind("<ButtonRelease-1>", $cb2);
    $cv->CanvasBind("<Motion>",          $cb3);
}
 
sub left_mouse_down
{
    # This gets called whenever the left-mouse button is clicked
    my ($ev, $cv, $x, $y) = @_;
 
    # Figure out what adjustments have to be made for the scroll locat
+ion
    $x = $cv->canvasx($x);
    $y = $cv->canvasy($y);

    $b_button_1_down = 1;
    ($x0, $y0) = ($x, $y);
    print "(debug) button1 down, (x,y) => ($x,$y)\n";
}
 
sub left_mouse_moving
{
    # This gets called whenever the mouse moves.  It's true for ALL
    # mouse motion, but we're really just interested in when the mouse
    # is moving -and- the left mouse button is held down; hence the na
+me.
    #
    my ($ev, $cv, $x, $y) = @_;
    return unless $b_button_1_down;

    # Figure out what adjustments have to be made for the scroll locat
+ion
    $x = $cv->canvasx($x);
    $y = $cv->canvasy($y);

    print "(debug) button1 moving, (x,y) => ($x,$y)\n";
    $rect_id and $cv->delete($rect_id); # Delete any old rectangle fir
+st
    my @opts = (-outline => 'yellow', -dash => '.  ');
    $rect_id = $cv->createRectangle($x0, $y0, $x, $y, @opts);
}
 
sub left_mouse_release
{
    # This gets called whenever the left-mouse button is released
    my ($ev, $cv, $x, $y) = @_;
    $b_button_1_down = 0;

    # Figure out what adjustments have to be made for the scroll locat
+ion
    $x = $cv->canvasx($x);
    $y = $cv->canvasy($y);

    ($x1, $y1) = ($x, $y);
    print "(debug) button1 release, (x,y) => ($x,$y)\n";
    # Now do something with the triangle at (x0,y0,x1,y1)...
    $rect_id and $c->delete($rect_id); # Delete any old rectangle firs
+t
    my @opts = (-fill => 'purple');
    $rect_id = $c->createRectangle($x0, $y0, $x, $y, @opts);
}

[download]

I changed the result to a solid purple rectangle (just to make it a little more interesting, as well as further visual confirmation of success).  As you can see, the program finally does the right thing, even when you've scrolled the view.

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

In reply to Re: Tk mysteries. by liverpole
in thread Tk mysteries. by tamaguchi

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.