#!/usr/bin/tclsh # We now use the object name as an array, not the attribute name. # This allows us to easily store and retrieve multiple attributes per object. # To delete an object, just delete its array and its object command. proc get_color {obj_name} { upvar #0 $obj_name arr return $arr(color) } proc set_color {obj_name color} { upvar #0 $obj_name arr set arr(color) $color } proc dispatch {obj_name command args} { if { $command == "get_color" } { return [get_color $obj_name] } elseif { $command == "set_color" } { set_color $obj_name [lindex $args 0] } else { puts "Error: Unknown command $command" } } proc apple {args} { foreach name $args { proc $name {command args} \ "return \[eval dispatch $name \$command \$args\]" upvar #0 $name arr set arr(color) green } } proc delete_apple {args} { foreach name $args { upvar #0 $name arr unset arr ; # Deletes the object's data rename $name {} ; # Deletes the object command } } # Note the advantage of using an array per object: # 'delete_apple' can just 'unset arr' instead of having to # remove one entry in three different arrays. apple a1 a2 a3 a2 set_color yellow a3 set_color red puts "a1 has color [a1 get_color]" puts "a2 has color [a2 get_color]" puts "a3 has color [a3 get_color]" delete_apple a1 a2 a3