Bounding boxes of characters in canvases

if 0 {

Purpose: Show how to find where a single character within a text item is located on a Tk canvas.

David Coolbear wrote in comp.lang.tcl:

 Assume I have a TK canvas witch contains a text item. I insert several
 lines of text. I want to know the pixel coordinants of a specific letter
 so I can align a graphic with the text. I know the line number and the
 column number of the letter. I know I can easily use bbox to find the
 coordinants of the text item but I can't figure out how to get the
 coordinants of a specific letter.

One possible answer to his question is the following procedure. The demo main program that follows it illustrates what it does by creating a canvas, creating a text item within it, and outlining the bounding box of each character within the item.

--KBK (22 Jan 2001)


Bryan Oakley 22 Nov 2005 - Kevin, this rocks! I added one tiny bit of code to normalize the index; without this it chokes if you pass in "insert" or any of the other non-numeric forms of indices.


Usman Muzaffar 15 Jun 2006 - I think there's a bug in the calculation of charYMax: it's incorrectly using itemYMin instead of itemXMin as the x-coordinate. What's surprising is how often this doesn't make a difference!

}

 #----------------------------------------------------------------------
 #
 # canvCharBBox --
 #
 #       Compute the bounding box of a single character within a
 #       text item on a canvas.
 #
 # Parameters:
 #       canvas -- Path name of the canvas widget
 #       tagOrId -- Tag or ID of the text item
 #       index -- Character index within the text item.  It is legal
 #                for the character index to be equal to the length
 #                of the string, in which case the returned bounding
 #                box will give the dimensions of the 'dead space'
 #                at the right of the bottom line.
 #
 # Results:
 #       Returns the bounding box of the selected character, or an empty
 #       list if the character is not found.
 #
 # Bugs:
 #       If a line does not begin at the leftmost extent of the text
 #       item, the bounding box of the leftmost character in the line
 #       includes the 'dead space' to the left of the line.
 #
 # Author:
 #       Kevin Kenny <[email protected]>
 #
 #----------------------------------------------------------------------
 
 proc canvCharBBox { canvas tagOrId index } {
 
     # Begin by locating the bounding box of the entire item
 
     foreach { itemXMin itemYMin itemXMax itemYMax } [$canvas bbox $tagOrId] {
         break
     }

     # Normalize the index
     
     if {![string is integer -strict $index]} {
         set index [$canvas index $tagOrId $index]
     }

     # Locate the greatest Y for which the character index of the
     # right edge of the box is less than $index.  This co-ordinate
     # is the lower bound of Y
 
     set charYMin [expr { $itemYMin - 1 }]
     set y0 $itemYMin
     set y1 $itemYMax
     while { $y1 >= $y0 } {
         set y2 [expr { ( $y0 + $y1 ) / 2 }]
         if { [$canvas index $tagOrId @$itemXMax,$y2] < $index } {
             set charYMin $y2
             set y0 [expr { $y2 + 1 }]
         } else {
             set y1 [expr { $y2 - 1 }]
         }
     }
 
     # Locate the least Y for which the character index of the left edge
     # of the box is greater than $index.  This co-ordinate is the upper
     # bound of Y
 
     set charYMax [expr { $itemYMax + 1 }]
     set y0 [expr { $charYMin + 1 }]
     set y1 $itemYMax
     while { $y1 >= $y0 } {
         set y2 [expr { ( $y0 + $y1 ) / 2 }]
         if { [$canvas index $tagOrId @$itemYMin,$y2] > $index } {
             set charYMax $y2
             set y1 [expr { $y2 - 1 }]
         } else {
             set y0 [expr { $y2 + 1 }]
         }
     }
 
     # Now go probing on the midpoint of the line of characters for
     # the greatest X for which the character index is less than
     # $index.  This co-ordinate is the lower bound for X
 
     set charXMin [expr { $itemXMin - 1 }]
     set y [expr { ( $charYMin + $charYMax ) / 2 }]
     set x0 $itemXMin
     set x1 $itemXMax
     while { $x1 >= $x0 } {
         set x2 [expr { ( $x0 + $x1 ) / 2 }]
         if { [$canvas index $tagOrId @$x2,$y] < $index } {
             set charXMin $x2
             set x0 [expr { $x2 + 1 }]
         } else {
             set x1 [expr { $x2 - 1 }]
         }
     }
 
     # Finally, probe on the midpoint of the line of characters for
     # the smallest X for which the character index is greater than
     # $index.  This co-ordinate is the upper bound of X.
 
     set charXMax [expr { $itemXMax + 1 }]
     set x0 [expr { $charXMin + 1 }]
     set x1 $itemXMax
     while { $x1 >= $x0 } {
         set x2 [expr { ( $x0 + $x1 ) / 2 }]
         if { [$canvas index $tagOrId @$x2,$y] > $index } {
             set charXMax $x2
             set x1 [expr { $x2 - 1 }]
         } else {
             set x0 [expr { $x2 + 1 }]
         }
     }
 
     # Return the computed bounding box.
 
     return [list \
                 [expr { $charXMin + 1 }] \
                 [expr { $charYMin + 1 }] \
                 [expr { $charXMax - 1 }] \
                 [expr { $charYMax - 1 }] ]
 
 
 }
 
 # DEMO
 
 grid [canvas .c -width 200 -height 200]
 set string "Joe's\nBar and\nGrill"
 .c create text 100 100 -text $string \
     -justify center \
     -font {Helvetica 36 bold} -fill white -tags theText 
 
 for { set i 0 } { $i <= [string length $string] } { incr i } {
     foreach { x0 y0 x1 y1 } [canvCharBBox .c theText $i] break
     puts [format "char %2d: %3d %3d %3d %3d" $i $x0 $y0 $x1 $y1]
     set x2 [expr { ( $x0 + $x1 ) / 2 }]
     set y2 [expr { ( $y0 + $y1 ) / 2 }]
     .c create rectangle $x0 $y0 $x1 $y1 -fill {} -outline black
     .c create text $x2 $y2 -text $i -font {Helvetica 8} -fill black
 }