proc progressbar {w args} {
    array set opt {
        -width 256 -height 16 -relief sunken -borderwidth 1 -style bar
    }
    array set opt $args
    set style $opt(-style)
    unset opt(-style)  ;# don't let the canvas get this
    eval canvas $w [array get opt]
    set h [$w cget -height]
    switch -- $style {
        bar {
            $w create rect 1 1 1 [expr {$h-1}] -fill CornflowerBlue \
                -tags {bar status}
        }
        circle {
            $w create arc  1 1 [expr {$h-1}] [expr {$h-1}] -start 90 \
             -fill CornflowerBlue -tags {arc status} -extent 0
        }
    }
    $w create text [expr [$w cget -width] / 2] [expr $h / 2] \
        -text "0 %" -tags txt
    rename $w _$w
    proc $w {args} {
        set w [lindex [info level 0] 0]
        if {[lindex $args 0] == "set"} {
            set n [lindex $args 1]
            set h [winfo height $w]
            set width [winfo width $w]
            set color [color:rgb $n]
            $w itemconf txt -text "$n %"
            $w coords txt [expr $width / 2] [expr $h / 2]
            $w coords bar 1 1 [expr $n * $width / 100] [expr $h - 1]
            $w itemconf status -fill $color -outline $color
            $w itemconf arc -extent [expr $n*-3.599]
        } else {
            eval _$w $args 
        }
    }
    set w
}

proc color:rgb {n} {
    # map 0..100 to a red-yellow-green sequence
    set n     [expr {$n < 0? 0: $n > 100? 100: $n}]
    set red   [expr {$n > 75? 60 - ($n * 15 / 25) : 15}]
    set green [expr {$n < 50? $n * 15 / 50 : 15}]
    format    "#%01x%01x0" $red $green
}

#----- Test:
if {[file tail [info script]]==[file tail $argv0]} {
    progressbar .1
    progressbar .2 -style circle -height 50 -width 50
    pack .1 .2
    
    proc test {} {
        for {set i 0} {$i<=10000} {incr i 100} {
             after $i .1 set [expr $i/100]
             after $i .2 set [expr $i/100]
        }
    }
    test
    bind . <1> test
}