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