in reply to Eliminate blinking cursor from text widget

Just a basic design comment, regarding the need to remove the cursor.

Why even use the Text widget? A Canvas can also display any chess font which the Text widget can. The Canvas won't have a cursor to deal with, plus gives many options for implementing drag'n'drop, etc.

Here is a chessboard for you to start with. 

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

my @oddrow =  qw(d l d l d l d l);
my @evenrow = qw(l d l d l d l d);

#inline base64_encoded images are 70 x 70
my ($cWidth, $cHeight) = (8 * 70, 8*70);

my $w = $cWidth + 70;
my $h = $cHeight + 70;
my $mw = MainWindow->new;
$mw->geometry($w.'x'.$h);

my $c = $mw->Canvas( 
   -bg => 'lightsteelblue',
   -width => $cWidth + 140,
   -height => $cHeight + 140)->pack;

my $dimage = $mw->Photo(-data => get_dark() );
my $limage = $mw->Photo(-data => get_light() );

my %marker;
my %square;

foreach my $row(1..8){ 
     my @template;
     if($row % 2){ @template = @oddrow }else{ @template = @evenrow };

  foreach my $col (1..8) { 
     my $image;
     my $colortag = shift @template;
     if ($colortag eq 'd'){$image = $dimage}else{$image = $limage}

     $square{$row}{$col} = $c->createImage ($row * 70 , $col *70,
        -image => $image,
        -tags=>['square', $colortag ,"row.$col", "col.$row"] );
         # row col hack to make everything "normal" :-)
   
     $marker{$row}{$col} = $c->createRectangle(
                         $row * 70 - 9, $col *70 -9 ,
                         $row * 70 + 9, $col *70 + 9, 
                         -fill=>'lightyellow',
                         -tags => ['rect', $colortag ,"row.$col", "col
+.$row"],
                         );
      
  }
}

$c->lower('rect','square'); #hide the rects under the squares

$c->bind('square', '<Button-1>', \&click );
$c->bind('square', '<Button-3>', \&clickout );
$c->bind('rect',   '<Button-3>', \&clickout );

MainLoop;

sub findtag {
  my ($canv) = @_;
  my $id = $canv->find('withtag', 'current');
  my @tags = $canv->gettags($id);
  print "@tags\n";
  my ($r) = ( grep /^row\d*/, @tags );
  my ($c) = ( grep /^col\d*/, @tags );
  my($row)= $r =~ /(\d+)/;
  my($col)= $c =~ /(\d+)/;
  print "$row $col\n";
  return ($id,$row,$col);
}

sub click{
  my ($canv) = @_;
  my ($id,$row,$col) = findtag($canv);
  print "$row $col clicked\n";
   $canv->raise($marker{$col}{$row},$square{$col}{$row});
}

sub clickout{
  my ($canv) = @_;
  my ($id,$row,$col) = findtag($canv);
  print "$row $col clickedout\n";
   $canv->raise($square{$col}{$row});
}

sub get_dark{
return 
'/9j/4AAQSkZJRgABAQEASABIAAD//gAXQ3JlYXRlZCB3aXRoIFRoZSBHSU1Q/+EAFkV4a
+WYAAE1N
ACoAAAAIAAAAAAAA/9sAQwAFAwQEBAMFBAQEBQUFBgcMCAcHBwcPCwsJDBEPEhIRDxEREx
+YcFxMU
GhURERghGBodHR8fHxMXIiQiHiQcHh8e/9sAQwEFBQUHBgcOCAgOHhQRFB4eHh4eHh4eHh
+4eHh4e
Hh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4e/8AAEQgARgBGAwEiAAIRAQ
+MRAf/E
ABoAAAMBAQEBAAAAAAAAAAAAAAADBAIBBQj/xAAsEAACAgEEAQIFBAMBAAAAAAABAgMRAA
+QSITFB
UWEFEyJxkSMygbFCocFS/8QAGwEAAgMAAwAAAAAAAAAAAAAAAgMAAQQFBgf/xAAdEQACAw
+EBAAMA
AAAAAAAAAAAAAQIRITESA0JR/9oADAMBAAIRAxEAPwD55B3Exn0B4yvUIEhRX6H1d+uZEL
+DUMoAL
dE3lk0KyRhS1MFvj28Z1Zy1UejMim2HTxkbrUsDZyF5doZVJ+2NllEmilVQPoYGx75PGtA
+EnkgfU
Tj4Rrov0NcfM0kw6oqSAfaskCqpUqb9eMuQ/pzgUSYzdfcZApcUSvqKOMWgNlOuffINnCu
+ASfXEx
Mx007KLA28nrvNbTLsWgdhI548XiUcrFIrHtTS4aiLcjSuzi/wCsM5CzeRQrisMqij3J2A
++JOeeD
Yxe8pqlJfgmvznC9ymSibW7/AIyaeT9aJlWlFH+cyxWmmTJ42KRzRGzXf5zDghI+RtINHx
+jJQV1c
oLdsbv3zsyLSxV+w9V4zTaFoNE6oJPq7jPJ6JxKEzEItCs3o0LTpuWkDAf8AMxuA1Xy416
+bbfnvL
orjEPKYpfoNm7zmo2xTHnsX/AB3mJo3SVgP8Tz+cPi7A6ukr9qix9sdFCXg2Fz8sbaA98M
+XptwTb
tPHrhgtCrPZgJQspPis3KVGnDVyrePtmQL1JX/yCW++a1Vto3ANbdpNf7zElpyMqFTANMW
+LVvUf1
nZ3X5qkA0yjrFFS0QIIPAq8dAEMahqsxlb9DhpgURlnGoKx2PrBH5xblo9Y/RKtZOZ+YTJ
+YHJOMn
iK6tixXwSAeDjk6FyZJr5HOqddtCyePfCSGTfGzglqAb/mW6mNX+KVGqlmI765zMyyhEmM
+lOpA2e
Mb6XBXm3pNIkt8sp9h4wz1VgVE3bRIzHn2wxT+YLwjehBfUSDfyyE2MEG+R4yKXaaOGicR
+uZGBKA
0cxLKIZnCgWOqzPtmli/mAbVr1sZzTNv10UQs3x+cbJscRSkMe7v1GS6eQHXq/IG7v05xk
+UiVgg2
HKgXXf5xohkklUsSNx9c46AaiUruI3kC8oikqUbjwR3hyf4D0zK0cOtXddihx5IyKR2Mrq
+R+1/P3
yj4kd2pLhSACDfti50Vp3ok7yeffDjXm2JeSpFWllV0IkYCj64YnRxJEpOwsT3eGKajYWl
+jtt0xP
g81i/iSkagEULjVuPthhgwGrowgPoIQLFE5Pp1UqGN4YZIkfB84VZHVbpzZvErEBJ2eMMM
+sFHTGJ
HKknmM/6xWlhDo/NbaYf1hhjFwD7HpCJABx2LwwwzI2NP//Z';

}


sub get_light{
return 
'/9j/4AAQSkZJRgABAQEAlgCWAAD/4QAWRXhpZgAATU0AKgAAAAgAAAAAAAD/2wBDAAUDB
+AQEAwUE
BAQFBQUGBwwIBwcHBw8LCwkMEQ8SEhEPERETFhwXExQaFRERGCEYGh0dHx8fExciJCIeJB
+weHx7/
2wBDAQUFBQcGBw4ICA4eFBEUHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh
+4eHh4e
Hh4eHh4eHh4eHh7/wAARCABGAEYDASIAAhEBAxEB/8QAGgAAAwEBAQEAAAAAAAAAAAAAAA
+IDBAEF
B//EADIQAAIBAwMCAwUIAwEAAAAAAAECEQADIQQSMUFRBRMiFDJhccEkQoGRobHR8DRSc+
+H/xAAa
AQEBAQEBAQEAAAAAAAAAAAADAgEABAYH/8QAJBEAAgICAQMEAwAAAAAAAAAAAAECEQMhEh
+MxUQQU
QVIyQpH/2gAMAwEAAhEDEQA/APtFo3LtpG9r1RzGL7/zXblq9tJGp1YH/dx9a0aayotLjo
+Ovb9a0
MPSQOGM84r8zeSb3yZ9PJxUuxg9m1JQMus1ZA6jUP+0/tXW02rBC+16xt2QRqX/mt9tdpE
+Lg8DtT
3DHvCCeBzH8Vrnkr8mTzV6R5Vy1qbXqGq1qmADOpeCZ+eK41vUDZ9r1ixg/aHwfzrfq2Bt
+ghpIWY
BrJqLjG0pKY3CQKnq5F+zEik12Bg5bcNTqSVOANQ+f1qNtntt/lazg86hyQJ+dUeGaSu05
+xH1pD/
ALKWx8aN+oyfZiLHHwAJuXGS5rNWAMhjfuAH5eoUUAgMxYJBPac0VXucn2f9N6UfBfS+Yb
+aknG0c
fvV2LhhJiRB+hqViGFoghfTEHmr3VhQ04BwYma6gpNNjIXImQAYMdzS30dlJBIWOvNIhLC
+FPGIPM
1a4dm0K8mR1xNUtoNqnoy6q2zIoZfUB0rPuDW9o97mJyela7z2wRIPaOlQICj19JBxP9+d
+HKx4uk
ADbpPGSZEVNY8wgHIP3frVWbfDTkYxwalcZdwECWEY7ij4/JUWyJJLnacfrRVSqKN7APOM
+xNFcoi
Wh9LcZ7VkkhhtBjqMVuUgp70QPdrJ4ZbD+G6ZpJ9AkEZ4rfbFlh6/lkV6Iq+55MjVkiGck
+A4nPQ5
qvloEBOIPPemW2IkCDkTM9asuxbcAA7es1SQM5mV7W9htIO0yD0rhshQThYB/CrWwA7FZB
+PEVBgo
ukMxkAzFc1ouLZn2rBLYBM/jS30QsWXkHOKtJltsQekc1K6LhAPIEzRVoaL2TDEHIUmB73
+NFduKS
BAkHMgTRUl6H8Jtk+HWTBnaDBPIq9pPSm5iY5isPgGqa74Za2wYXIIrfaYBp7n8qddrCyX
+yZVVKh
WlgPnigMJ2loJOfhXHcQQSAvU9RQqhnKyNvQd65BJKthY2s7KWmBGeD8aXVIm5WbBBgR0q
+toDeYY
Hv3FJq9hKhSCZkGOta2qOTfISAHTzDDR37UmpI2gjBUEkgcgUXYJQk+ocfCo37jG1IM7Zg
+x/YqPg
VJtir5ySQGAMEADvRSXXeRLlcDAOKKnQtM83w7Wey6VLIthmT7081p9tYF32e6cweaKKZR
+Rs3tlB
rUch/LYSdpzmg+IlbxRkJAmCDniaKKrig2OviADqDazPINLe8QDMFNv3TzOeaKK1xRJK74
+gRcQFJ
hoGelP7Sz2SPLGCQPV/5RRWvHHwWjK3iBVRtUzAmT8KKKKzpx8FWf//Z';

}

__END__

[download]
I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Replies are listed 'Best First'.
Re^2: Eliminate blinking cursor from text widget
by chessgui (Scribe) on Jan 16, 2012 at 10:31 UTC
    This is a very professional looking chess board. Do you do chess coding yourself? If there is a complete solution with drag and drop and the rest I'm interested.

    On the other hand doing things by using a canvas is much more complicated. You may know that in chess positions are stored in fen strings. If you substitute slashes with newlines and digits with as many spaces as the digit says in the first field of a fen string you practically have a string which inserted in a text widget represents a chess board (you only have to make corrections for white and black squares). This is a matter of few regular expressions. No screen coordinates, sizes etc. need to be calculated whatsoever making things temptingly simple and quicker as well since the drawing of the board is a matter of $text_widget->insert('1.0',$corrected_fen_string) rather than looping over x and y coordinates, calculating the screen coordinates for each and every square then drawing them.
[reply]
      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;}

      [download]
      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;

      [download]
      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";

}

      [download]
      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom