proc every {ms body} {
        eval $body
        after $ms [info level 0]
  }

  proc pick { l } {
        return [lindex $l [expr {int( [llength $l] * rand() )}]]
  }

  proc randColor {} {
        set h {0 1 2 3 4 5 6 7 8 9 a b c d e f}
        return "#[pick $h][pick $h][pick $h][pick $h][pick $h][pick $h]"
  }

  proc biggen_font { cur_size max_size N } {
        if {$cur_size > $max_size} {
                if {[incr N -1] < 0} return
                after 3000 [list update_config $N]
        } else {
                font configure randfont -size [incr cur_size 2]
                after 40 [list biggen_font $cur_size $max_size $N]
        }
  }

  proc update_config { N } {
        if {[winfo exists .w]} {
                set cur_size 2
                font configure randfont \
                        -underline [pick {0 1}] \
                        -family [pick [font families]] \
                        -weight [pick {normal bold}] \
                        -slant [pick {roman italic}] \
                        -size $cur_size

                wm title .w [font configure randfont -family]
                set col [randColor]
                .w.f   configure -bg $col
                .w.f.l configure -bg $col
                biggen_font $cur_size 150 $N
        }
  }

  wm withdraw .
  font create randfont
  set PERIOD [expr {25 * 60 * 1000}]

  every $PERIOD {
        if {![winfo exists .w]} {
                toplevel .w
                wm state .w zoomed ;# maximize window
                pack [frame .w.f] -fill both -expand true
                pack [label .w.f.l -font randfont -text " Stretch! "] \
                        -fill both -expand true -padx 20 -pady 20
                update_config 20
        }
  }

TIP 145