#!/usr/bin/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",
"#.bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb.#",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbb````bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbb.``.bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbb`#bb``bbbbbbbbbbbbbbbbbbbbb#.`````..#bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbb``bb``bbbbbbbbbbbbbbbbbbb#.```````````#bbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbb.````.bbbbbbbbbbbbbbbbbb.``````````````.bbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbb.``.bbbbbbbbbbbbbbbbbb#`````````````.```bbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb#`````````````..```.bbbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb.`````````````...```#bbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb````````````````````.bbbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`````````````````````#bbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`````````````````````.bbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb.``````````````````````bbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb.````````````...```````bbbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#``.#.``````..##.``````#bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb.``##b#````##b#b.``````#bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`.#.#b.```#b..#b.`````.bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`.``.#.``.b.``.##`````#bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#`..`..#```#.```#b`````.bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb#``.``.....#````#b`````#bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``#.`######..`.##`````.bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``..############``````.bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``..####b#######.``````bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb`..#######b#####.``````bbbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``.####b######.#.``````#bbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``..###########..``.```.bbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb``...#######.....``...``bbbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb.`#....#.#....###```..``.bbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbb.`##........##bbb.```.```bbbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbb.``###.....####bbb#```````.bbbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbb#```bb#########bbbbb.```````#bbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbb```#bb#######bbbbbbbb````````bbbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbb.``.bbbb####bbbbbbbbbb.```````.bbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbb#```bbbbbbb#bbbbbbbbbbb#````````bbbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbb```.bbbbbbbbbbbbbbbbbbbb.````````bbbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbb.```bbbbbbbbbbbbbbbbbbbbb.`````````bbbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbbb.```.##bbbbbb#bbbbbbbb#b#b#`````````.bbbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbb.````..b#bbb#b#bbbb#b######b``````````#bbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbbb`````.#b#bbbbbbbbbbbbb#b###b#``````````bbbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbb#````.#bbbbbbb#bbbbbbbbbbbb##b.`````````#bbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbb.````##bbbbbbbbbbbbbbbbbbbbb###``````````bbbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbb````.#bbbbbbbbbbbbbbbbbbbbbbbb#.`````````#bbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbbb````#bbbbbbbbbbbbbbbbbbbbbbbbbb#``.``````.bbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbb.```.#bbbbbbbbbbbbbbbbbbbbbbbbbbb`.``.`````bbbbbbbbbbbb`",
"`bbbbbbbbbbbbbbbb````.bbbbbbbbb#bbbbbbbbbbbbbbbbbb.`````````#bbbbbbbbbbb`",
"`bbbbbbbbbbbbbbb.````bbbbbbbbbb#bbbbbbbbbbbbbbbbbb.`````````.bbbbbbbbbbb`",
"`bbbbbbbbbbbbbbb.```.bbbbbbbbb#bbbbbbbbbbbbbbbbbbb.``````````bbbbbbbbbbb`",
"`bbbbbbbbbbbbbb#````#bbbbbbbbb#bbbbbbbbbbbbbbbbbbb.``````````#bbbbbbbbbb`",
"`bbbbbbbbbbbbbb.````#bbbbbbbbb#bbbbbbbbbbbbbbbbbbb#``````````.bbbbbbbbbb`",
"`bbbbbbbbbbbbb.````.bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#``````````.bbbbbbbbbb`",
"`bbbbbbbbbbbbb``````#bbbbbbbbb#bbbbbbbbbbbbbbbbbbbb```````````bbbbbbbbbb`",
"`bbbbbbbbbbbb.```.`.bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#```````````bbbbbbbbbb`",
"`bbbbbbbbbbbb#````..#bbbbbbbbb#bbbbbbbbbbbbbbbbbbbb``````````.bbbbbbbbbb`",
"`bbbbbbbbbbbb.````..bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#``````````.bbbbbbbbbb`",
"`bbbbbbbbbbbb#`.#.`.bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#```````.``.bbbbbbbbbb`",
"`bbbbbbbbbbbbb####.`##bbbbbbbb#bbbbbbbbbbbbbbbb###.``````````.bbbbbbbbbb`",
"`bbbbbbbbbbbb######.`.#bbbbbbb#bbbbbbbbbbbbbbbb###b`````````.bbbbbbbbbbb`",
"`bbbbbbbbbbb#.######.`.#bbbbbbbbbbbbbbbbbbbbbbb####````````.##bbbbbbbbbb`",
"`bbbbbbbbbb#..#######```#bbbbbb#bbbbbbbbbbbbbbb###..``````.###bbbbbbbbbb`",
"`bbbbbbbb##.##########```#bbbbbbbbbbbbbbbbbbb#####..`````..###bbbbbbbbbb`",
"`bbbbb###.#.##########.```#bbbbbbbbbbbbbbbbbb#####........####bbbbbbbbbb`",
"`bbbb#.################````.#bbbbbbbbbbbbbbbb##.##.#.....######bbbbbbbbb`",
"`bbbb##################.````.bbbbbbbbbbbbbbbb##..##.#...########bbbbbbbb`",
"`bbbb###################`````bbbbbbbbbbbbbbbbb#..################bbbbbbb`",
"`bbbb###################.````#bbbbbbbbbbbbbbb##...################bbbbbb`",
"`bbbb#.##################.``#bbbbbbbbbbbbbbbb#`..##################bbbbb`",
"`bbbb#.####################bbbbbbbbbbbbbbbbb#``..###################bbbb`",
"`bbbb#####################.#bbbbbbbbbbbbbb#.```..###################bbbb`",
"`bbbb#.####################.bbbbbbbbbbbbb#`````..##################bbbbb`",
"`bbbb#####################...#bbbbbbbb##.``````.##################bbbbbb`",
"`bbbb..####################.``..#....``````````..#.##############bbbbbbb`",
"`bbbb#..#.################...`````````````````...###########.##bbbbbbbbb`",
"`bbbb#.........##########.#..``````````````````...##.#####..#bbbbbbbbbbb`",
"`bbbbbb#..........####.#....``````````````````..#..###.....#bbbbbbbbbbbb`",
"`bbbbbbbbbb#.................``..###########..`...#..#....bbbbbb.``.bbbb`",
"`bbbbbbbbbbbbb#........#...`.#bbbbbbbbbbbbbbbb.`.........bbbbbb.````.bbb`",
"`bbbbbbbbbbbbbbbbb#......`..bbbbbbbbbbbbbbbbbb#.`.......bbbbbbb``bb``bbb`",
"`bbbbbbbbbbbbbbbbbbb#..``.#bbbbbbbbbbbbbbbbbbbb#.```..#bbbbbbbb``bb#`bbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb.``.bbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb````bbbbbb`",
"`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb`",
"#.bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb.#",
"a#`````````````````````````````````````````````````````````````````````#a"
};
EOXPM
}

