I was using unknown today to add some syntax sugar to dicts and somehow came up with a simple, lightweight object system that has the feel of javascript objects. No inheritence or delegation for now but composition should be possible (it's just nested dicts after all).
The basic idea is that everything's a value (how very tclish ;-). Methods are simply lambda expressions stored as elements in a dict. Also, I started by stealing the object syntax from Tk widget hierarchies but ended up with a very javascript-like syntax.
# we start with a dict:
set foo {
location {
x 0
y 0
}
heading 0
move {{distance} {
%this.location.x = [expr {
[%this.location.x]+($distance*cos([%this.heading]))
}]
%this.location.y = [expr {
[%this.location.y]+($distance*sin([%this.heading]))
}]
}}
}
# to get values form the dict simply:
puts [%foo.location.x]
# to set values simply:
%foo.heading = [expr {acos(-1)/8}]
# to call a method simply apply:
%foo.move.apply 100
# There are a couple other conveniences
# for dict operations.
# to merge two dicts:
set newfoo [%foo + {name "tortise"}]
# to merge another dict into foo:
%foo += {name "hare"}
# syntax sugar for dict:
proc dicthash {cmd args} {
uplevel 1 [string map "CMD $cmd ARGS {{$args}}" {
set path [split [string range CMD 1 end] .]
set varname [lindex $path 0]
set path [lrange $path 1 end]
upvar 1 $varname var
if {[lindex $path end] == "apply"} {
set path [lrange $path 0 end-1]
set script [dict get $var {*}$path]
set body [lindex $script 1]
regsub -all -- {\y\$this\y} $body "{$var}" body
regsub -all -- {\%this} $body "dicthash %var" body
lset script 1 $body
if {ARGS == ""} {
return [apply $script]
} else {
return [apply $script {*}ARGS]
}
} else {
switch -- [llength ARGS] {
0 {
return [dict get $var {*}$path]
}
2 {
set op [lindex ARGS 0]
set val [lindex ARGS 1]
if {$op == "="} {
return [dict set var {*}$path $val]
} elseif {$op == "+"} {
if {$path == ""} {
return [dict merge $var $val]
} else {
error "invalid dict merge"
}
} elseif {$op == "+="} {
if {$path == ""} {
return [set var [dict merge $var $val]]
} else {
error "invalid dict merge"
}
}
}
}
}
error "unsupported operation on CMD"
}]
}
proc unknown {cmd args} {
if {[string index $cmd 0] == "%"} {
return [dicthash $cmd {*}$args]
} else {
error "unknown: $cmd $args"
}
}