On the other hand doing things by using a canvas is much more complicated.
Yes, but you get the power to do things like a real game. On a Canvas, the trick is to store the relevant data for each piece in a canvas item tag. It's a simple concept, but hard to grab at first.
Here are a few examples. The first shows how to drag a text item, like your unicode chess piece. You can tell which square they are dropped in by setting up tags on the positional squares. The second example shows how to use tags creatively. The third shows how to dynamically manipulate tags.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::JPEG;
use Tk::PNG;
my ($dx,$dy);
my $mw = Tk::MainWindow->new;
$mw->fontCreate('big',
-family=>'arial',
-weight=>'bold',
-size=> 10);
my $can = $mw->Scrolled('Canvas',
-height => 400,
-width => 400,
-bg => 'black',
-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;}
Creative tag manipulation
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::JPEG;
use Tk::PNG;
#demonstrates need for subwidget method
#on Scrolled Canvas, to use lower or raise
my $mw = new MainWindow;
my $canvas = $mw->Scrolled('Canvas',
-bg => 'white',
-xscrollincrement => 1,
-yscrollincrement => 1,
-confine => 1,
-scrollbars => 'se',
-width => 200,
-height => 200,
-closeenough =>3,
-scrollregion => [ 0, 0, 500, 500 ],
)->pack(qw/ -fill both -expand 1 -side top/);
my $realcanvas = $canvas->Subwidget('scrolled');
$mw->Button(-text=>"Raise Bunny",
-command => sub{
# $canvas->lower( 'bunny' ,'tux' ); # will cause error
# need subwidget of the scrolled canvas
$realcanvas->raise( 'bunny' ,'tux' );
})->pack();
$mw->Button(-text=>"Lower Bunny",
-command => sub{
$realcanvas->lower( 'bunny' ,'tux' );
})->pack();
my $tux = $mw->Photo(-file => 'tux.jpg' );
$canvas->createImage( 0, 0, -image => $tux,
-anchor => 'nw',
-tags => ['tux'],
);
my $bunny = $mw->Photo(-file => 'bunny.jpg' );
$canvas->createImage( 40, 40, -image => $bunny,
-anchor => 'nw',
-tags => ['bunny'],
);
my $lineseg = $canvas->createLine(
1,1,200,200,
-fill => 'red',
-tags => ['line']
);
# $canvas->lower( 'bunny' ,'tux' ); # will cause error
# need subwidget
$realcanvas->lower( 'bunny' ,'tux' );
MainLoop;
More tag manipulation
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $top = new MainWindow;
my $c=$top->Canvas->pack;
my $circle = $c->createOval(30,30,100,100,
-fill => 'blue',
-tags =>['circle'],
-stipple => 'gray12',
);
my $rect1 = $c->createRectangle(10,10,44,44,
-fill => 'green',
-stipple => 'gray12',
-tags =>['rect1'],
);
my $rect2 = $c->createRectangle(93,93,200,200,
-fill => 'yellow',
-tags =>['rect2'],
-stipple => 'gray12',
);
my $poly1 = $c->createPolygon(0,0, 44,44, 55,55, 90,90, 200,200, 10,10
+0,0,0,
-fill => 'red',
-smooth => 1,
-splinesteps => 100,
-stipple => 'gray12',
-tags =>['poly1'],
);
$c->Tk::bind("<Motion>", [ \&print_xy, Ev('x'), Ev('y') ]);
&print_xy($c, 42,42);
MainLoop;
sub print_xy {
my ($canv, $x, $y) = @_;
print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n";
#my $x1 = $x+1;
#my $y1 = $y+1;
#it will actually use a zero size rectangle
my (@current) = $canv->find('overlapping', $x, $y, $x, $y);
foreach my $id(@current){
print $canv->gettags($id),' ';
}
print "\n";
}
|