# 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 break } 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 break } else { incr ix -1 set size [lindex $bigtext(sizes) $ix] set mode "down" } } else { break } } # 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} { break } 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 .bWhen I press the button, my widget just disappears.
Tcl2002 programming contest: problem 2The Great Canadian Tcl/Tk Programming Contest, eh?