in reply to Re^2: Eliminate blinking cursor from text widget
in thread Eliminate blinking cursor from text widget
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.
Creative tag manipulation#!/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;}
More 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;
#!/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"; }
|
|---|