make canvas auto-scroll when dragging out of range 
Author Message
 make canvas auto-scroll when dragging out of range

Dear all,

In many scrolled-canvas based applications, when we are dragging some
item out of the visible range, the canvas will automatically scroll
so that after the drag-drop, the item is still in view.

How to do this?  The following is a sample item-dragging program:

use strict;
use Tk;

my $top=new MainWindow;
my $canvas=$top->Scrolled('Canvas',-scrollregion=>[0,0,1000,1000])->pack;
my $circle=$canvas->create('oval',100,100,150,150,-fill=>'white');
my($x,$y);
$canvas->bind($circle,'<1>'=>sub {($x,$y)=($Tk::event->x,$Tk::event->y)});
$canvas->bind($circle,'<B1-Motion>'=>sub {
    my($x1,$y1)=($Tk::event->x,$Tk::event->y);
    # if $x1 $y1 is out of range
    #     scroll canvas
    $canvas->move($circle,$x1-$x,$y1-$y);
    ($x,$y)=($x1,$y1);

Quote:
});

MainLoop;

I tried $canvas->xview(scroll=>...) but there were two problems:

1)  When the canvas auto-scrolled, I couldn't adhere the mouse cursor to
    the item it was dragging.

2)  When dragging, if the mouse was not moving, there was no scrolling.
    I see other applications will still scroll in this situation.

Could you help me with some sample code or modify the program I post above?

Thank you.

John Lin



Fri, 23 Aug 2002 03:00:00 GMT  
 make canvas auto-scroll when dragging out of range

Quote:

> Dear all,

> In many scrolled-canvas based applications, when we are dragging some
> item out of the visible range, the canvas will automatically scroll
> so that after the drag-drop, the item is still in view.

> How to do this?  The following is a sample item-dragging program:

> use strict;
> use Tk;

> my $top=new MainWindow;
> my $canvas=$top->Scrolled('Canvas',-scrollregion=>[0,0,1000,1000])->pack;
> my $circle=$canvas->create('oval',100,100,150,150,-fill=>'white');
> my($x,$y);
> $canvas->bind($circle,'<1>'=>sub {($x,$y)=($Tk::event->x,$Tk::event->y)});
> $canvas->bind($circle,'<B1-Motion>'=>sub {
>     my($x1,$y1)=($Tk::event->x,$Tk::event->y);
>     # if $x1 $y1 is out of range
>     #     scroll canvas
>     $canvas->move($circle,$x1-$x,$y1-$y);
>     ($x,$y)=($x1,$y1);
> });
> MainLoop;

> I tried $canvas->xview(scroll=>...) but there were two problems:

> 1)  When the canvas auto-scrolled, I couldn't adhere the mouse cursor to
>     the item it was dragging.

Maybe you can use a Toplevel window for the item? Look at the DragDrop
package in the Perl/Tk distribution.

Quote:

> 2)  When dragging, if the mouse was not moving, there was no scrolling.
>     I see other applications will still scroll in this situation.

I think the Motion binding is not enough. You can start a ->repeat
callback which periodically (about each 0.1 ms) checks whether the
cursor is over the canvas. The ->repeat callback should be destroyed
if the item is dropped.

Regards,
        Slaven

--
use Tk;$c=tkinit->Canvas(-he,20)->grid;$x=5;map{s!\n!!g;map{create$c 'line'=>
map{$a=-43+ord;($x+($a>>3)*2=>5+($a&7)*2)}split''}split"!";$x+=12}split/_/=>'K
PI1_+09IPK_K;-OA1_+K!;A__1;Q!7G_1+QK_3CLPI90,_+K!;A_+1!KQ!.N_K+1Q!.F_1+KN.Q__1+
KN._K+1Q!.F_1+KN.Q_+1Q__+1!KQ!.N_1;Q!7G_K3,09Q_+1!K.Q_K+1Q!.F_1+KN.Q_';MainLoop



Fri, 23 Aug 2002 03:00:00 GMT  
 make canvas auto-scroll when dragging out of range
Slaven Rezic wrote

Quote:
> John Lin writes:
> Maybe you can use a Toplevel window for the item?
> Look at the DragDrop package in the Perl/Tk distribution.

Thanks...  Actually I am new to Perl/Tk.
Your answer is too hard for a newbie like me  : (

Although I tried "perldoc Tk::Toplevel", "perldoc Tk::Widget"
and looked into the DragDrop.pm source code, I still couldn't figure it out...

Could you give me a piece of sample code
or redirect me to somewhere with a lot of examples (e.g. "widget") ?

Quote:
> > 1)  When the canvas auto-scrolled, I couldn't adhere the mouse cursor to
> >     the item it was dragging.

I think my problem can be solved by resetting the position of the mouse cursor
to where the dragged item is scrolled to.
Thus, the cursor will look like "adhering" to the item.

My question is: how can I set the position of the mouse cursor?

I found the function $x->pointerx, but it is the "get" method.
I need to "set", like $x->pointerx($newx).

Thanks.

John Lin

P.S.
Please run the following program to see what I mean by
"I couldn't adhere the mouse cursor to the item it was dragging" and
"resetting mouse-cursor position might solve my problem".

use strict;
use Tk;

my $main=new MainWindow;
my $canvas=$main->Scrolled('Canvas',-scrollregion=>[0,0,1000,1000])->pack;
my $circle=$canvas->create('oval',100,100,150,150,-fill=>'white');
my($x,$y);
$canvas->bind($circle,'<1>'=>sub {($x,$y)=($Tk::event->x,$Tk::event->y)});
$canvas->bind($circle,'<B1-Motion>'=>sub {
    my($x1,$y1)=($Tk::event->x,$Tk::event->y);
    $canvas->xview(scroll=>-1,'unit') if $x1<0;
    $canvas->xview(scroll=>1,'unit') if $x1>$canvas->Width;
    $canvas->yview(scroll=>-1,'unit') if $y1<0;
    $canvas->yview(scroll=>1,'unit') if $y1>$canvas->Height;
    $canvas->move($circle,$x1-$x,$y1-$y);
    ($x,$y)=($x1,$y1);

Quote:
});

MainLoop;


Sat, 24 Aug 2002 03:00:00 GMT  
 make canvas auto-scroll when dragging out of range
John Lin wrote

Quote:
> Slaven Rezic wrote
> > John Lin writes:
> > > 1)  When the canvas auto-scrolled, I couldn't adhere the mouse cursor to
> > >     the item it was dragging.

> I think my problem can be solved by resetting the position of the mouse cursor
> to where the dragged item is scrolled to.
> Thus, the cursor will look like "adhering" to the item.

> My question is: how can I set the position of the mouse cursor?

After reading the Tcl/Tk FAQ: "Can I warp the mouse pointer?", the answer is "NO".
(Hmm...  I think Perl/Tk resource is very rare.
 Eventually I have to go to Tcl/Tk for help.)

Quote:
> > > 2)  When dragging, if the mouse was not moving, there was no scrolling.
> > >     I see other applications will still scroll in this situation.
> > I think the Motion binding is not enough. You can start a ->repeat
> > callback which periodically (about each 0.1 ms) checks whether the
> > cursor is over the canvas. The ->repeat callback should be destroyed
> > if the item is dropped.

With Slaven's help and my observation over those auto-scrolling applications,
my program is modified as the following.

My observation:  The mouse cursor is not moved to adhere to the item at all,
the item is moved instead, to adhere to the mouse cursor.

Please give it a try and comments are welcomed.

Thank you.

John Lin

use strict;
use Tk;

my $main=new MainWindow;
my $canvas=$main->Scrolled('Canvas',-scrollregion=>[0,0,9000,9000])->pack;
my $circle=$canvas->createOval(100,100,150,150,-fill=>'white');

for my $i (1..90) {
    for my $j (1..90) {
        $canvas->createOval(100*$i-5,100*$j-5,100*$i,100*$j);
    }

Quote:
}

my($x,$y,$timer);

$canvas->bind($circle,'<1>'=>sub {
    ($x,$y)=($Tk::event->x,$Tk::event->y);
    $timer=$canvas->repeat(100=>\&scrollmove) unless defined $timer;

Quote:
});

$canvas->bind($circle,'<B1-Motion>'=>sub {
    my($x1,$y1)=($Tk::event->x,$Tk::event->y);
    $canvas->move($circle,$x1-$x,$y1-$y);
    ($x,$y)=($x1,$y1);

Quote:
});

