#!/usr/bin/tclsh # We introduce object commands: one command for each object. # These commands allow easier access to the color properties. 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 a1 {command args} { if { $command == "get_color" } { return [get_color a1] } elseif { $command == "set_color" } { set_color a1 [lindex $args 0] } else { puts "Error: Unknown command $command" } } proc a2 {command args} { if { $command == "get_color" } { return [get_color a2] } elseif { $command == "set_color" } { set_color a2 [lindex $args 0] } else { puts "Error: Unknown command $command" } } proc a3 {command args} { if { $command == "get_color" } { return [get_color a3] } elseif { $command == "set_color" } { set_color a3 [lindex $args 0] } else { puts "Error: Unknown command $command" } } a1 set_color yellow a2 set_color red a3 set_color green puts "a1 has color [a1 get_color]" puts "a2 has color [a2 get_color]" puts "a3 has color [a3 get_color]"