gamma.tk
author viric@llimona
Sun, 22 Oct 2006 12:23:15 +0200
changeset 1 c36976fd28f3
parent 0 2b12eedda295
child 2 9aa865195c24
permissions -rw-r--r--
More changes.
viric@0
     1
#!/bin/wish
viric@0
     2
viric@1
     3
set wheight 400
viric@1
     4
set wwidth 800
viric@1
     5
set wwidthsingle [expr $wwidth / 3 ]
viric@1
     6
set gradient 5
viric@1
     7
viric@1
     8
# Aquest -2 és perque els butons, per alguna raó, són 2 pixels més alts i
viric@1
     9
# amples.
viric@1
    10
set wheightsingle [expr $wheight / $gradient - 2]
viric@1
    11
viric@1
    12
proc stepvalue { min max step } {
viric@1
    13
	global gradient
viric@1
    14
	return [expr $min + ( ( $max - $min ) * $step / ($gradient - 1) )]
viric@1
    15
}
viric@1
    16
viric@1
    17
proc color { r g b } {
viric@1
    18
	return [format "#%04x%04x%04x" $r $g $b]
viric@1
    19
}
viric@1
    20
viric@1
    21
# Build the labels
viric@1
    22
viric@1
    23
# Left
viric@0
    24
frame .leftcol
viric@1
    25
label .leftcol.c -height $wheight -width $wwidthsingle -bg #12f \
viric@1
    26
	-bitmap @gray50.xbm -borderwidth 0
viric@0
    27
pack .leftcol.c
viric@1
    28
viric@1
    29
# Center
viric@0
    30
frame .centercol
viric@1
    31
for {set i 0} {$i < $gradient} {incr i} {
viric@1
    32
	set r [stepvalue 0 65535 $i]
viric@1
    33
	set g $r 
viric@1
    34
	set b $r 
viric@1
    35
	button .centercol.b$i -height $wheightsingle -width $wwidthsingle \
viric@1
    36
		-bg [color $r $g $b]  -bitmap gray50 -borderwidth 0 \
viric@1
    37
		-highlightthickness 0 -command "selection $i"
viric@1
    38
	pack .centercol.b$i -side top
viric@1
    39
}
viric@1
    40
viric@1
    41
# Right
viric@0
    42
frame .rightcol
viric@1
    43
label .rightcol.c -height $wheight -width $wwidthsingle -bg #f12 \
viric@1
    44
	-bitmap @gray50.xbm -borderwidth 0
viric@0
    45
pack .rightcol.c
viric@0
    46
viric@0
    47
pack .leftcol -side left
viric@0
    48
pack .centercol -side left
viric@0
    49
pack .rightcol -side left
viric@0
    50
viric@1
    51
viric@1
    52
# Global variables
viric@1
    53
viric@1
    54
# Loop functions
viric@1
    55
viric@1
    56
# Returns { min_r max_r min_g max_g min_b max_b }
viric@1
    57
set min_r 0
viric@1
    58
set max_r 65535
viric@1
    59
set min_g 0
viric@1
    60
set max_g 0
viric@1
    61
set min_b 0
viric@1
    62
set max_b 0
viric@1
    63
viric@1
    64
proc getnext { } {
viric@1
    65
}
viric@1
    66
viric@1
    67
proc prepare_colors { } {
viric@1
    68
	global min_r max_r min_g max_g min_b max_b
viric@1
    69
}
viric@1
    70
viric@1
    71
proc selection { i } {
viric@1
    72
	puts $i
viric@1
    73
}
viric@1
    74