$canvas->bind($circle,'<ButtonRelease-1>'=>sub {
    $canvas->afterCancel($timer) if defined $timer;
    undef $x;  undef $y;  undef $timer;

Quote:
});

sub scrollmove {
    return unless defined $x and defined $y;
    my($x1,$y1)=($canvas->canvasx($x),$canvas->canvasy($y));
    $canvas->xview(scroll=>-1,'unit') if $x<50;
    $canvas->xview(scroll=>1,'unit') if $x>$canvas->Width-50;
    $canvas->yview(scroll=>-1,'unit') if $y<50;
    $canvas->yview(scroll=>1,'unit') if $y>$canvas->Height-50;
    my($x2,$y2)=($canvas->canvasx($x),$canvas->canvasy($y));
    $canvas->move($circle,$x2-$x1,$y2-$y1);

Quote:
}

MainLoop;


Sun, 25 Aug 2002 03:00:00 GMT  
 make canvas auto-scroll when dragging out of range

Quote:

> John Lin wrote
> > Slaven Rezic wrote
> > > John Lin writes:

> > > > 1)  When the canvas auto-scrolled, I couldn't adhere the mouse cursor to
> > > >     the item it was dragging.

> > I think my problem can be solved by resetting the position of the mouse cursor
> > to where the dragged item is scrolled to.
> > Thus, the cursor will look like "adhering" to the item.

> > My question is: how can I set the position of the mouse cursor?

> After reading the Tcl/Tk FAQ: "Can I warp the mouse pointer?", the answer is "NO".
> (Hmm...  I think Perl/Tk resource is very rare.
>  Eventually I have to go to Tcl/Tk for help.)

> > > > 2)  When dragging, if the mouse was not moving, there was no scrolling.
> > > >     I see other applications will still scroll in this situation.

> > > I think the Motion binding is not enough. You can start a ->repeat
> > > callback which periodically (about each 0.1 ms) checks whether the
> > > cursor is over the canvas. The ->repeat callback should be destroyed
> > > if the item is dropped.

> With Slaven's help and my observation over those auto-scrolling applications,
> my program is modified as the following.

> My observation:  The mouse cursor is not moved to adhere to the item at all,
> the item is moved instead, to adhere to the mouse cursor.

> Please give it a try and comments are welcomed.

> Thank you.

> John Lin

Very good... but what happens when you drag the blob outside of the scrollable
limits, and "drop" it?
The blob is then lost forever.

Cheers,

Jon.

- Show quoted text -

Quote:

> use strict;
> use Tk;

> my $main=new MainWindow;
> my $canvas=$main->Scrolled('Canvas',-scrollregion=>[0,0,9000,9000])->pack;
> my $circle=$canvas->createOval(100,100,150,150,-fill=>'white');

> for my $i (1..90) {
>     for my $j (1..90) {
>         $canvas->createOval(100*$i-5,100*$j-5,100*$i,100*$j);
>     }
> }

> my($x,$y,$timer);

> $canvas->bind($circle,'<1>'=>sub {
>     ($x,$y)=($Tk::event->x,$Tk::event->y);
>     $timer=$canvas->repeat(100=>\&scrollmove) unless defined $timer;
> });

> $canvas->bind($circle,'<B1-Motion>'=>sub {
>     my($x1,$y1)=($Tk::event->x,$Tk::event->y);
>     $canvas->move($circle,$x1-$x,$y1-$y);
>     ($x,$y)=($x1,$y1);
> });

> $canvas->bind($circle,'<ButtonRelease-1>'=>sub {
>     $canvas->afterCancel($timer) if defined $timer;
>     undef $x;  undef $y;  undef $timer;
> });

> sub scrollmove {
>     return unless defined $x and defined $y;
>     my($x1,$y1)=($canvas->canvasx($x),$canvas->canvasy($y));
>     $canvas->xview(scroll=>-1,'unit') if $x<50;
>     $canvas->xview(scroll=>1,'unit') if $x>$canvas->Width-50;
>     $canvas->yview(scroll=>-1,'unit') if $y<50;
>     $canvas->yview(scroll=>1,'unit') if $y>$canvas->Height-50;
>     my($x2,$y2)=($canvas->canvasx($x),$canvas->canvasy($y));
>     $canvas->move($circle,$x2-$x1,$y2-$y1);
> }

