diff -r c36976fd28f3 -r 9aa865195c24 gamma.tk --- 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