--- a/gamma.tk Sun Oct 22 12:23:15 2006 +0200
+++ b/gamma.tk Sun Oct 22 22:56:16 2006 +0200
@@ -3,7 +3,9 @@
set wheight 400
set wwidth 800
set wwidthsingle [expr $wwidth / 3 ]
-set gradient 5
+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.
@@ -19,6 +21,8 @@
}
# Build the labels
+frame .c
+pack .c -side bottom
# Left
frame .leftcol
@@ -48,27 +52,236 @@
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
-# Global variables
+$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 { min_r max_r min_g max_g min_b max_b }
-set min_r 0
-set max_r 65535
-set min_g 0
-set max_g 0
-set min_b 0
-set max_b 0
+# 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 getnext { } {
+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 { } {
- global min_r max_r min_g max_g min_b max_b
+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 } {
- puts $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