> MainLoop;



Sun, 25 Aug 2002 03:00:00 GMT  
 make canvas auto-scroll when dragging out of range
Jonathan Davies wrote

Quote:

> > Please give it a try and comments are welcomed.
> Very good... but what happens when you drag the blob outside of the scrollable
> limits, and "drop" it?  The blob is then lost forever.

I knew it.  As I observed those auto-scrolling applications, in this situation, the
dropping will become disabled (the shape of the mouse pointer will also change).
It will become another question: "How to enable/disable during the drag-drop ..."
As I said, I am a newbie for Perl/Tk ...

Anyway, please try the following modified version and comments are welcomed.
It doesn't employ any new technologies, just use some 'if' checking.

Quote:
> Cheers

Cheers

Please also redirect me to where I can learn about enabling/disabling drag-drops.

Thank you

John Lin

use strict;
use Tk;

my $main=new MainWindow;
my $canvas=$main->Scrolled('Canvas',-scrollbars=>'se',
    -scrollregion=>[0,0,9000,9000])->pack(-fill=>'both',-expand=>1);
my $circle=$canvas->createOval(100,100,150,150,-fill=>'white');

for my $i (1..90) {
    for my $j (1..90) {
        $canvas->createOval(100*$i-5,100*$j-5,100*$i,100*$j);
    }

Quote:
}

my($x,$y,$timer);

$canvas->bind($circle,'<1>'=>sub {
    ($x,$y)=($Tk::event->x,$Tk::event->y);
    $timer=$canvas->repeat(100=>\&scrollmove) unless defined $timer;

Quote:
});

$canvas->bind($circle,'<B1-Motion>'=>sub {
    my($x1,$y1)=($Tk::event->x,$Tk::event->y);
    if($x1>5 and $x1<$canvas->Width-25) {
        $canvas->move($circle,$x1-$x,0);  $x=$x1;
    }
    if($y1>5 and $y1<$canvas->Height-25) {
        $canvas->move($circle,0,$y1-$y);  $y=$y1;
    }

Quote:
});

$canvas->bind($circle,'<ButtonRelease-1>'=>sub {
    $canvas->afterCancel($timer) if defined $timer;
    undef $timer;

Quote:
});

sub scrollmove {
    my($x1,$y1)=($canvas->canvasx($x),$canvas->canvasy($y));
    $canvas->xview(scroll=>-1,'unit') if $x<30;
    $canvas->xview(scroll=>1,'unit') if $x>$canvas->Width-50;
    $canvas->yview(scroll=>-1,'unit') if $y<30;
    $canvas->yview(scroll=>1,'unit') if $y>$canvas->Height-50;
    my($x2,$y2)=($canvas->canvasx($x),$canvas->canvasy($y));
    $canvas->move($circle,$x2-$x1,$y2-$y1);

Quote:
}

MainLoop;


Mon, 26 Aug 2002 03:00:00 GMT  
 make canvas auto-scroll when dragging out of range


:After reading the Tcl/Tk FAQ: "Can I warp the mouse pointer?", the
:answer is "NO".
:(Hmm...  I think Perl/Tk resource is very rare.
: Eventually I have to go to Tcl/Tk for help.)

I seem to recall, somewhere in the back of my memories, that the newest
version of Tk (8.3.0 - about a month or so old) now has some mouse
warping ability.

--
<URL: http://dev.scriptics.com/>

Unless explicitly stated to the contrary, nothing in this posting
should be construed as representing my employer's opinions.



Fri, 30 Aug 2002 03:00:00 GMT  
 
 [ 7 post ] 

 Relevant Pages 

1. tying a widget in one canvas to the scrolling of another canvas

2. Dragging objects on a canvas

3. problems tracking a mouse drag over canvas items,

4. Auto-scrolling Text widgets

5. Auto scrolling windows?

6. Auto-scrolling Text Widget

7. Auto-scrolling in a text window??

8. Making range non-greedy?

9. RFC: Making array using range op and map

10. Thanks and Follow-up (was: RFC: Making array using range op and map)

11. Auto resize a canvas

12. Mouse click location on a scrolled canvas

 

 
Powered by phpBB® Forum Software