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.


****Usage Summary:****

======
  # 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"}

======

I toyed with the idea of implementing method calls as %foo.move($value) but that felt very un-tclish to me. So I opted to use "apply" as the keyword for method invocation.

****Here's the implementation:****
======
  # 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"
    }
  }

======


----
!!!!!!
%| [Category Object Orientation] |%
!!!!!!