Commit | Line | Data |
---|---|---|
920dae64 AT |
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: |