viric@0: #!/bin/wish
viric@0: 
viric@1: set wheight 400
viric@1: set wwidth 800
viric@1: set wwidthsingle [expr $wwidth / 3 ]
viric@1: set gradient 5
viric@1: 
viric@1: # Aquest -2 és perque els butons, per alguna raó, són 2 pixels més alts i
viric@1: # amples.
viric@1: set wheightsingle [expr $wheight / $gradient - 2]
viric@1: 
viric@1: proc stepvalue { min max step } {
viric@1: 	global gradient
viric@1: 	return [expr $min + ( ( $max - $min ) * $step / ($gradient - 1) )]
viric@1: }
viric@1: 
viric@1: proc color { r g b } {
viric@1: 	return [format "#%04x%04x%04x" $r $g $b]
viric@1: }
viric@1: 
viric@1: # Build the labels
viric@1: 
viric@1: # Left
viric@0: frame .leftcol
viric@1: label .leftcol.c -height $wheight -width $wwidthsingle -bg #12f \
viric@1: 	-bitmap @gray50.xbm -borderwidth 0
viric@0: pack .leftcol.c
viric@1: 
viric@1: # Center
viric@0: frame .centercol
viric@1: for {set i 0} {$i < $gradient} {incr i} {
viric@1: 	set r [stepvalue 0 65535 $i]
viric@1: 	set g $r 
viric@1: 	set b $r 
viric@1: 	button .centercol.b$i -height $wheightsingle -width $wwidthsingle \
viric@1: 		-bg [color $r $g $b]  -bitmap gray50 -borderwidth 0 \
viric@1: 		-highlightthickness 0 -command "selection $i"
viric@1: 	pack .centercol.b$i -side top
viric@1: }
viric@1: 
viric@1: # Right
viric@0: frame .rightcol
viric@1: label .rightcol.c -height $wheight -width $wwidthsingle -bg #f12 \
viric@1: 	-bitmap @gray50.xbm -borderwidth 0
viric@0: pack .rightcol.c
viric@0: 
viric@0: pack .leftcol -side left
viric@0: pack .centercol -side left
viric@0: pack .rightcol -side left
viric@0: 
viric@1: 
viric@1: # Global variables
viric@1: 
viric@1: # Loop functions
viric@1: 
viric@1: # Returns { min_r max_r min_g max_g min_b max_b }
viric@1: set min_r 0
viric@1: set max_r 65535
viric@1: set min_g 0
viric@1: set max_g 0
viric@1: set min_b 0
viric@1: set max_b 0
viric@1: 
viric@1: proc getnext { } {
viric@1: }
viric@1: 
viric@1: proc prepare_colors { } {
viric@1: 	global min_r max_r min_g max_g min_b max_b
viric@1: }
viric@1: 
viric@1: proc selection { i } {
viric@1: 	puts $i
viric@1: }
viric@1: