proc lerpcolor { col1 col2 alpha } {
  set dc [vecsub $col2 $col1]
  set nc [vecadd $col1 [vecscale $dc $alpha]]
  return $nc  
}

proc coltogs { col } {
  foreach {r g b} $col {}
  set gray [expr ($r + $g + $b) / 3.0]
  return [list $gray $gray $gray]
}

proc tricolor_scale {} {
  display update off
  set mincolorid [expr [colorinfo num] - 1]
  set maxcolorid [expr [colorinfo max] - 1]
  set colrange [expr $maxcolorid - $mincolorid]
  set colhalf [expr $colrange / 2]
  for {set i $mincolorid} {$i < $maxcolorid} {incr i} {
    set colpcnt [expr ($i - $mincolorid) / double($colrange)]
#      set r [expr 1.0 - $colpcnt]
#      set g $r
#      set b $r
#      set r [expr 1.0 - $colpcnt]
#      set g 0.5
#      set b $colpcnt
#    if { $colpcnt < 0.5 } {
#      set r [expr 1.0 - $colpcnt]
#      set g $colpcnt 
#      set b 0.0
#    } else {
#      set r 0.0
#      set g [expr 0.5 - ($colpcnt - 0.5)]
#      set b [expr $colpcnt]
#    }

    set R { 0.9 0.4 0.3 }
    set W { 0.5 0.4 0.4 }
    set B { 0.0 0.0 0.5 }
    if { $colpcnt < 0.5 } {
      set nc [lerpcolor $R $W [expr $colpcnt * 2.0]]
    } else {
      set nc [lerpcolor $W $B [expr ($colpcnt-0.5) * 2.0]]
    }

#    set R { 1.0 0.3 0.3 }
#    set B { 0.0 0.0 0.7 }
#    set nc [lerpcolor $R $B [expr $colpcnt * 0.99]]

#    set nc [coltogs $nc]
    foreach {r g b} $nc {}
    puts "index: $i $r $g $b   -- $colpcnt"
    display update ui
    color change rgb $i $r $g $b 
  }
  display update on
}

tricolor_scale