1 | #!/bin/sh |
---|
2 | # the next line restarts using wish \ |
---|
3 | exec wish8.4 "$0" "$@" |
---|
4 | |
---|
5 | # tcolor -- |
---|
6 | # This script implements a simple color editor, where you can |
---|
7 | # create colors using either the RGB, HSB, or CYM color spaces |
---|
8 | # and apply the color to existing applications. |
---|
9 | # |
---|
10 | # RCS: @(#) $Id: tcolor,v 1.3 2001/10/29 16:23:32 dkf Exp $ |
---|
11 | |
---|
12 | wm title . "Color Editor" |
---|
13 | |
---|
14 | # Global variables that control the program: |
---|
15 | # |
---|
16 | # colorSpace - Color space currently being used for |
---|
17 | # editing. Must be "rgb", "cmy", or "hsb". |
---|
18 | # label1, label2, label3 - Labels for the scales. |
---|
19 | # red, green, blue - Current color intensities in decimal |
---|
20 | # on a scale of 0-65535. |
---|
21 | # color - A string giving the current color value |
---|
22 | # in the proper form for x: |
---|
23 | # #RRRRGGGGBBBB |
---|
24 | # updating - Non-zero means that we're in the middle of |
---|
25 | # updating the scales to load a new color,so |
---|
26 | # information shouldn't be propagating back |
---|
27 | # from the scales to other elements of the |
---|
28 | # program: this would make an infinite loop. |
---|
29 | # command - Holds the command that has been typed |
---|
30 | # into the "Command" entry. |
---|
31 | # autoUpdate - 1 means execute the update command |
---|
32 | # automatically whenever the color changes. |
---|
33 | # name - Name for new color, typed into entry. |
---|
34 | |
---|
35 | set colorSpace hsb |
---|
36 | set red 65535 |
---|
37 | set green 0 |
---|
38 | set blue 0 |
---|
39 | set color #ffff00000000 |
---|
40 | set updating 0 |
---|
41 | set autoUpdate 1 |
---|
42 | set name "" |
---|
43 | |
---|
44 | if {$tcl_platform(platform) eq "unix"} { |
---|
45 | option add *Entry.background white |
---|
46 | } |
---|
47 | |
---|
48 | # Create the menu bar at the top of the window. |
---|
49 | |
---|
50 | . configure -menu [menu .menu] |
---|
51 | menu .menu.file |
---|
52 | .menu add cascade -menu .menu.file -label File -underline 0 |
---|
53 | .menu.file add radio -label "RGB color space" -variable colorSpace \ |
---|
54 | -value rgb -underline 0 -command {changeColorSpace rgb} |
---|
55 | .menu.file add radio -label "CMY color space" -variable colorSpace \ |
---|
56 | -value cmy -underline 0 -command {changeColorSpace cmy} |
---|
57 | .menu.file add radio -label "HSB color space" -variable colorSpace \ |
---|
58 | -value hsb -underline 0 -command {changeColorSpace hsb} |
---|
59 | .menu.file add separator |
---|
60 | .menu.file add radio -label "Automatic updates" -variable autoUpdate \ |
---|
61 | -value 1 -underline 0 |
---|
62 | .menu.file add radio -label "Manual updates" -variable autoUpdate \ |
---|
63 | -value 0 -underline 0 |
---|
64 | .menu.file add separator |
---|
65 | .menu.file add command -label "Exit program" -underline 0 -command {exit} |
---|
66 | |
---|
67 | # Create the command entry window at the bottom of the window, along |
---|
68 | # with the update button. |
---|
69 | |
---|
70 | labelframe .command -text "Command:" -padx {1m 0} |
---|
71 | entry .command.e -relief sunken -borderwidth 2 -textvariable command \ |
---|
72 | -font {Courier 12} |
---|
73 | button .command.update -text Update -command doUpdate |
---|
74 | pack .command.update -side right -pady .1c -padx {.25c 0} |
---|
75 | pack .command.e -expand yes -fill x -ipadx 0.25c |
---|
76 | |
---|
77 | |
---|
78 | # Create the listbox that holds all of the color names in rgb.txt, |
---|
79 | # if an rgb.txt file can be found. |
---|
80 | |
---|
81 | grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m} |
---|
82 | |
---|
83 | grid columnconfigure . {1 2} -weight 1 |
---|
84 | grid rowconfigure . 0 -weight 1 |
---|
85 | foreach i { |
---|
86 | /usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt |
---|
87 | /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt |
---|
88 | /usr/openwin/lib/X11/rgb.txt |
---|
89 | } { |
---|
90 | if {![file readable $i]} { |
---|
91 | continue; |
---|
92 | } |
---|
93 | set f [open $i] |
---|
94 | labelframe .names -text "Select:" -padx .1c -pady .1c |
---|
95 | grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2 |
---|
96 | grid columnconfigure . 0 -weight 1 |
---|
97 | listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \ |
---|
98 | -relief sunken -borderwidth 2 -exportselection false |
---|
99 | bind .names.lb <Double-1> { |
---|
100 | tc_loadNamedColor [.names.lb get [.names.lb curselection]] |
---|
101 | } |
---|
102 | scrollbar .names.s -orient vertical -command ".names.lb yview" \ |
---|
103 | -relief sunken -borderwidth 2 |
---|
104 | pack .names.lb .names.s -side left -fill y -expand 1 |
---|
105 | while {[gets $f line] >= 0} { |
---|
106 | if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} { |
---|
107 | .names.lb insert end $col |
---|
108 | } |
---|
109 | } |
---|
110 | close $f |
---|
111 | break |
---|
112 | } |
---|
113 | |
---|
114 | # Create the three scales for editing the color, and the entry for |
---|
115 | # typing in a color value. |
---|
116 | |
---|
117 | frame .adjust |
---|
118 | foreach i {1 2 3} { |
---|
119 | label .adjust.l$i -textvariable label$i -pady 0 |
---|
120 | labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m |
---|
121 | scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \ |
---|
122 | -command tc_scaleChanged |
---|
123 | pack .scale$i -in .adjust.$i |
---|
124 | pack .adjust.$i |
---|
125 | } |
---|
126 | grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c |
---|
127 | |
---|
128 | labelframe .name -text "Name:" -padx 1m -pady 1m |
---|
129 | entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \ |
---|
130 | -font {Courier 12} |
---|
131 | pack .name.e -side right -expand 1 -fill x |
---|
132 | bind .name.e <Return> {tc_loadNamedColor $name} |
---|
133 | grid .name -column 1 -row 1 -sticky nsew -padx .15c -pady .15c |
---|
134 | |
---|
135 | # Create the color display swatch on the right side of the window. |
---|
136 | |
---|
137 | labelframe .sample -text "Color:" -padx 1m -pady 1m |
---|
138 | frame .sample.swatch -width 2c -height 5c -background $color |
---|
139 | label .sample.value -textvariable color -width 13 -font {Courier 12} |
---|
140 | pack .sample.swatch -side top -expand yes -fill both |
---|
141 | pack .sample.value -side bottom -pady .25c |
---|
142 | grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2 |
---|
143 | |
---|
144 | |
---|
145 | # The procedure below is invoked when one of the scales is adjusted. |
---|
146 | # It propagates color information from the current scale readings |
---|
147 | # to everywhere else that it is used. |
---|
148 | |
---|
149 | proc tc_scaleChanged args { |
---|
150 | global red green blue colorSpace color updating autoUpdate |
---|
151 | if {$updating} { |
---|
152 | return |
---|
153 | } |
---|
154 | switch $colorSpace { |
---|
155 | rgb { |
---|
156 | set red [format %.0f [expr {[.scale1 get]*65.535}]] |
---|
157 | set green [format %.0f [expr {[.scale2 get]*65.535}]] |
---|
158 | set blue [format %.0f [expr {[.scale3 get]*65.535}]] |
---|
159 | } |
---|
160 | cmy { |
---|
161 | set red [format %.0f [expr {65535 - [.scale1 get]*65.535}]] |
---|
162 | set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]] |
---|
163 | set blue [format %.0f [expr {65535 - [.scale3 get]*65.535}]] |
---|
164 | } |
---|
165 | hsb { |
---|
166 | set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \ |
---|
167 | [expr {[.scale2 get]/1000.0}] \ |
---|
168 | [expr {[.scale3 get]/1000.0}]] |
---|
169 | set red [lindex $list 0] |
---|
170 | set green [lindex $list 1] |
---|
171 | set blue [lindex $list 2] |
---|
172 | } |
---|
173 | } |
---|
174 | set color [format "#%04x%04x%04x" $red $green $blue] |
---|
175 | .sample.swatch config -bg $color |
---|
176 | if {$autoUpdate} doUpdate |
---|
177 | update idletasks |
---|
178 | } |
---|
179 | |
---|
180 | # The procedure below is invoked to update the scales from the |
---|
181 | # current red, green, and blue intensities. It's invoked after |
---|
182 | # a change in the color space and after a named color value has |
---|
183 | # been loaded. |
---|
184 | |
---|
185 | proc tc_setScales {} { |
---|
186 | global red green blue colorSpace updating |
---|
187 | set updating 1 |
---|
188 | switch $colorSpace { |
---|
189 | rgb { |
---|
190 | .scale1 set [format %.0f [expr {$red/65.535}]] |
---|
191 | .scale2 set [format %.0f [expr {$green/65.535}]] |
---|
192 | .scale3 set [format %.0f [expr {$blue/65.535}]] |
---|
193 | } |
---|
194 | cmy { |
---|
195 | .scale1 set [format %.0f [expr {(65535-$red)/65.535}]] |
---|
196 | .scale2 set [format %.0f [expr {(65535-$green)/65.535}]] |
---|
197 | .scale3 set [format %.0f [expr {(65535-$blue)/65.535}]] |
---|
198 | } |
---|
199 | hsb { |
---|
200 | set list [rgbToHsv $red $green $blue] |
---|
201 | .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]] |
---|
202 | .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]] |
---|
203 | .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]] |
---|
204 | } |
---|
205 | } |
---|
206 | set updating 0 |
---|
207 | } |
---|
208 | |
---|
209 | # The procedure below is invoked when a named color has been |
---|
210 | # selected from the listbox or typed into the entry. It loads |
---|
211 | # the color into the editor. |
---|
212 | |
---|
213 | proc tc_loadNamedColor name { |
---|
214 | global red green blue color autoUpdate |
---|
215 | |
---|
216 | if {[string index $name 0] != "#"} { |
---|
217 | set list [winfo rgb .sample.swatch $name] |
---|
218 | set red [lindex $list 0] |
---|
219 | set green [lindex $list 1] |
---|
220 | set blue [lindex $list 2] |
---|
221 | } else { |
---|
222 | switch [string length $name] { |
---|
223 | 4 {set format "#%1x%1x%1x"; set shift 12} |
---|
224 | 7 {set format "#%2x%2x%2x"; set shift 8} |
---|
225 | 10 {set format "#%3x%3x%3x"; set shift 4} |
---|
226 | 13 {set format "#%4x%4x%4x"; set shift 0} |
---|
227 | default {error "syntax error in color name \"$name\""} |
---|
228 | } |
---|
229 | if {[scan $name $format red green blue] != 3} { |
---|
230 | error "syntax error in color name \"$name\"" |
---|
231 | } |
---|
232 | set red [expr {$red<<$shift}] |
---|
233 | set green [expr {$green<<$shift}] |
---|
234 | set blue [expr {$blue<<$shift}] |
---|
235 | } |
---|
236 | tc_setScales |
---|
237 | set color [format "#%04x%04x%04x" $red $green $blue] |
---|
238 | .sample.swatch config -bg $color |
---|
239 | if {$autoUpdate} doUpdate |
---|
240 | } |
---|
241 | |
---|
242 | # The procedure below is invoked when a new color space is selected. |
---|
243 | # It changes the labels on the scales and re-loads the scales with |
---|
244 | # the appropriate values for the current color in the new color space |
---|
245 | |
---|
246 | proc changeColorSpace space { |
---|
247 | global label1 label2 label3 |
---|
248 | switch $space { |
---|
249 | rgb { |
---|
250 | set label1 "Adjust Red:" |
---|
251 | set label2 "Adjust Green:" |
---|
252 | set label3 "Adjust Blue:" |
---|
253 | tc_setScales |
---|
254 | return |
---|
255 | } |
---|
256 | cmy { |
---|
257 | set label1 "Adjust Cyan:" |
---|
258 | set label2 "Adjust Magenta:" |
---|
259 | set label3 "Adjust Yellow:" |
---|
260 | tc_setScales |
---|
261 | return |
---|
262 | } |
---|
263 | hsb { |
---|
264 | set label1 "Adjust Hue:" |
---|
265 | set label2 "Adjust Saturation:" |
---|
266 | set label3 "Adjust Brightness:" |
---|
267 | tc_setScales |
---|
268 | return |
---|
269 | } |
---|
270 | } |
---|
271 | } |
---|
272 | |
---|
273 | # The procedure below converts an RGB value to HSB. It takes red, green, |
---|
274 | # and blue components (0-65535) as arguments, and returns a list containing |
---|
275 | # HSB components (floating-point, 0-1) as result. The code here is a copy |
---|
276 | # of the code on page 615 of "Fundamentals of Interactive Computer Graphics" |
---|
277 | # by Foley and Van Dam. |
---|
278 | |
---|
279 | proc rgbToHsv {red green blue} { |
---|
280 | if {$red > $green} { |
---|
281 | set max [expr {double($red)}] |
---|
282 | set min [expr {double($green)}] |
---|
283 | } else { |
---|
284 | set max [expr {double($green)}] |
---|
285 | set min [expr {double($red)}] |
---|
286 | } |
---|
287 | if {$blue > $max} { |
---|
288 | set max [expr {double($blue)}] |
---|
289 | } elseif {$blue < $min} { |
---|
290 | set min [expr {double($blue)}] |
---|
291 | } |
---|
292 | set range [expr {$max-$min}] |
---|
293 | if {$max == 0} { |
---|
294 | set sat 0 |
---|
295 | } else { |
---|
296 | set sat [expr {($max-$min)/$max}] |
---|
297 | } |
---|
298 | if {$sat == 0} { |
---|
299 | set hue 0 |
---|
300 | } else { |
---|
301 | set rc [expr {($max - $red)/$range}] |
---|
302 | set gc [expr {($max - $green)/$range}] |
---|
303 | set bc [expr {($max - $blue)/$range}] |
---|
304 | if {$red == $max} { |
---|
305 | set hue [expr {($bc - $gc)/6.0}] |
---|
306 | } elseif {$green == $max} { |
---|
307 | set hue [expr {(2 + $rc - $bc)/6.0}] |
---|
308 | } else { |
---|
309 | set hue [expr {(4 + $gc - $rc)/6.0}] |
---|
310 | } |
---|
311 | if {$hue < 0.0} { |
---|
312 | set hue [expr {$hue + 1.0}] |
---|
313 | } |
---|
314 | } |
---|
315 | return [list $hue $sat [expr {$max/65535}]] |
---|
316 | } |
---|
317 | |
---|
318 | # The procedure below converts an HSB value to RGB. It takes hue, saturation, |
---|
319 | # and value components (floating-point, 0-1.0) as arguments, and returns a |
---|
320 | # list containing RGB components (integers, 0-65535) as result. The code |
---|
321 | # here is a copy of the code on page 616 of "Fundamentals of Interactive |
---|
322 | # Computer Graphics" by Foley and Van Dam. |
---|
323 | |
---|
324 | proc hsbToRgb {hue sat value} { |
---|
325 | set v [format %.0f [expr {65535.0*$value}]] |
---|
326 | if {$sat == 0} { |
---|
327 | return "$v $v $v" |
---|
328 | } else { |
---|
329 | set hue [expr {$hue*6.0}] |
---|
330 | if {$hue >= 6.0} { |
---|
331 | set hue 0.0 |
---|
332 | } |
---|
333 | scan $hue. %d i |
---|
334 | set f [expr {$hue-$i}] |
---|
335 | set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]] |
---|
336 | set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]] |
---|
337 | set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]] |
---|
338 | switch $i { |
---|
339 | 0 {return "$v $t $p"} |
---|
340 | 1 {return "$q $v $p"} |
---|
341 | 2 {return "$p $v $t"} |
---|
342 | 3 {return "$p $q $v"} |
---|
343 | 4 {return "$t $p $v"} |
---|
344 | 5 {return "$v $p $q"} |
---|
345 | default {error "i value $i is out of range"} |
---|
346 | } |
---|
347 | } |
---|
348 | } |
---|
349 | |
---|
350 | # The procedure below is invoked when the "Update" button is pressed, |
---|
351 | # and whenever the color changes if update mode is enabled. It |
---|
352 | # propagates color information as determined by the command in the |
---|
353 | # Command entry. |
---|
354 | |
---|
355 | proc doUpdate {} { |
---|
356 | global color command |
---|
357 | set newCmd $command |
---|
358 | regsub -all %% $command $color newCmd |
---|
359 | eval $newCmd |
---|
360 | } |
---|
361 | |
---|
362 | changeColorSpace hsb |
---|
363 | |
---|
364 | # Local Variables: |
---|
365 | # mode: tcl |
---|
366 | # End: |
---|