1#!/bin/sh 2# the next line restarts using wish \ 3exec 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.10 96/02/16 10:49:25 11 12wm 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 35set colorSpace hsb 36set red 65535 37set green 0 38set blue 0 39set color #ffff00000000 40set updating 0 41set autoUpdate 1 42set name "" 43 44# Create the menu bar at the top of the window. 45 46frame .menu -relief raised -borderwidth 2 47pack .menu -side top -fill x 48menubutton .menu.file -text File -menu .menu.file.m -underline 0 49menu .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 ." 64pack .menu.file -side left 65 66# Create the command entry window at the bottom of the window, along 67# with the update button. 68 69frame .bot -relief raised -borderwidth 2 70pack .bot -side bottom -fill x 71label .commandLabel -text "Command:" 72entry .command -relief sunken -borderwidth 2 -textvariable command \ 73 -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* 74button .update -text Update -command doUpdate 75pack .commandLabel -in .bot -side left 76pack .update -in .bot -side right -pady .1c -padx .25c 77pack .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 82frame .middle -relief raised -borderwidth 2 83pack .middle -side top -fill both 84foreach 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 <Double-1> { 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 114frame .middle.middle 115pack .middle.middle -side left -expand yes -fill y 116frame .middle.middle.1 117frame .middle.middle.2 118frame .middle.middle.3 119frame .middle.middle.4 120pack .middle.middle.1 .middle.middle.2 .middle.middle.3 -side top -expand yes 121pack .middle.middle.4 -side top -expand yes -fill x 122foreach 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} 128label .nameLabel -text "Name:" 129entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \ 130 -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* 131pack .nameLabel -in .middle.middle.4 -side left 132pack .name -in .middle.middle.4 -side right -expand 1 -fill x 133bind .name <Return> {tc_loadNamedColor $name} 134 135# Create the color display swatch on the right side of the window. 136 137frame .middle.right 138pack .middle.right -side left -pady .25c -padx .25c -anchor s 139frame .swatch -width 2c -height 5c -background $color 140label .value -textvariable color -width 13 \ 141 -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* 142pack .swatch -in .middle.right -side top -expand yes -fill both 143pack .value -in .middle.right -side bottom -pady .25c 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 149proc tc_scaleChanged args { 150 global red green blue colorSpace color updating autoUpdate 151 if $updating { 152 return 153 } 154 if {$colorSpace == "rgb"} { 155 set red [format %.0f [expr [.scale1 get]*65.535]] 156 set green [format %.0f [expr [.scale2 get]*65.535]] 157 set blue [format %.0f [expr [.scale3 get]*65.535]] 158 } else { 159 if {$colorSpace == "cmy"} { 160 set red [format %.0f [expr {65535 - [.scale1 get]*65.535}]] 161 set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]] 162 set blue [format %.0f [expr {65535 - [.scale3 get]*65.535}]] 163 } else { 164 set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \ 165 [expr {[.scale2 get]/1000.0}] \ 166 [expr {[.scale3 get]/1000.0}]] 167 set red [lindex $list 0] 168 set green [lindex $list 1] 169 set blue [lindex $list 2] 170 } 171 } 172 set color [format "#%04x%04x%04x" $red $green $blue] 173 .swatch config -bg $color 174 if $autoUpdate doUpdate 175 update idletasks 176} 177 178# The procedure below is invoked to update the scales from the 179# current red, green, and blue intensities. It's invoked after 180# a change in the color space and after a named color value has 181# been loaded. 182 183proc tc_setScales {} { 184 global red green blue colorSpace updating 185 set updating 1 186 if {$colorSpace == "rgb"} { 187 .scale1 set [format %.0f [expr $red/65.535]] 188 .scale2 set [format %.0f [expr $green/65.535]] 189 .scale3 set [format %.0f [expr $blue/65.535]] 190 } else { 191 if {$colorSpace == "cmy"} { 192 .scale1 set [format %.0f [expr (65535-$red)/65.535]] 193 .scale2 set [format %.0f [expr (65535-$green)/65.535]] 194 .scale3 set [format %.0f [expr (65535-$blue)/65.535]] 195 } else { 196 set list [rgbToHsv $red $green $blue] 197 .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]] 198 .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]] 199 .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]] 200 } 201 } 202 set updating 0 203} 204 205# The procedure below is invoked when a named color has been 206# selected from the listbox or typed into the entry. It loads 207# the color into the editor. 208 209proc tc_loadNamedColor name { 210 global red green blue color autoUpdate 211 212 if {[string index $name 0] != "#"} { 213 set list [winfo rgb .swatch $name] 214 set red [lindex $list 0] 215 set green [lindex $list 1] 216 set blue [lindex $list 2] 217 } else { 218 case [string length $name] { 219 4 {set format "#%1x%1x%1x"; set shift 12} 220 7 {set format "#%2x%2x%2x"; set shift 8} 221 10 {set format "#%3x%3x%3x"; set shift 4} 222 13 {set format "#%4x%4x%4x"; set shift 0} 223 default {error "syntax error in color name \"$name\""} 224 } 225 if {[scan $name $format red green blue] != 3} { 226 error "syntax error in color name \"$name\"" 227 } 228 set red [expr $red<<$shift] 229 set green [expr $green<<$shift] 230 set blue [expr $blue<<$shift] 231 } 232 tc_setScales 233 set color [format "#%04x%04x%04x" $red $green $blue] 234 .swatch config -bg $color 235 if $autoUpdate doUpdate 236} 237 238# The procedure below is invoked when a new color space is selected. 239# It changes the labels on the scales and re-loads the scales with 240# the appropriate values for the current color in the new color space 241 242proc changeColorSpace space { 243 global label1 label2 label3 244 if {$space == "rgb"} { 245 set label1 Red 246 set label2 Green 247 set label3 Blue 248 tc_setScales 249 return 250 } 251 if {$space == "cmy"} { 252 set label1 Cyan 253 set label2 Magenta 254 set label3 Yellow 255 tc_setScales 256 return 257 } 258 if {$space == "hsb"} { 259 set label1 Hue 260 set label2 Saturation 261 set label3 Brightness 262 tc_setScales 263 return 264 } 265} 266 267# The procedure below converts an RGB value to HSB. It takes red, green, 268# and blue components (0-65535) as arguments, and returns a list containing 269# HSB components (floating-point, 0-1) as result. The code here is a copy 270# of the code on page 615 of "Fundamentals of Interactive Computer Graphics" 271# by Foley and Van Dam. 272 273proc rgbToHsv {red green blue} { 274 if {$red > $green} { 275 set max $red.0 276 set min $green.0 277 } else { 278 set max $green.0 279 set min $red.0 280 } 281 if {$blue > $max} { 282 set max $blue.0 283 } else { 284 if {$blue < $min} { 285 set min $blue.0 286 } 287 } 288 set range [expr $max-$min] 289 if {$max == 0} { 290 set sat 0 291 } else { 292 set sat [expr {($max-$min)/$max}] 293 } 294 if {$sat == 0} { 295 set hue 0 296 } else { 297 set rc [expr {($max - $red)/$range}] 298 set gc [expr {($max - $green)/$range}] 299 set bc [expr {($max - $blue)/$range}] 300 if {$red == $max} { 301 set hue [expr {.166667*($bc - $gc)}] 302 } else { 303 if {$green == $max} { 304 set hue [expr {.166667*(2 + $rc - $bc)}] 305 } else { 306 set hue [expr {.166667*(4 + $gc - $rc)}] 307 } 308 } 309 if {$hue < 0.0} { 310 set hue [expr $hue + 1.0] 311 } 312 } 313 return [list $hue $sat [expr {$max/65535}]] 314} 315 316# The procedure below converts an HSB value to RGB. It takes hue, saturation, 317# and value components (floating-point, 0-1.0) as arguments, and returns a 318# list containing RGB components (integers, 0-65535) as result. The code 319# here is a copy of the code on page 616 of "Fundamentals of Interactive 320# Computer Graphics" by Foley and Van Dam. 321 322proc hsbToRgb {hue sat value} { 323 set v [format %.0f [expr 65535.0*$value]] 324 if {$sat == 0} { 325 return "$v $v $v" 326 } else { 327 set hue [expr $hue*6.0] 328 if {$hue >= 6.0} { 329 set hue 0.0 330 } 331 scan $hue. %d i 332 set f [expr $hue-$i] 333 set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]] 334 set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]] 335 set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]] 336 case $i \ 337 0 {return "$v $t $p"} \ 338 1 {return "$q $v $p"} \ 339 2 {return "$p $v $t"} \ 340 3 {return "$p $q $v"} \ 341 4 {return "$t $p $v"} \ 342 5 {return "$v $p $q"} 343 error "i value $i is out of range" 344 } 345} 346 347# The procedure below is invoked when the "Update" button is pressed, 348# and whenever the color changes if update mode is enabled. It 349# propagates color information as determined by the command in the 350# Command entry. 351 352proc doUpdate {} { 353 global color command 354 set newCmd $command 355 regsub -all %% $command $color newCmd 356 eval $newCmd 357} 358 359changeColorSpace hsb 360