* Purpose: Progress meter for Tcl scripts
I am creating this page because I don't find one like it but certainly there should be an interest. While the below example works somewhat, I am sure that the more experienced coders can come up with better.
The "spinner" component spins upon each loop providing an indication that the program is working, while the percent meter indicates the entire progress of work being done.
This fails for values <= 100 and has other faulty logic MT
set p(cnt) 1
set spincnt 0
array set spinner {
0 "/" 1 "-" 2 "\\" 3 "|"
4 "/" 5 "-" 6 "\\" 7 "|"
}
proc progressMeter {total} {
global p spincnt spinner
puts -nonewline stdout " \[00%\]\b\b\b\b\b\b"; flush stdout
for {set i 0} {$i < $total} {incr i} {
if {$spincnt == 7} {
set spincnt 0
} else {
incr spincnt
}
if {$p(cnt) < 10} {
set percent ".0$p(cnt)"
} else {
set percent ".$p(cnt)"
}
puts -nonewline stdout " $spinner($spincnt)\b\b\b"; flush stdout
if {$i >= [expr $total * $percent]} {
incr p(cnt)
set pout [string map {"." ""} $p(cnt)]
puts -nonewline stdout " $spinner($spincnt)\[$pout%\]\b\b\b\b\b\b\b\b"
flush stdout
}
# your code goes here rather than the delay
after 100
}
puts stdout "\b\bDone! "; flush stdout
return
}
# arbitrary starter
progressMeter 220SC Here's another one which is used as a callback, more like the various tk callback widgets. The original author is Kris Raney I believe.
# text_progress --
#
# progress callback for a download or other piece of work
#
# Arguments:
# total expected total size/duration
# current current size/duration
# Results:
# Displays progress information in some way to the user.
#
# this version culled from Kris Raney's text_progress
#
proc text_progress {totalsize current} {
puts -nonewline "\r |"
if {$totalsize == 0} {
set totalsize $current
}
set portion [expr 1.0 * $current/$totalsize * 40]
for {set x 0} {$x <= $portion} {incr x} {
puts -nonewline "="
}
for {} {$x <= 40} {incr x} {
puts -nonewline " "
}
puts -nonewline "| [format "%3d" [expr int(100.0 * $current/$totalsize)]] %"
flush stdout
if {$totalsize == $current} {
puts "\ndone"
}
}
## test code
for {set i 0} {$i < 100} {incr i} {
text_progress 100 $i
after 100
}