if 0 {
experiment to make tcl understand 'a = c' mathematical commands. Starts with a standard command 'realnumber' and its Cmd, cget and configure scripts then a test script exercises it to demonstrate its 'use'.
Suggested by Numerical Analysis in Tcl }
proc realnumber {w args} { ;# a variable
global $w.props ;# an array of options specific to the dimValue 'class'
# define option list and each default value
array set $w.props {-value 0 }
set textArgs {} ;# list of arguments not specific to the class
foreach {opt val} $args {
if {[array names $w.props $opt]!=""} {set options($opt) $val
} else { lappend textArgs $opt $val }
}
eval interp create $w ;# create the "procedure" w
interp hide {} $w
# Install the alias:
# realnumberCmd are sub-commands for realnumber class
interp alias {} $w {} realnumberCmd $w
foreach opt [array names options] {
$w configure $opt $options($opt)
}
return $w ;# the original object
}
proc realnumberCmd {self cmd args} {
switch -- $cmd {
configure {eval realnumberConfigure $self $cmd $args}
cget {eval realnumberCget $self $args}
"=" { $self configure -value $args }
"?" { return [$self cget -value] }
}
}
proc realnumberConfigure {self cmd args} {
# 3 cases:
#
# $args is empty -> return all options with their values
# $args is one element -> return current values
# $args is 2+ elements -> configure the options
#puts "Config comd $self $cmd $args [llength $args]"
global $self.props
switch [llength $args] {
0 { ;# return all options
set result [array names $self.props]
return $result
}
1 { ;# return argument values
lappend opts [$self cget $args]
return $opts
}
default { ;# >1 arg - an option and its value
foreach {option value} $args { ;# go through each option:
if {[array names $self.props $option]=="-value"} {
set $self.props($option) [expr $value]
} elseif {[array names $self.props $option]!=""} {
# access global array element for each added option.
set $self.props($option) $value
} else { ;# try the default $option, $value for $self
$self configure $option $value
}
}
return {}
}
}
}
proc realnumberCget {self args} { ;# cget defaults done by the interp cget command
upvar #0 $self.props props ;# get local address for global array
if {[array names props $args ]!=""} {
return $props($args)
}
return 1 ;# [uplevel 1 [list interp invokehidden {} $self cget $args]]
}
proc test {} {
realnumber biff
set i 1
while {$i<12} {
set j 1
while {$j<12} {
biff = $i*$j
puts "$i*$j is [biff ?]" ;# or use [biff cget -value]
incr j
}
incr i
}
puts "factorials up to 14 NB greater than 16 this algorithm gets into trouble with integer overruns"
set j 1
biff = 1
while {$j<14} {
biff = [biff ?]*$j
puts "$j! is [biff ?]" ;# or use [biff cget -value]
incr j
}
}
console show; update idletasks
testslebetman Notwithstanding the fact that a real number in mathematics means something completely different (see Computers and real numbers) I've implemented this concept a bit more intuitively (and if you consider lines of code, also more simply). Unlike the implementation above, my variables exist as both variables and commands. Personally I would call it a C-like syntax for numbers:
proc cleanupVar {name1 name2 op} {
rename $name1 {}
}
proc var {name {= =} args} {
upvar 1 $name x
if {[llength $args]} {
set x [expr $args]
} else {
set x {}
}
proc $name args "
upvar 1 $name $name
if {\[llength \$args\]} {
set $name \[expr \[lrange \$args 1 end\]\]
} else {
return \$[set name]
}
"
uplevel 1 [list trace add variable $name unset cleanupVar]
}The following is an example of how to use var:
proc test {} {
var x
var y = 10
x = $y*2
return $x
}
puts [test]Another feature is that my variables actually exists in local scope even though their associated commands exists in global scope. This means that the varaibles can be used recursively:
proc recursiveTest {x} {
var y = $x - 1
if {$y > 0} {
recursiveTest $y
}
puts $y
}
recursiveTest 10should output the numbers 0 to 9. Another test:
proc test2 {} {
var x = 10
puts "this x belongs to test2 = $x"
}
proc test3 {} {
var x = 100
test2
puts "this x belongs to test3 = $x"
}
test3output:
this x belongs to test2 = 10 this x belongs to test3 = 100
Another, even more powerful, implementation of this concept is Let unknown know.