Tcl2002 programming contest: solutions to problem 2

Only Brent Welch attempted to solve this one. His solution appears below. At least on the Windows platform, it appears to make some errors in the font metrics; at most window sizes, it displays less than the complete text.

 # bigtext
 # Brent Welch
 # Display text in a widget at the largest possible font size
 # without cropping the text, and honoring word wrapping.

 proc bigtext {w family string} {
     global bigtext

     # Clean up from old runs

     catch {destroy $w}
     catch {font delete bigtext}
     catch {font delete shadow}
     unset -nocomplain bigtext

     set bigtext(w) $w
     set bigtext(string) $string

     # Find out the range of supported font sizes
     # I've got scalable fonts, so this is probably extra work

     set size 1
     font create bigtext -family $family -size $size
     set lastsize [font actual bigtext -size]
     lappend bigtext(sizes) $lastsize
     while {$size < 250} {
         incr size
         font configure bigtext -size $size
         set nextsize [font actual bigtext -size]
         if {$nextsize > $lastsize} {
             lappend bigtext(sizes) $nextsize
             set lastsize $nextsize
     font configure bigtext -size 20

     # Create a second font for iteration when resizing
     font create shadow -family $family

     # Approx interline spacing for font-metric based approach
     set bigtext(pad) .7

     # Create a text widget.  We insert a newline so we can
     # probe for the location of location 2.0

     text $w -font bigtext -wrap word
     $w insert 1.0 ${string}\n

     # Bind to configure so we detect resizes
     bind $w <Configure> [list bigtext_conf $w]
 proc bigtext_conf {w} {
    # Not sure if this is important, but we
    # can collapse out multiple configure events
    # by tweaking atime.
    global a atime
    catch {after cancel $a}
    set a [after $atime bigtext_resize $w]
 set atime 200
 proc bigtext_resize {w} {
     global bigtext

     # Find out where we are in the list of fonts
     set size [font actual bigtext -size]
     set ix [lsearch $bigtext(sizes) $size]
     set mode "?"  ;# how we are changing font size

     # Iterate based on font metrics, which are imperfect because we
     # don't know about line wrapping metrics, even with -lmargin1 et al.
     # But this is fast because it can be done without updating the display.

     while {1} {
         set height [bigtext_metrics_height $w $size $bigtext(string)]
         if {$height != {} && $height < [winfo height $w] * .9} {
             incr ix
             if {$ix >= [llength $bigtext(sizes)] || $mode eq "down"} {
                 # We are either at the end of the possible font sizes,
                 # or we just reduced the font size
             set size [lindex $bigtext(sizes) $ix]
             set mode "up"
         } elseif {$height == {} || $height > [winfo height $w]} {
             if {$ix == 0 || $mode eq "up"} {
                 # We are either at the start of the possible font sizes,
                 # or we just increased the font size
             } else {
                 incr ix -1
                 set size [lindex $bigtext(sizes) $ix]
                 set mode "down"
         } else {
     # Now, we could be wrong, so we set the size, then check more
     # carefully with dlineinfo, which requires a redisplay
     font configure bigtext -size $size
     while {[bigtext_text_height $w $size $bigtext(string)] == {}} {
         incr ix -1
         if {$ix == 0} {
         set size [lindex $bigtext(sizes) $ix]
         font configure bigtext -size $size

 # Use the dlineinfo command to find out precisely where the text is,
 # but this has the disadvantage that we have to update the display first.

 proc bigtext_text_height {w size string} {
     global bigtext
     update idletasks ;# ugh
     set dl [$w dlineinfo 2.0]
     if {[llength $dl] == 0} {
         # off the end
         return {}
     } else {
         foreach {x y width height offset} [$w dlineinfo "1.0 lineend"] { break }
         return $y

 # Use font metrics to get an approximate size, but we don't really
 # know, or want to know, how the text widget lays out text.  So,
 # we use bigtext(pad) to approximate interline spacing.  Even if we
 # knew that exactly, we don't want to redo the line wrapping algorithm

 proc bigtext_metrics_height {w size string} {
     global bigtext
     font configure shadow -size $size
     set len [font measure shadow $string]
     set lines [expr ceil($len/[winfo width $w])]
     set h [font metrics shadow -linespace]
     set height [expr $lines * $h + ($lines-1) * $h * $bigtext(pad)]
     return $height

(KBK developed a reference solution prior to the contest, and will post it here soon; alas, it's on a computer that's powered down 3000 miles away. AMG: Is your reference solution available yet?)

HJG I tried to call this procedure in several ways, but I don't get some big text:

  set Text "Hello World"
  set Font "Courier New" ;#  "symbol" # "Times New Roman" # "Verdana"
 #label  .t -text $Text
  text   .t; .t insert end $Text
  button .b -text "bigtext" -command { bigtext .t $Font $Text; bell }
  pack   .t .b

When I press the button, my widget just disappears.

Tcl2002 programming contest: problem 2

The Great Canadian Tcl/Tk Programming Contest, eh?