#!/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
	prepare_colors_center $type $nxmin $nxmax
	prepare_colors_margins $type $nxmin $nxmax
}


proc prepare_colors_margins { type nxmin nxmax } {
	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
}

proc prepare_colors_center { type nxmin nxmax } {
	global gradient

	# 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_center $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 $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