#!/usr/bin/tclsh 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 } set_color a1 green set_color a2 yellow set_color a3 red puts "a1 has color [get_color a1]" puts "a2 has color [get_color a2]" puts "a3 has color [get_color a3]"