Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Tk Canvas Items Drag

by msemtd (Scribe)
on Jun 03, 2003 at 08:44 UTC ( #262592=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info michael.erskine@jasmin.plc.uk
Description: An example of draggable canvas items that I developed as a learning exercise. Quite often I find that I don't understand other peoples' examples until I have built my own from scratch. Here, I was looking for the information available from Tk during a drag type operation and to discriminate between objects upon drop. I threw in the playing card for eyecandy!
#! perl
use strict;
use warnings;
use Tk;
# Main window with a stretchy canvas...
my $mw = new MainWindow( -title => "Tk Canvas Item Drag" );
my $c = $mw->Canvas(
    -width  => 600,
    -height => 300,
    -bg     => 'beige',
)->pack( -expand => '1', -fill => 'both' );
# Some rectangle items...
$c->createRectangle(
    100, 100, 200, 200,
    -fill          => 'orange',
    -activefill    => 'darkorange',
    -outline       => 'red',
    -activeoutline => 'green',
    -width         => 1,
    -activewidth   => 2,
    -tags          => ['draggable'],
);
$c->createRectangle(
    210, 110, 260, 160,
    -fill       => 'red',
    -activefill => 'darkred',
    -tags       => ['draggable'],
);
# This one is not draggable...
$c->createRectangle(
    410, 90, 510, 160,
    -fill       => 'blue',
    -activefill => 'navy',
);
# An image of a playing card - loaded from a a pixmap with the playing
+_card_xpm sub - see below...
$c->Pixmap( 'card', -data => playing_card_xpm() );
$c->createImage(
    300, 100,
    -image  => 'card',
    -anchor => 'nw',
    -tags   => [ 'draggable', 'card' ],
);
my $description = <<'EOF';
The orange and red rectangles can be moved - the blue one can't.
When the playing card is dragged it leaves a vector behind!
Take a look at the info that goes to STDOUT.
EOF
$c->createText(
    300, 20,
    -anchor  => 'n',
    -justify => 'center',
    -text    => $description
);
# add bindings for draggable objects...
$c->bind( 'draggable', '<1>'                   => \&drag_start );
$c->bind( 'draggable', '<B1-Motion>'           => \&drag_during );
$c->bind( 'draggable', '<Any-ButtonRelease-1>' => \&drag_end );
# the enter and leave events could be used to show and hide highlight 
+type objects...
$c->bind( 'draggable', '<B1-Enter>' => undef );
$c->bind( 'draggable', '<B1-Leave>' => undef );
# Dragging item info hash to be kept during a drag...
my %draginfo;
MainLoop();

sub drag_start {
    print "drag_start:\n";
    my ($c) = @_;
    my $e = $c->XEvent;
    # get the screen position of the initial button press...
    my ( $sx, $sy ) = ( $e->x, $e->y,,, );
    print "\t screen: $sx, $sy\n";
    # get the canvas position...
    my ( $cx, $cy ) = ( $c->canvasx($sx), $c->canvasy($sy) );
    print "\t canvas: $cx, $cy\n";
    # get the clicked item...
    my $id = $c->find( 'withtag', 'current' );
    print "\t item id: $id\n";
    my ( $x1, $y1, $x2, $y2 ) = $c->bbox($id);
    print "\t obj has bbox: $x1, $y1, $x2, $y2.\n";
    # set up the draginfo...
    $draginfo{id}     = $id;
    $draginfo{startx} = $draginfo{lastx} = $cx;
    $draginfo{starty} = $draginfo{lasty} = $cy;
}

sub drag_during {
    print "drag_during:\n";
    my ($c) = @_;
    my $e = $c->XEvent;
    # get the screen position of the move...
    my ( $sx, $sy ) = ( $e->x, $e->y,,, );
    print "\t screen: $sx, $sy\n";
    # get the canvas position...
    my ( $cx, $cy ) = ( $c->canvasx($sx), $c->canvasy($sy) );
    print "\t canvas: $cx, $cy\n";
    # get the amount to move...
    my ( $dx, $dy ) = ( $cx - $draginfo{lastx}, $cy - $draginfo{lasty}
+ );
    print "\t dx, dy = $dx, $dy\n";
    # move it...
    $c->move( $draginfo{id}, $dx, $dy );
    # update last position
    $draginfo{lastx} = $cx;
    $draginfo{lasty} = $cy;
    my ( $x1, $y1, $x2, $y2 ) = $c->bbox( $draginfo{id} );
    print "\t obj has bbox: $x1, $y1, $x2, $y2.\n";
}

sub drag_end {
    print "drag_end: \n";
    # upon drag end, check for valid position and act accordingly...
    # was it the card?
    my @tags = $c->gettags( $draginfo{id} );
    if ( grep /^card$/, @tags ) {
        # did it move anywhere? If so draw a vector...
        if (   $draginfo{startx} - $draginfo{lastx}
            or $draginfo{starty} - $draginfo{lasty} )
        {
            my $line = $c->createLine(
                $draginfo{startx}, $draginfo{starty},
                $draginfo{lastx},  $draginfo{lasty},
                -arrow    => 'last',
                -width    => 3,
                -capstyle => 'round',
                -fill     => 'navy',
            );
        }
    }
    %draginfo = ();
}
# return the source of a nice playing card pixmap...
sub playing_card_xpm {
    return <<'EOXPM';
/* XPM */
static char *j[] = {
/* width height num_colors chars_per_pixel */
"    73    97        8            1",
/* colors */
"` c #000000",
". c #808080",
"# c #c0c0c0",
"a c None",
"b c #ffffff",
"c c #000000",
"d c #000000",
"e c #000000",
/* pixels */
"a#```````````````````````````````````````````````````````````````````
+``#a",
"#.bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bb.#",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbb````bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbb.``.bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbb`#bb``bbbbbbbbbbbbbbbbbbbbb#.`````..#bbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbb``bb``bbbbbbbbbbbbbbbbbbb#.```````````#bbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbb.````.bbbbbbbbbbbbbbbbbb.``````````````.bbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbb.``.bbbbbbbbbbbbbbbbbb#`````````````.```bbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb#`````````````..```.bbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb.`````````````...```#bbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb````````````````````.bbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`````````````````````#bbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`````````````````````.bbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb.``````````````````````bbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb.````````````...```````bbbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#``.#.``````..##.``````#bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb.``##b#````##b#b.``````#bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`.#.#b.```#b..#b.`````.bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`.``.#.``.b.``.##`````#bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`..`..#```#.```#b`````.bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#``.``.....#````#b`````#bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``#.`######..`.##`````.bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``..############``````.bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``..####b#######.``````bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb`..#######b#####.``````bbbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``.####b######.#.``````#bbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``..###########..``.```.bbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``...#######.....``...``bbbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb.`#....#.#....###```..``.bbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb.`##........##bbb.```.```bbbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb.``###.....####bbb#```````.bbbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbb#```bb#########bbbbb.```````#bbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbb```#bb#######bbbbbbbb````````bbbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbb.``.bbbb####bbbbbbbbbb.```````.bbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbb#```bbbbbbb#bbbbbbbbbbb#````````bbbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbb```.bbbbbbbbbbbbbbbbbbbb.````````bbbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbb.```bbbbbbbbbbbbbbbbbbbbb.`````````bbbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbb.```.##bbbbbb#bbbbbbbb#b#b#`````````.bbbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbb.````..b#bbb#b#bbbb#b######b``````````#bbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbb`````.#b#bbbbbbbbbbbbb#b###b#``````````bbbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbb#````.#bbbbbbb#bbbbbbbbbbbb##b.`````````#bbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbb.````##bbbbbbbbbbbbbbbbbbbbb###``````````bbbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbb````.#bbbbbbbbbbbbbbbbbbbbbbbb#.`````````#bbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbbb````#bbbbbbbbbbbbbbbbbbbbbbbbbb#``.``````.bbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbb.```.#bbbbbbbbbbbbbbbbbbbbbbbbbbb`.``.`````bbbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbbb````.bbbbbbbbb#bbbbbbbbbbbbbbbbbb.`````````#bbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbb.````bbbbbbbbbb#bbbbbbbbbbbbbbbbbb.`````````.bbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbbb.```.bbbbbbbbb#bbbbbbbbbbbbbbbbbbb.``````````bbbbbbbb
+bbb`",
"`bbbbbbbbbbbbbb#````#bbbbbbbbb#bbbbbbbbbbbbbbbbbbb.``````````#bbbbbbb
+bbb`",
"`bbbbbbbbbbbbbb.````#bbbbbbbbb#bbbbbbbbbbbbbbbbbbb#``````````.bbbbbbb
+bbb`",
"`bbbbbbbbbbbbb.````.bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#``````````.bbbbbbb
+bbb`",
"`bbbbbbbbbbbbb``````#bbbbbbbbb#bbbbbbbbbbbbbbbbbbbb```````````bbbbbbb
+bbb`",
"`bbbbbbbbbbbb.```.`.bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#```````````bbbbbbb
+bbb`",
"`bbbbbbbbbbbb#````..#bbbbbbbbb#bbbbbbbbbbbbbbbbbbbb``````````.bbbbbbb
+bbb`",
"`bbbbbbbbbbbb.````..bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#``````````.bbbbbbb
+bbb`",
"`bbbbbbbbbbbb#`.#.`.bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#```````.``.bbbbbbb
+bbb`",
"`bbbbbbbbbbbbb####.`##bbbbbbbb#bbbbbbbbbbbbbbbb###.``````````.bbbbbbb
+bbb`",
"`bbbbbbbbbbbb######.`.#bbbbbbb#bbbbbbbbbbbbbbbb###b`````````.bbbbbbbb
+bbb`",
"`bbbbbbbbbbb#.######.`.#bbbbbbbbbbbbbbbbbbbbbbb####````````.##bbbbbbb
+bbb`",
"`bbbbbbbbbb#..#######```#bbbbbb#bbbbbbbbbbbbbbb###..``````.###bbbbbbb
+bbb`",
"`bbbbbbbb##.##########```#bbbbbbbbbbbbbbbbbbb#####..`````..###bbbbbbb
+bbb`",
"`bbbbb###.#.##########.```#bbbbbbbbbbbbbbbbbb#####........####bbbbbbb
+bbb`",
"`bbbb#.################````.#bbbbbbbbbbbbbbbb##.##.#.....######bbbbbb
+bbb`",
"`bbbb##################.````.bbbbbbbbbbbbbbbb##..##.#...########bbbbb
+bbb`",
"`bbbb###################`````bbbbbbbbbbbbbbbbb#..################bbbb
+bbb`",
"`bbbb###################.````#bbbbbbbbbbbbbbb##...################bbb
+bbb`",
"`bbbb#.##################.``#bbbbbbbbbbbbbbbb#`..##################bb
+bbb`",
"`bbbb#.####################bbbbbbbbbbbbbbbbb#``..###################b
+bbb`",
"`bbbb#####################.#bbbbbbbbbbbbbb#.```..###################b
+bbb`",
"`bbbb#.####################.bbbbbbbbbbbbb#`````..##################bb
+bbb`",
"`bbbb#####################...#bbbbbbbb##.``````.##################bbb
+bbb`",
"`bbbb..####################.``..#....``````````..#.##############bbbb
+bbb`",
"`bbbb#..#.################...`````````````````...###########.##bbbbbb
+bbb`",
"`bbbb#.........##########.#..``````````````````...##.#####..#bbbbbbbb
+bbb`",
"`bbbbbb#..........####.#....``````````````````..#..###.....#bbbbbbbbb
+bbb`",
"`bbbbbbbbbb#.................``..###########..`...#..#....bbbbbb.``.b
+bbb`",
"`bbbbbbbbbbbbb#........#...`.#bbbbbbbbbbbbbbbb.`.........bbbbbb.````.
+bbb`",
"`bbbbbbbbbbbbbbbbb#......`..bbbbbbbbbbbbbbbbbb#.`.......bbbbbbb``bb``
+bbb`",
"`bbbbbbbbbbbbbbbbbbb#..``.#bbbbbbbbbbbbbbbbbbbb#.```..#bbbbbbbb``bb#`
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb.``.bbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb````bbb
+bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bbb`",
"#.bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+bb.#",
"a#```````````````````````````````````````````````````````````````````
+``#a"
};
EOXPM
}

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://262592]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (4)
As of 2020-09-23 21:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I donít succeed, I Ö










    Results (132 votes). Check out past polls.

    Notices?