| 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: |