##</code><code>##

#!/usr/bin/perl
use strict;
use Tk;
use Tk::Balloon;

my $dx;
my $dy;
my $balloonhash = {};
my $statushash  = {};

my $mw        = tkinit;
my $c         = $mw->Canvas->pack;
my $statusbar = $mw->Label->pack( -fill => 'x' );

my $b = $c->Balloon(
    -initwait        => 0,
    -statusbar       => $statusbar,
    -balloonposition => 'mouse'
);

$b->attach(
    $c,
    -initwait      => 75,
    -balloonmsg    => $balloonhash,
    -statusmsg     => $statushash,
    -cancelcommand => \&checktag
);

for my $i ( 0 .. 4 ) {

    my $item = $c->create(
        'rect',
        $i * 20, $i * 20, $i * 20 + 20,
        $i * 20 + 20,
        -fill => 'red',
        -tags => ["TAF$i", 'group1', 'move']
    );

    $balloonhash->{$item} = "Balloon $i WITH tag";
    $statushash->{$item}  = "Status message $i WITH tag";


    my $item2 = $c->create(
        'rect', $i * 20 + 20,
        $i * 20,
        $i * 20 + 40,
        $i * 20 + 20,
        -fill => 'green',
	-tags => ['group2','move']
    );
    $balloonhash->{$item2} = "Balloon $i with NO tag";
    $statushash->{$item2}  = "Status message $i NO tag";
}

$c->bind('move', '<1>', sub {&mobileStart();});
$c->bind('move', '<B1-Motion>', sub {&mobileMove();});
$c->bind('move', '<ButtonRelease>', sub {&mobileStop();});

MainLoop;

sub checktag {
    if ( grep /TAF/, $c->gettags('current') ) {
        return 0;
    }
    else {
        return 1;
    }
}

sub mobileStart {
      my $ev = $c->XEvent;
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      $c->raise('current');
      print "START MOVE->  $dx  $dy\n";
}

