[GPS]: I like toying with new interfaces and objects.  This is a simple somewhat odd system, but I like it.  I'm planning to use this for a little 3D project I'm working on.  Use this code however you like, but I would like to know how you use it, so leave a comment or email me[mailto:GeorgePS@XMission.com].

----
  #!/bin/tclsh8.4
  
  proc getUniqueId {} {
    while 1 {
      set id [clock clicks]
      if {"" == [info commands $id]} {
        return $id
      }
    }
  }
  
  proc newObject {} {
    set id [getUniqueId]
    interp alias {} $id {} __instance $id
    return $id
  }
  
  proc __instance {id args} {
    upvar #0 _obj$id ar
    set al [llength $args]
    if {1 == $al} {
      set mem [lindex $args 0]
      return [set ar($mem)]
    } elseif {2 == $al} {
      foreach {mem value} $args break
      set ar($mem) $value
    } else {
      return -code error "bad number of arguments sent to $id: $args"
    }
  }
  
  proc call {meth _ id args} {
    upvar #0 _obj$id ar
    namespace eval :: [set ar($meth)] $args
  }
  
  proc newMethod {name _ id body} {
    upvar #0 _obj$id ar
    set methodId [getUniqueId]
    proc ::$methodId args "set self $id\n upvar #0 _obj$id ar\n $body"
    set ar($name) $methodId
    return $methodId
  }
  
  proc whenModified {name type id cmd} {
    upvar #0 _obj$id ar
    
    trace variable ar($name) $type $cmd
  }
  
----
  #TEST CODE
  
  proc TV {} {
    set tv [newObject]
    $tv x 0
    $tv y 0
    $tv z 0
    $tv brand MagnetBox
    $tv size "36\""
    
    
    newMethod info for $tv {
      puts "I am a $ar(size) TV made by $ar(brand) currently positioned at $ar(x) $ar(y) $ar(z)"
    }
    
    newMethod changeBrand for $tv {
      set ar(brand) [lindex $args 0]
    }
    
    newMethod move for $tv {
      foreach {x y z} $args break
      incr ar(x) $x
      incr ar(y) $y
      incr ar(z) $z
    }
    
    newMethod absMove for $tv {
      foreach {x y z} $args break
      set ar(x) $x
      set ar(y) $y
      set ar(z) $z
    }
    
    return $tv
  }
  proc radio {} {
    set r [newObject]
    $r x 0
    $r y 0
    $r z 0
    
    $r brand Funkadelic
    $r type AM
    $r station "102.36 The Funk"
    $r stationList [list {102.36 The Funk} {98.4 The Bore} {84.3 NPR} {90.6 The Morning Zoo Fools}]
    $r numStations 4
    
    newMethod info for $r {
      puts "I'm an [$self type] radio made by the [$self brand] company.  I am currently receiving [$self station]."
    }
    
    newMethod changeStation for $r {
      set rand [expr {int(rand() * [$self numStations])}]
      set newStation [lindex [$self stationList] $rand]
      $self station $newStation
    }
    
    return $r
  }
  proc stationModified {args} {
    puts "You changed the station."
    #puts $args
  }
  
  proc main {} {
    set tv [TV]
    
    call info in $tv
    call changeBrand in $tv Zony
    call info in $tv
    call move in $tv 20 10 0
    call info in $tv
    call absMove in $tv 0 0 0
    call info in $tv
    
    set radio [radio]
    
    call info in $radio
    whenModified station wu $radio stationModified
    
    for {set i 0} {$i < 5} {incr i} {
      puts "Changing station (randomly)"
      call changeStation in $radio
      puts [$radio station]
    }
    call info in $radio
  }
  main
----  
$ tclsh8.4 SDynObject.tcl  

I am a 36" TV made by MagnetBox currently positioned at 0 0 0

I am a 36" TV made by Zony currently positioned at 0 0 0

I am a 36" TV made by Zony currently positioned at 20 10 0

I am a 36" TV made by Zony currently positioned at 0 0 0

I'm an AM radio made by the Funkadelic company.  I am currently receiving 102.36 The Funk.

Changing station (randomly)

You changed the station.

90.6 The Morning Zoo Fools

Changing station (randomly)

You changed the station.

102.36 The Funk

Changing station (randomly)

You changed the station.

90.6 The Morning Zoo Fools

Changing station (randomly)

You changed the station.

90.6 The Morning Zoo Fools

Changing station (randomly)

You changed the station.

84.3 NPR

I'm an AM radio made by the Funkadelic company.  I am currently receiving 84.3 NPR.

----
 [Category Object Orientation]