#!/usr/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 New -command new_points

$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

}

	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"

	} 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 $fd "# plot for gnuplot"

	puts $fd "# plot 'data' index 0 title 'vermell', 'data' index 1 title 'verd', 'data' index 2 title 'blau'"

	foreach t { rpoints gpoints bpoints } {

		puts $fd "# $t"

		foreach i [set $t] {

			puts -nonewline $fd [join $i " "]

			puts $fd ""

		}

		if { $t != "bpoints"} {

			puts $fd ""

			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 0] != "#" } {

				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

}

proc new_points { } {

        global rpoints gpoints bpoints

        set rpoints {{0 0.} {65535 1.}}

        set gpoints {{0 0.} {65535 1.}}

        set bpoints {{0 0.} {65535 1.}}

        prepare_colors_newpoint

}

# Prepare the colors for the user, for the first time!

prepare_colors_newpoint