#!/usr/bin/wish
 # $Id: MungeColor.tcl,v 5.0 2003/06/05 14:49:36 uwe Exp uwe $
 # what: color numbers for plotting
 
 package provide MungeColor                1.0
 
 set RGB(fname) "/usr/X11R6/lib/X11/rgb.txt"
 set RGB(file) [ open $RGB(fname) r ]
 
 set filecont [ split [ read $RGB(file) [ file size $RGB(fname) ] ] "\n" ]
 foreach str $filecont {
          if { "[ string index $str 0 ]" == "!" }  {
                 continue
         }
         if { [ scan $str " %d %d %d %n " R G B pos ] < 3 } {
                 continue
         }
         set dark 0.7
         set LR [ expr int( $R * $dark ) ]
         set LG [ expr int( $G * $dark ) ]
         set LB [ expr int( $B * $dark ) ]
         set cval [ format "#%02x%02x%02x" $R $G $B ]
         set dval [ format "#%02x%02x%02x" $LR $LG $LB ]
         set cname [ string trim [ string range $str $pos end ] ] 
         #D0# puts "$R $G $B $pos $cval \"$cname\""
         eval "set RGB(\$cname) {$R $G $B}"
         # set RGB($cval) "$cname"
         # .l1 configure -bg $cval 
         # .l2 configure -bg $dval 
         # update
         # update
 }
 close $RGB(file)
 
 proc 2color { val } {
         global RGB
         set val [ string trim $val ]
         if { [ string index $val 0 ] != "#" } {
                 if { [ array names RGB $val ] != {} } {
                         #D0# puts " color name $val"
                         set rgb $RGB($val)
                         #D0# puts rgb:$rgb
                         foreach {R G B} $rgb {
                                 #D0# puts " color R:$R "
                                 #D0# puts " color G:$G "
                                 #D0# puts " color B:$B "
                         } 
                 } else { 
                         foreach {R G B} {99 99 99} {
                         }
                 }
         } else {
                 #D0# puts " color number $val"
                 switch [ string length $val ] {
                            4 {
                                 scan $val "#%01x%01x%01x" R G B
                                 set R [ expr $R * 0x11 ]
                                 set G [ expr $G * 0x11 ]
                                 set B [ expr $B * 0x11 ]
                         }  7 {
                                 scan $val "#%02x%02x%02x" R G B 
                         } 10 {
                                 scan $val "#%03x%03x%03x" R G B 
                                 set R [ expr $R / 0x11 ]
                                 set G [ expr $G / 0x11 ]
                                 set B [ expr $B / 0x11 ]
                         } default {
                                 #D0# puts length:[ string length $val ]
                                 scan $val "#%02x%02x%02x" R G B 
                         }
                 }
         }
         set dark 0.7
         set LR [ expr round( $R * $dark ) ]
         set LG [ expr round( $G * $dark ) ]
         set LB [ expr round( $B * $dark ) ]
         set cval [ format "#%02x%02x%02x" $R $G $B ]
         set dval [ format "#%02x%02x%02x" $LR $LG $LB ]
         #D0# puts "$cval $dval"
         return "$cval $dval"
 }
 
 proc col_h { val } {
         set ret [ 2color "$val" ]
         set ret [ split $ret ]
         return [ lindex $ret 0 ]
 }
 
 proc col_l { val } {
         set ret [ 2color "$val" ]
         set ret [ split $ret ]
         return [ lindex $ret 1 ]
 }
 
 # END