Finished the R G B range.
authorviric@mandarina
Sun, 22 Oct 2006 22:56:16 +0200
changeset 2 9aa865195c24
parent 1 c36976fd28f3
child 3 2bdd3f8b7864
Finished the R G B range.
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
 
-proc getnext { } {
+	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 prepare_colors { } {
-	global min_r max_r min_g max_g min_b max_b
+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 } {
-	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