#! 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
}
|