Posted to tcl by kbk at Sun Jan 25 01:11:09 GMT 2009view pretty

package require Tk
set fontlist "8 5 10 9 6 11 10 6 13 12 7 15 14 8 17 16 10 20 18 11 22 24 14 30 30 18 37 36 22 45"
foreach {size width height} $fontlist {
    font create font$size -family {Courier New} -size [expr {-$height}]
    while {[font measure font$size M] > $width} {
	incr height -1
	font configure font$size -size [expr {-$height}]
    }
}