#!/usr/bin/tclsh

# To save work, we write a single dispatch procedure for all objects.
# The object commands now take only 1 line of code each: they just call
# the dispatcher.

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 a1 {command args} {
   return [eval dispatch a1 $command $args]
}

proc a2 {command args} {
   return [eval dispatch a2 $command $args]
}

proc a3 {command args} {
   return [eval dispatch a3 $command $args]
}

a1 set_color red
a2 set_color green
a3 set_color yellow

puts "a1 has color [a1 get_color]"
puts "a2 has color [a2 get_color]"
puts "a3 has color [a3 get_color]"