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# RCS: @(#) $Id: tcolor,v 1.3 2001/10/29 16:23:32 dkf Exp $ 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 44if {$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] 51menu .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 70labelframe .command -text "Command:" -padx {1m 0} 71entry .command.e -relief sunken -borderwidth 2 -textvariable command \ 72 -font {Courier 12} 73button .command.update -text Update -command doUpdate 74pack .command.update -side right -pady .1c -padx {.25c 0} 75pack .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 81grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m} 82 83grid columnconfigure . {1 2} -weight 1 84grid rowconfigure . 0 -weight 1 85foreach 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 117frame .adjust 118foreach 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} 126grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c 127 128labelframe .name -text "Name:" -padx 1m -pady 1m 129entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \ 130 -font {Courier 12} 131pack .name.e -side right -expand 1 -fill x 132bind .name.e <Return> {tc_loadNamedColor $name} 133grid .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 137labelframe .sample -text "Color:" -padx 1m -pady 1m 138frame .sample.swatch -width 2c -height 5c -background $color 139label .sample.value -textvariable color -width 13 -font {Courier 12} 140pack .sample.swatch -side top -expand yes -fill both 141pack .sample.value -side bottom -pady .25c 142grid .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 149proc 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 185proc 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 213proc 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 246proc 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 279proc 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 324proc 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 355proc doUpdate {} { 356 global color command 357 set newCmd $command 358 regsub -all %% $command $color newCmd 359 eval $newCmd 360} 361 362changeColorSpace hsb 363 364# Local Variables: 365# mode: tcl 366# End: 367