sub mobileMove {
      my $ev = $c->XEvent;
      
     #you can drag individuals or whole groups 
     # $c->move('current', $ev->x + $dx, $ev->y +$dy);
     
     if ( grep /TAF/, $c->gettags('current') ) {
       $c->move('current', $ev->x + $dx, $ev->y +$dy);
     }else{
       $c->move('group2', $ev->x + $dx, $ev->y +$dy);
     }
      
     ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      print "MOVING->  $dx  $dy\n";
}

sub mobileStop{&mobileMove;}

##</code><code>##

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $dx;
my $dy;
my $grouptag; 

my $mw = MainWindow->new;
$mw->geometry("700x600");

my $x1 = 50;
my $x2 = 100;
my $y1 = 50;
my $y2 = 200;

my $c = $mw->Canvas(-width => 700, -height => 565,
                -bg => 'black',
		   )->pack;

my $closebutton = $mw->Button(-text => 'Exit', -command => sub{Tk::exit(0)})
               ->pack; 

my $parent = $c->createOval($x1, $y1, $x2, $y2, 
                             -fill => 'red',
			     -tags => ['mover','group1'],
			     );

my @children;
for (1..4) {
    push @children, $c->createLine(($x1 + $x2)/2,$y1, (2 * $x2), (2 * $y2),
        #   -state =>'disabled', 
           -fill => 'white',
           -activefill  => 'green',
	   -disabledfill => 'white',
	   -tags => ['mover','group1','line','line'.$_],    
	   );
        
    $x1 += 15; $x2 += 15;
         }

$c->bind('mover', '<1>', sub {&mobileStart();});
$c->bind('mover', '<B1-Motion>', sub {&mobileMove();});
$c->bind('mover', '<ButtonRelease>', sub {&mobileStop();});

MainLoop;

sub mobileStart {
      my $ev = $c->XEvent;
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
 
      my $curr_object = $c->find('withtag','current'); 
          print "curr->",@$curr_object,"\n";  #array dereference 
           my (@list) = $c->gettags($curr_object); 
           print "movelist->@list\n"; 

#         if( grep /line/, @list){ 
#	         ($grouptag) = grep /(line\d+)/, @list; 
#	 } else {($grouptag) = grep /(group\d+)/, @list; }
# JKrahn
#You are grep()ing through @list twice! and using capturing parentheses!  Ick!            
#this is better
          unless ( ( $grouptag ) = grep /line\d/, @list ) {                              
              ( $grouptag ) = grep /group\d/, @list;                                     
              }                                                                          
    #      print "grouptag-> $grouptag\n";
    #      print "START MOVE->  $dx  $dy\n";
}

sub mobileMove {
      my $ev = $c->XEvent;
      $c->move($grouptag, $ev->x + $dx, $ev->y +$dy);
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
     # print "MOVING->  $dx  $dy\n";
}

sub mobileStop{&mobileMove;}


##</code><code>##

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::JPEG;
use Tk::PNG;

my $file = shift || die "need a bmp, gif,jpg or png as arg 1\n";

my ($dx,$dy);
my $mw  = Tk::MainWindow->new;

$mw->fontCreate('big',
   -family=>'arial',
   -weight=>'bold',
   -size=> 30);

my $can = $mw->Scrolled('Canvas',
                 -height => 400,
		 -width  => 400,
		 -scrollbars => 'osoe',
                 -highlightthickness=>0,
		 -borderwidth =>0,
                 )->pack( -fill =>'both',-expand=>1);

my $realcan = $can->Subwidget('scrolled');

my $img = $mw->Photo( -file => $file );

$can->createImage(0,0,  #hardcoded offset
                  -image => $img, 
		  -anchor => 'nw',
		  -tags => ['img'],
		   );

my @bbox = $can->bbox( 'img'  );

$can->configure(-scrollregion => [@bbox] );

my $text = 'This is some text';
$can->createText(50,50,
    -text   => $text,
    -fill =>'yellow',
    -anchor => 'nw',
    -font   => 'big',
    -tags=> ['move']
    );

$realcan->bind('move', '<1>', sub {&mobileStart();});
$realcan->bind('move', '<B1-Motion>', sub {&mobileMove();});
$realcan->bind('move', '<ButtonRelease>', sub {&mobileStop();});

MainLoop;

sub mobileStart {
      my $ev = $realcan->XEvent;
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      $realcan->raise('current');
      print "START MOVE->  $dx  $dy\n";
}

sub mobileMove {
      my $ev = $realcan->XEvent;
      $realcan->move('current', $ev->x + $dx, $ev->y +$dy);
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      print "MOVING->  $dx  $dy\n";
}

sub mobileStop{&mobileMove;}