#!/usr/bin/tclsh

# We introduce the class command (in this example it is called 'apple'),
# which creates the object commands for us (acting as a kind of constructor).

proc get_color {obj_name} {
   global a_color
   if { [info exists a_color($obj_name)] } {
      return $a_color($obj_name)
   } else {
      puts "Warning: $obj_name has no color!"
      return "transparent"   ; # return a default color
   }
}

proc set_color {obj_name color} {
   global a_color
   set a_color($obj_name) $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\]"
   }
}

apple a1 a2 a3
a1 set_color green
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]"