Discipulus has asked for the wisdom of the Perl Monks concerning the following question:
Hello monks and nuns!
before the end of the Tk questions months I have another tk question.
My goal is to have a canvas filling the mainwindow and I want to drow squares into this canvas to have evenly divided as a chessboard.
The first question about mainwindow geometry was already answered by the wise kcott in the CB, but I also put it here for completeness and for future readers:
- A mainwindow with geometry 100x100 goes from 0,0 to 100,100 ie it has 101 pixels! I found this very misleading.. but anyway it'snot the only problem i have.
Infact, even using a mainwindow with geometry 99x99 I have undesired pixels here and there: in the program below I try to create 4 squares to fulfill the main canvas (but they do not arrive at the east and south borders: run it to see). Also the pixel used to outline the square are problematic..
- canvas objects support the outline properties: is this added to the object area? I mean a square 50x50 with outline enabled (and is by default) ,means actually 51x51 one? It seems so: run my program and notice that north and west outlines are not shown as if they are outside of the visible area ( so -1,-1 as starting point).
Notice that -outline => undef means transparent (you'll see the red of the main big canvas underlying), but specifying no outline assumes black as default .
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
# uncomment if module is installed
# use Tk::WidgetDump;
my ($dx,$dy);
my $mw = Tk::MainWindow->new();
# kcot gently confirmed that 100x100 in geometry means
# from 0,0 to 100,100 aka 101 pixels!!
$mw->geometry("99x99");
# main underlying canvas is filled with RED
my $can = $mw->Canvas(
-height => 100,
-width => 100,
-bg => 'red',
)->pack( );
# used to dump coordinates
my %board;
# alternate colors for tales
my @alt_col = qw(gold2 green);
# squares for tales starting at 0,0
my ($sq_x,$sq_y) = (0,0);
foreach my $letter (('A'..'B')){
unshift @alt_col, pop @alt_col;
foreach my $num (1..2){
# cycle colors
unshift @alt_col, pop @alt_col;
$can->createRectangle($sq_x, $sq_y, $sq_x+49,$sq_y+49,
-fill => $alt_col[0],
# outline undef means ransparent outline
# if not specified defaults to black outline
-outline => undef ,
-tags=> ['first']
);
$board{$letter.$num} = {tx=>$sq_x,ty=>$sq_y,bx=>$sq_x+49,by=>$
+sq_y+49};
# add 50
$sq_x += 50;
}
# reset x to 0 for new row
$sq_x = 0;
# add 50 to y
$sq_y += 50;
print "\n";
}
# legenda
print "ty = top Y tx = top X by = bottom Y bx = bottom X\n";
# dump board coordinates
foreach my $key (sort keys %board){
print "$key -> ",
( map{"$_ $board{$key}{$_} "}
reverse sort keys %{$board{$key}}
),"\n";
}
$can->bind('first', '<1>', sub {&show_click();});
# uncomment if module is installed
# $mw->WidgetDump;
MainLoop;
sub show_click{
my $ev = $can->XEvent;
($dx, $dy) = ($ev->x, $ev->y);
print "CLICKED $dx $dy\n";
my $cur_id = ($can->find('withtag','current'))[0];
print "current canvas $cur_id\n\n";
}
What the program outputs seems what I want; ie squares of 50 pixels sides:
ty = top Y tx = top X by = bottom Y bx = bottom X
A1 -> ty 0 tx 0 by 49 bx 49
A2 -> ty 0 tx 50 by 49 bx 99
B1 -> ty 50 tx 0 by 99 bx 49
B2 -> ty 50 tx 50 by 99 bx 99
But what is shown on the screen seems misplaced toward north-west by one or more pixels. Also: when I dump the canvas I get:
# main canvas
width: 104
height: 99
reqwidth: 104
reqheight: 104
# squares coordinates dumped (from top left to bottom right) are:
0,0,49,49
50,0,99,49
0,50,49,99
50,50,99,99
# that reflect what I want
Thanks for the patience and happy Tk month!
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Re: Tk geometry, pixel coordinates precision, canvas and outline
by zentara (Archbishop) on Apr 23, 2018 at 15:46 UTC
|
Hi Discipulus!! Here is another chessboard I used. It has realistic looking squares. I hope it adds some inspiration. :-)
#!/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__
| [reply] [Watch: Dir/Any] [d/l] |
Re: Tk geometry, pixel coordinates precision, canvas and outline
by tybalt89 (Monsignor) on Apr 23, 2018 at 14:18 UTC
|
1. You may be seeing the highlight rectangle. Add -highlightthickness => 0, to your canvas.
(Is the highlightthickness the reason it looks like there is an extra pixel?)
2. the reason you are seeing red background is that createRectangle does not draw two edges.
$canvas->createRectangle(x1, y1, x2, y2, ?option, value, optio
+n, value, ...?)
The arguments x1, y1, x2, and y2 give the coordinates of two di
+agonally opposite corners of the
rectangle (the rectangle will include its upper and left edges
+but not its lower or right edges).
Does the following do what you want ?
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
# uncomment if module is installed
# use Tk::WidgetDump;
my ($dx,$dy);
my $mw = Tk::MainWindow->new();
# kcot gently confirmed that 100x100 in geometry means
# from 0,0 to 100,100 aka 101 pixels!!
#$mw->geometry("99x99");
# main underlying canvas is filled with RED
my $can = $mw->Canvas(
-height => 100,
-width => 100,
-bg => 'red',
-highlightthickness => 0,
)->pack( );
# used to dump coordinates
my %board;
# alternate colors for tales
my @alt_col = qw(gold2 green);
# squares for tales starting at 0,0
my ($sq_x,$sq_y) = (0,0);
foreach my $letter (('A'..'B')){
unshift @alt_col, pop @alt_col;
foreach my $num (1..2){
# cycle colors
unshift @alt_col, pop @alt_col;
$can->createRectangle($sq_x, $sq_y, $sq_x+50,$sq_y+50,
-fill => $alt_col[0],
# outline undef means ransparent outline
# if not specified defaults to black outline
-outline => undef ,
-tags=> ['first']
);
$board{$letter.$num} = {tx=>$sq_x,ty=>$sq_y,bx=>$sq_x+49,by=>$
+sq_y+49};
# add 50
$sq_x += 50;
}
# reset x to 0 for new row
$sq_x = 0;
# add 50 to y
$sq_y += 50;
print "\n";
}
# legenda
print "ty = top Y tx = top X by = bottom Y bx = bottom X\n";
# dump board coordinates
foreach my $key (sort keys %board){
print "$key -> ",
( map{"$_ $board{$key}{$_} "}
reverse sort keys %{$board{$key}}
),"\n";
}
$can->bind('first', '<1>', sub {&show_click();});
# uncomment if module is installed
# $mw->WidgetDump;
MainLoop;
sub show_click{
my $ev = $can->XEvent;
($dx, $dy) = ($ev->x, $ev->y);
print "CLICKED $dx $dy\n";
my $cur_id = ($can->find('withtag','current'))[0];
print "current canvas $cur_id\n\n";
}
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
use Tk;
my $mw = Tk::MainWindow->new();
my $can = $mw->Canvas(
-height => 100,
-width => 100 ,
-bg => 'red',
-highlightthickness => 0,
)->pack( );
$can->createRectangle(0,0,101,101,
-fill => 'gold2',
#-outline => undef ,
#-width => 10,
);
MainLoop;
With #-outline => undef , the black, 1px outline is shown in North and West sides but no in other ones. This seems to prove that the outline width is added to. By other hand with -outline => undef no red background in shown so the yellow square fills the correct 100x100 region.
The weird part is that it seems that just first pixel is managed in this way, ie shifting the yellow square toward SE: infact using -width => 10 (the width of the outline!) the yellow square remains centerd..
- 2 Thanks i overlooked this part of the docs.. So I must always consider 1 pixel more while drawing rectangles, even with no outline.
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
|