I stumbled across a sweet way to create an autoincrementing variable for use in loops and such. It allows me to write code like:
tclsh8.4 [~/code]source serial.tcl
tclsh8.4 [~/code]serial create s
tclsh8.4 [~/code]foreach fruit {apples oranges pears banannas} {
> puts [format {%03d %s} $s $fruit]
>}
001 apples
002 oranges
003 pears
004 banannas
tclsh8.4 [~/code]Anyway, I'm so impressed by my own cleverness, that I need to post it online immediately. (It needs SubCommands and named arguments to work...
#serial.tcl
#Copyright April 13, 2005 - Pierre Coueffin
source subcommands.tcl
proc serial {command args} {
subcommand $command args {
create {var {start 1} {step 1}} {
incr start [expr -1 * $step]
upvar $var v
if {[regexp {read {serial trace (-?[0-9]+)}} \
[trace info variable v]]} {
error "The variable $var has already been declared serial."
}
set v $start
trace add variable v read [list serial trace $step]
}
array {var vals {step 1}} {
upvar $var v
foreach {idx val} $vals {
set v($idx) [expr $val - $step]
}
trace add variable v read [list serial trace $step]
}
trace {step var idx _op} {
upvar $var v
if {$idx == {}} {
incr v $step
} else {
incr v($idx) $step
}
}
forget {var} {
upvar $var v
trace remove variable v read \
[list serial trace [serial stepsize v]]
}
stepsize {var {newstep {}}} {
upvar $var v
if {[llength $newstep] > 0} {
serial forget v
serial create v $v $newstep
return $v
} else {
regexp {read {serial trace (-?[0-9]+)}} \
[trace info variable v] match step
return $step
}
}
last {var} {
upvar $var v
return [incr v [expr -1 * [serial stepsize v]]]
}
default {} {
error "serial: I don't know how to \"$command\"!"
}
}
}SS With Jim Closures it's as simple as:
proc make-counter {} {lambda {} {{i 0}} {incr i}}
set s [make-counter]
foreach fruit {apples oranges pears banannas} {
puts [format {%s %s} [$s] $fruit]
}output:
1 apples 2 oranges 3 pears 4 banannas
Wow, you're fast! I had a few other samples to post, but you managed to slip the edit in while I was checking that the last one worked... I'll just tuck them away here:
tclsh8.4 [~/code]puts $s 5 tclsh8.4 [~/code]puts $s 6 tclsh8.4 [~/code]serial last s 7 tclsh8.4 [~/code]serial last s 7 tclsh8.4 [~/code]serial stepsize s 1 tclsh8.4 [~/code]serial stepsize s 10 7 tclsh8.4 [~/code]puts $s 17 tclsh8.4 [~/code]set s 5 5 tclsh8.4 [~/code]puts $s 15 tclsh8.4 [~/code]puts $s 25 tclsh8.4 [~/code]puts $s 35
Or how about an array of them?
tclsh8.4 [~/code]serial array sa {0 0 1 5 bob 3} 2
tclsh8.4 [~/code]puts $sa(0)
0
tclsh8.4 [~/code]puts $sa(0)
2
tclsh8.4 [~/code]puts $sa(0)
4
tclsh8.4 [~/code]
tclsh8.4 [~/code]puts $sa(bob)
3
tclsh8.4 [~/code]puts $sa(bob)
5
tclsh8.4 [~/code]puts $sa(bob)
7