Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Tk geometry, pixel coordinates precision, canvas and outline

by Discipulus (Canon)
on Apr 23, 2018 at 12:07 UTC ( [id://1213422]=perlquestion: print w/replies, xml ) Need Help??

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.

Replies are listed 'Best First'.
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__

    I'm not really a human, but I play one on earth. ..... an animated JAPH
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"; }
      Thanks master tybalt89 for your insights,
      • 1 yes with -highlightthickness => 0 as in your example everything is looking better. You set this on the main canvas and if I understand affects the frame where rectangles will be drown. But in effect this looks ok until -outline => undef is there. I'm starting to doubt that -outline => undef means a transparent outline: probably it means no outline at all so less pixel used.

      Compare difference if you comment/uncomment -outline => undef in the following snippet:

      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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1213422]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (8)
As of 2024-03-29 13:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found