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
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 2
The Great Canadian Tcl/Tk Programming Contest, eh?