Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Tk Canvas Items Drag

by msemtd (Scribe)
on Jun 03, 2003 at 08:44 UTC ( [id://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
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://262592]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others musing on the Monastery: (8)
As of 2024-03-28 10:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found