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