Automatically Resizing Font to Fit Window

In c.l.t there was a request for:

I was wondering if there is a proc already out there that will scale up and down the font sizes proportional to the changes in the window size.

I did not see one, so this is what I wrote up this morning:

proc resizeFont {win text args} {
    set ret [font create {*}$args]
    font configure $ret -size 1
    global resizedFonts
    lappend resizedFonts($win) [list $ret $text]
    bind $win <Configure> [list calculateFontResize $win]
    return $ret
}

proc calculateFontResize {win} {
    global resizedFonts
    set w [winfo width $win]
    foreach f $resizedFonts($win) {
        foreach {font text} $f break
        while {[font measure $font $text] < $w} {
            font configure $font -size [expr {[font configure $font -size]+1}]
        }
        while {[font measure $font $text] > $w} {
            font configure $font -size [expr {[font configure $font -size]-1}]
        }
    }        
}

set labelText "This is some text"
pack [label .l -text $labelText -border 3 -relief ridge] -fill both -expand yes
.l configure -font [resizeFont .l $labelText -weight bold -underline 1]

It deals with resizing to fit width, but makes no provision for height.