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. ---- } #---------------------------------------------------------------------- # # 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 # #---------------------------------------------------------------------- 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 } ---- [Category Graphics] - [Arts and Crafts of Tcl-Tk Programming]