Finished the R G B range.
#!/bin/wish
set wheight 400
set wwidth 800
set wwidthsingle [expr $wwidth / 3 ]
set gradient 10
# Precision on color selection
set th_prec 2000
# Aquest -2 és perque els butons, per alguna raó, són 2 pixels més alts i
# amples.
set wheightsingle [expr $wheight / $gradient - 2]
proc stepvalue { min max step } {
global gradient
return [expr $min + ( ( $max - $min ) * $step / ($gradient - 1) )]
}
proc color { r g b } {
return [format "#%04x%04x%04x" $r $g $b]
}
# Build the labels
frame .c
pack .c -side bottom
# Left
frame .leftcol
label .leftcol.c -height $wheight -width $wwidthsingle -bg #12f \
-bitmap @gray50.xbm -borderwidth 0
pack .leftcol.c
# Center
frame .centercol
for {set i 0} {$i < $gradient} {incr i} {
set r [stepvalue 0 65535 $i]
set g $r
set b $r
button .centercol.b$i -height $wheightsingle -width $wwidthsingle \
-bg [color $r $g $b] -bitmap gray50 -borderwidth 0 \
-highlightthickness 0 -command "selection $i"
pack .centercol.b$i -side top
}
# Right
frame .rightcol
label .rightcol.c -height $wheight -width $wwidthsingle -bg #f12 \
-bitmap @gray50.xbm -borderwidth 0
pack .rightcol.c
pack .leftcol -side left
pack .centercol -side left
pack .rightcol -side left
# Menu
menu .mb
. config -menu .mb
set mFile [menu .mb.mFile]
.mb add cascade -label File -menu .mb.mFile
$mFile add command -label Load -command load_file
$mFile add command -label Save -command save_file
$mFile add separator
$mFile add cascade -label Export -menu ${mFile}.mExport
$mFile add command -label Quit -command exit
set mExport [menu ${mFile}.mExport]
$mExport add command -label "GNUPlot data" -command export_gnuplotdata
$mExport add command -label ICC -command export_icc
# Globals
set rpoints {{0 0.} {65535 1.}}
set gpoints {{0 0.} {65535 1.}}
set bpoints {{0 0.} {65535 1.}}
# Loop functions
# Returns { type }
proc get_next_ptype { } {
global rpoints gpoints bpoints
set nrp [llength $rpoints]
set ngp [llength $gpoints]
set nbp [llength $bpoints]
puts "nrp: $nrp"
puts "ngp: $ngp"
puts "nbp: $nbp"
if { $nrp > $ngp } {
set type g
} else {
set type r
}
if { [set n${type}p] > $nbp } {
set type b
}
return $type
}
proc get_next_point { type } {
global ${type}points
upvar 0 ${type}points points
set np [llength $points]
set last [lindex [lindex $points 0] 0 ]
set maxdist 0
set imin 0
for {set i 1} {$i < $np} {incr i 1} {
set actual [lindex [lindex $points $i] 0]
set dist [expr {abs($last - $actual)}]
puts "dist: $dist"
if { $dist > $maxdist } {
set imin [expr {$i - 1}]
puts "New imin"
set maxdist $dist
}
set last $actual
}
return $imin
}
proc prepare_colors_newpoint { } {
global icolors rpoints gpoints bpoints gradient type xmin xmax nxmin nxmax
set type [get_next_ptype]
set icolors [get_next_point $type]
upvar 0 ${type}points points
puts "type: $type"
puts "icolors: $icolors"
set xmin [lindex [lindex $points $icolors] 0]
set xmax [lindex [lindex $points [expr {$icolors + 1}]] 0]
set nxmin $xmin
set nxmax $xmax
prepare_colors $type $nxmin $nxmax
}
proc prepare_colors { type nxmin nxmax } {
global gradient
switch -- $type {
r {
set cmin [color $nxmin 0 0]
set cmax [color $nxmax 0 0]
} g {
set cmin [color 0 $nxmin 0]
set cmax [color 0 $nxmax 0]
}
b {
set cmin [color 0 0 $nxmin]
set cmax [color 0 0 $nxmax]
}
}
# Set the bg and fg color to xmin and xmax
.leftcol.c configure -background $cmin -foreground $cmax
.rightcol.c configure -background $cmin -foreground $cmax
# Prepare the colors of the middle buttons
for {set i 0} {$i < $gradient} {incr i} {
set x [stepvalue $nxmin $nxmax $i]
switch -- $type {
r { set c [color $x 0 0] }
g { set c [color 0 $x 0] }
b { set c [color 0 0 $x] }
}
.centercol.b$i configure -background $c -foreground $c
}
}
proc padd { point } {
}
proc selection { i } {
global rpoints gpoints bpoints nxmin nxmax gradient type th_prec
upvar 0 ${type}points points
set nstep_min [expr {$i - 1}]
set nstep_max [expr {$i + 1}]
if {$nstep_min < 0} { set nstep_min 0 }
if {$nstep_max >= $gradient} { set nstep_max [expr {$gradient - 1}] }
set nvalue_min [stepvalue $nxmin $nxmax $nstep_min]
set nvalue_max [stepvalue $nxmin $nxmax $nstep_max]
puts "$type - nvalue_min: $nvalue_min, nvalue_max: $nvalue_max"
set nxmin $nvalue_min
set nxmax $nvalue_max
if {[expr {$nxmax - $nxmin}] > $th_prec} {
puts "$type - More precision needed"
prepare_colors $type $nxmin $nxmax
} else {
puts "$type - New point!"
# Add the point - middle range
set middle [expr {$nxmin + ($nxmax - $nxmin)/2}]
set i 0
while { [lindex [lindex $points $i] 0] < $middle } {
incr i 1
}
# Get the middle of the light intesity
set vmin [lindex [lindex $points [expr {$i - 1}]] 1]
set vmax [lindex [lindex $points $i] 1]
set nval [expr {$vmin + ($vmax - $vmin)/2.0}]
set points [linsert $points $i [list $middle $nval]]
puts "$type - $points"
prepare_colors_newpoint
}
}
proc save_file { } {
global rpoints gpoints bpoints
set file [tk_getSaveFile]
if { $file == "" } {
return
}
set fd [open $file w]
puts "# plot for gnuplot"
puts "# plot 'data' index 0 title 'vermell', 'data' index 1 title 'verd', 'data' index 2 title 'blau'"
foreach t { rpoints gpoints bpoints } {
foreach i [set $t] {
puts -nonewline $fd [join $i " "]
puts $fd ""
}
if { $t != "bpoints"} {
puts $fd ""
}
}
close $fd
}
proc load_file { } {
global rpoints gpoints bpoints
set file [tk_getOpenFile]
if { $file == "" } {
return
}
set fd [open $file r]
set rpoints {}
set gpoints {}
set bpoints {}
set type r
while { [eof $fd] != 1 } {
set line [gets $fd]
if { $line == "" } {
set line [gets $fd]
if { $line == "" } {
switch -- $type {
r { set type g }
g { set type b }
}
}
} else {
if { [string index $line] != "#" } {
lappend ${type}points [split $line " "]
}
}
}
close $fd
# Debug
set nrp [llength $rpoints]
set ngp [llength $gpoints]
set nbp [llength $bpoints]
puts "Read nrp: $nrp, ngp: $ngp, nbp: $nbp"
prepare_colors_newpoint
}
# Prepare the colors for the user, for the first time!
prepare_colors_newpoint