If you add -state => readonly to a normal Entry widget, it both stops it being edited and prevents the insertion cursor (blinking vertical bar) being shown.

It might have the same effect on a ROText widget too, but you don't need that if you set normal entry widgets readonly.

Thanks a lot.

I also wonder which is the easiest way to determine the field on which I have clicked in terms of _text_ x and y coordinates.



$board_text->bind('<Button-1>',\&click_handler);

sub click_handler
{
my $click_x=...
my $click_y=...

#do sg. whith x,y

}
[download]



What should ... be? (I admit that I haven't dome my research on that one yet.)

If you do the bind like this:

    $ef1->bind( '<Button-1>', [ \&fred, 'bill' ] );
[download]

Then when you click on entry field 1 ($ef1) the subroutine 'fred' will be called with the handle of $ef1 as the first parameter, and the value 'bill' as the second. Now you can program whatever action is required.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

Sorry but the entry widget seems to be limited to one line in height. I need a 8x8 text widget to represent the board.

I take it from that you've been using a multi-line Text widget.

The problem I foresee is that whilst in a Text widget, a button-1 click sets the insertion cursor to the character under the mouse, if you make it readonly and disable the insertion cursor, will the button-1 binding still work?

I would use an 8x8 grid of Entry widgets. That way, each click identifies which symbol is clicked.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

PROBLEM SOLVED:

You should set the insertOnTime option (which controls the time in millisecons for which the blinking cursor is on) to zero.

$text_widget->configure(-insertontime=>0);

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]

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.

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