1 2proc color_generate {index} { 3 set index [expr abs($index) % 132] 4 set i [expr $index % 12] 5 set h [lindex {0 1 2 3 4 5 .5 1.25 2.65 3.4 4.5 5.5} $i] 6 set i [expr int($h)] 7 set h [expr $h - double($i)] 8 set j [expr $index / 12] 9 if {[expr $j % 2] == 0} { 10 set v 1.0 11 set s [expr 1.0 - sqrt(double($j) / 22.0)] 12 } else { 13 set v [expr 1.0 - sqrt(double($j) / 44.0)] 14 set s 1.0 15 } 16 switch $i { 17 0 { 18 set r $v 19 set g [expr $v * (1.0 - ($s * (1.0 - $h)))] 20 set b [expr $v * (1.0 - $s)] 21 } 22 1 { 23 set r [expr $v * (1.0 - ($s * $h))] 24 set g $v 25 set b [expr $v * (1.0 - $s)] 26 } 27 2 { 28 set r [expr $v * (1.0 - $s)] 29 set g $v 30 set b [expr $v * (1.0 - ($s * (1.0 - $h)))] 31 } 32 3 { 33 set r [expr $v * (1.0 - $s)] 34 set g [expr $v * (1.0 - ($s * $h))] 35 set b $v 36 } 37 4 { 38 set r [expr $v * (1.0 - ($s * (1.0 - $h)))] 39 set g [expr $v * (1.0 - $s)] 40 set b $v 41 } 42 5 { 43 set r $v 44 set g [expr $v * (1.0 - $s)] 45 set b [expr $v * (1.0 - ($s * $h))] 46 } 47 6 { 48 set r $v 49 set g [expr $v * (1.0 - $s)] 50 set b [expr $v * (1.0 - $s)] 51 } 52 } 53 54 if [expr $r < 0.0] {set r 0.0} 55 if [expr $r > 1.0] {set r 1.0} 56 if [expr $g < 0.0] {set g 0.0} 57 if [expr $g > 1.0] {set g 1.0} 58 if [expr $b < 0.0] {set b 0.0} 59 if [expr $b > 1.0] {set b 1.0} 60 61 return [list $r $g $b] 62} 63 64proc color_value {rgb} { 65 return [format "#%2.2x%2.2x%2.2x" \ 66 [expr int(255.0 * [lindex $rgb 0])] \ 67 [expr int(255.0 * [lindex $rgb 1])] \ 68 [expr int(255.0 * [lindex $rgb 2])]] 69} 70 71proc color_lighten {rgb {amt 0.25}} { 72 set newclr "" 73 foreach c $rgb { 74 set nc [expr $c + $amt] 75 if [expr $nc < 0.0] {set nc 0.0} 76 if [expr $nc > 1.0] {set nc 1.0} 77 lappend newclr $nc 78 } 79 return $newclr 80} 81 82proc color_darken {rgb {amt 0.25}} { 83 set newclr "" 84 foreach c $rgb { 85 set nc [expr $c - $amt] 86 if [expr $nc < 0.0] {set nc 0.0} 87 if [expr $nc > 1.0] {set nc 1.0} 88 lappend newclr $nc 89 } 90 return $newclr 91} 92 93proc color_gray {rgb} { 94 set gray [expr 0.30 * [lindex $rgb 0] + \ 95 0.59 * [lindex $rgb 1] + \ 96 0.11 * [lindex $rgb 2]] 97 if [expr $gray < 0.0] {return 0.0} 98 if [expr $gray > 1.0] {return 1.0} 99 return $gray 100} 101 102array set _ColorData { 103 win "" 104 done 0 105 red 127 106 green 127 107 blue 127 108 red,y 0 109 green,y 0 110 blue,y 0 111 colorbars 16 112 arrowsize 5 113 hue {0 6 1 2 3 9 10 5} 114 sat {10 6 2 0 1 5 9} 115} 116 117proc color_select {w title {oldclr ""} {loc ""}} { 118 global _ColorData 119 120 if {[llength $oldclr] == 3} { 121 set r [expr int(255.0 * [lindex $oldclr 0])] 122 if {$r < 0} { 123 set _ColorData(red) 0 124 } elseif {$r > 255} { 125 set _ColorData(red) 255 126 } else { 127 set _ColorData(red) $r 128 } 129 set g [expr int(255.0 * [lindex $oldclr 1])] 130 if {$g < 0} { 131 set _ColorData(green) 0 132 } elseif {$g > 255} { 133 set _ColorData(green) 255 134 } else { 135 set _ColorData(green) $g 136 } 137 set b [expr int(255.0 * [lindex $oldclr 2])] 138 if {$b < 0} { 139 set _ColorData(blue) 0 140 } elseif {$b > 255} { 141 set _ColorData(blue) 255 142 } else { 143 set _ColorData(blue) $b 144 } 145 } 146 147 set _ColorData(win) $w 148 catch {destroy $w} 149 toplevel $w 150 wm protocol $w WM_DELETE_WINDOW {set _ColorData(done) 0} 151 wm title $w $title 152 wm transient $w [winfo toplevel [winfo parent $w]] 153 wm resizable $w 0 0 154 155 frame $w.l 156 pack $w.l -side left -fill y -expand yes -padx 5 -pady 5 157 158 frame $w.l.t 159 pack $w.l.t -side top -pady 5 -anchor n 160 161 for {set j 0} {$j < 7} {incr j} { 162 set f [frame $w.l.t.y$j] 163 pack $f -side top -fill x 164 set sat [lindex $_ColorData(sat) $j] 165 for {set i 0} {$i < 8} {incr i} { 166 set hue [lindex $_ColorData(hue) $i] 167 set n [expr $hue + 12 * $sat] 168 set rgb [color_generate $n] 169 set clr [color_value $rgb] 170 button $f.b$i -padx 3m -pady 1m -bg $clr -activebackground $clr \ 171 -command "color:setrgb $rgb" 172 pack $f.b$i -side left 173 } 174 } 175 set f [frame $w.l.t.y8] 176 pack $f -side top -fill x 177 for {set i 0} {$i < 8} {incr i} { 178 set g [expr double($i) / 7.0] 179 set rgb [list $g $g $g] 180 set clr [color_value $rgb] 181 button $f.b$i -padx 3m -pady 1m -bg $clr -activebackground $clr \ 182 -command "color:setrgb $rgb" 183 pack $f.b$i -side left 184 } 185 186 frame $w.l.b 187 pack $w.l.b -side bottom -fill both -expand yes 188 189 set f [frame $w.l.b.b] 190 pack $f -side left -padx 5 -pady 5 -fill y -expand yes 191 button $f.a -text Accept -underline 0 -padx 3m -pady 1m \ 192 -command {set _ColorData(done) 1} 193 button $f.c -text Cancel -underline 0 -padx 3m -pady 1m \ 194 -command {set _ColorData(done) 0} 195 pack $f.a $f.c -side top -expand yes 196 197 bind $w <Alt-a> "$f.a flash; set _ColorData(done) 1" 198 bind $w <Alt-c> "$f.c flash; set _ColorData(done) 0" 199 200 frame $w.l.b.s -relief sunken -bd 2 -width 100 -height 50 \ 201 -bg [format "#%2.2x%2.2x%2.2x" \ 202 $_ColorData(red) $_ColorData(green) $_ColorData(blue)] 203 pack $w.l.b.s -side right -expand yes -fill both -padx 2 -pady 5 204 205 frame $w.r 206 pack $w.r -side right -fill y -expand yes -padx 5 -pady 10 207 208 set width [expr {[winfo reqwidth $w.l.t.y0.b0] - \ 209 2*([$w.l.t.y0.b0 cget -highlightthickness] + \ 210 [$w.l.t.y0.b0 cget -bd])}] 211 set height [expr 8 * [winfo reqheight $w.l.t.y0.b0]] 212 213 foreach {c l} {red R green G blue B} { 214 set f [frame $w.r.$c] 215 if {$c == "green"} { 216 pack $f -side left -fill y -expand yes -padx 5 217 } else { 218 pack $f -side left -fill y -expand yes 219 } 220 221 set box [frame $f.box] 222 pack $box -side bottom -fill x -expand yes 223 224 label $box.lab -text $l 225 entry $box.ent -width 4 -textvariable _ColorData($c) 226 pack $box.lab $box.ent -side top -fill x -expand yes 227 228 bind $box.ent <Return> [list color:entryvalue $c] 229 230 canvas $f.color -height $height -width $width -relief sunken -bd 2 231 pack $f.color -side left -expand yes -fill both 232 canvas $f.sel -height $height -width [expr 2 * $_ColorData(arrowsize)] \ 233 -highlightthickness 0 234 pack $f.sel -side right -expand yes -fill y 235 236 bind $f.color <Configure> "color:drawscale $c" 237 238 bind $f.color <Enter> "color:selColor $f $c red" 239 bind $f.color <Leave> "color:selColor $f $c black" 240 bind $f.color <ButtonPress-1> "color:Move $f $c %y" 241 bind $f.color <B1-Motion> "color:Move $f $c %y" 242 bind $f.color <ButtonRelease-1> "color:endMove $f $c %y" 243 244 bind $f.sel <Enter> "color:selColor $f $c red" 245 bind $f.sel <Leave> "color:selColor $f $c black" 246 bind $f.sel <ButtonPress-1> "color:Move $f $c %y" 247 bind $f.sel <B1-Motion> "color:Move $f $c %y" 248 bind $f.sel <ButtonRelease-1> "color:endMove $f $c %y" 249 } 250 251 if {$loc != ""} {center_window $w $loc} 252 253 set oldFocus [focus] 254 set oldGrab [grab current $w] 255 if {$oldGrab != ""} { 256 set grabStatus [grab status $oldGrab] 257 } 258 catch {grab $w} 259 tkwait visibility $w 260 raise $w 261 focus $w 262 tkwait variable _ColorData(done) 263 catch {focus $oldFocus} 264 destroy $w 265 if {$oldGrab != ""} { 266 if {$grabStatus == "global"} { 267 grab -global $oldGrab 268 } else { 269 grab $oldGrab 270 } 271 } 272 273 if {$_ColorData(done)} { 274 set r [format "%.3f" [expr double($_ColorData(red)) / 255.0]] 275 set g [format "%.3f" [expr double($_ColorData(green)) / 255.0]] 276 set b [format "%.3f" [expr double($_ColorData(blue)) / 255.0]] 277 return [list $r $g $b] 278 } 279 return "" 280} 281 282proc color:setrgb {r g b} { 283 global _ColorData 284 285 set _ColorData(red) [expr int(255.0 * $r)] 286 set _ColorData(green) [expr int(255.0 * $g)] 287 set _ColorData(blue) [expr int(255.0 * $b)] 288 289 color:updateall 290} 291 292proc color:entryvalue {clr} { 293 global _ColorData 294 295 if {[catch { 296 set val [expr int($_ColorData($clr))]} 297 ]} {set val 0} 298 if {$val < 0} {set val 0} 299 if {$val > 255} {set val 255} 300 set _ColorData($clr) $val 301 302 color:updateall 303} 304 305proc color:drawcolor {} { 306 global _ColorData 307 308 set color [format "#%2.2x%2.2x%2.2x" \ 309 $_ColorData(red) $_ColorData(green) $_ColorData(blue)] 310 $_ColorData(win).l.b.s configure -bg $color 311} 312 313proc color:drawscale {clr} { 314 global _ColorData 315 316 set dc [expr 255.0 / double($_ColorData(colorbars))] 317 set bar $_ColorData(win).r.$clr.color 318 $bar delete all 319 set height [winfo height $bar] 320 set dx [winfo width $bar] 321 set dy [expr double($height) / $_ColorData(colorbars)] 322 for {set i 0} {$i < $_ColorData(colorbars)} {incr i} { 323 set y [expr $i * $dy] 324 set c [expr 255 - int($i * $dc)] 325 if {$clr == "red"} { 326 set color [format "#%2.2x%2.2x%2.2x" \ 327 $c $_ColorData(green) $_ColorData(blue)] 328 } elseif {$clr == "green"} { 329 set color [format "#%2.2x%2.2x%2.2x" \ 330 $_ColorData(red) $c $_ColorData(blue)] 331 } else { 332 set color [format "#%2.2x%2.2x%2.2x" \ 333 $_ColorData(red) $_ColorData(green) $c] 334 } 335 $bar create rect 0 $y $dx [expr $y + $dy] \ 336 -fill $color -outline $color 337 } 338 339 set sel $_ColorData(win).r.$clr.sel 340 set y [expr $_ColorData(arrowsize) + \ 341 ($height - 2 * $_ColorData(arrowsize)) * \ 342 (1.0 - $_ColorData($clr) / 255.0)] 343 set _ColorData($clr,y) $y 344 $sel delete all 345 set _ColorData($clr,sel) [$sel create polygon 0 $y \ 346 [expr 2 * $_ColorData(arrowsize)] [expr $y + $_ColorData(arrowsize)] \ 347 [expr 2 * $_ColorData(arrowsize)] [expr $y - $_ColorData(arrowsize)]] 348} 349 350proc color:updateall {} { 351 color:drawcolor 352 color:drawscale red 353 color:drawscale green 354 color:drawscale blue 355} 356 357proc color:selColor {f clr selclr} { 358 global _ColorData 359 360 $f.sel itemconfigure $_ColorData($clr,sel) -fill $selclr 361} 362 363proc color:Move {f clr y} { 364 global _ColorData 365 366 set bar $f.color 367 set height [winfo height $bar] 368 if {$y < 0} {set y 0} 369 if {$y > $height} {set y $height} 370 set c [expr int(255.0 * (1.0 - double($y) / double($height)))] 371 if {$c < 0} {set c 0} 372 if {$c > 255} {set c 255} 373 set _ColorData($clr) $c 374 color:drawcolor 375 376 incr height -$_ColorData(arrowsize) 377 if {$y < $_ColorData(arrowsize)} {set y $_ColorData(arrowsize)} 378 if {$y > $height} {set y $height} 379 set diff [expr $y - $_ColorData($clr,y)] 380 $f.sel move $_ColorData($clr,sel) 0 $diff 381 set _ColorData($clr,y) [expr $_ColorData($clr,y) + $diff] 382} 383 384proc color:endMove {f clr y} { 385 color:Move $f $clr $y 386 color:drawscale red 387 color:drawscale green 388 color:drawscale blue 389} 390 391proc color:allcolors {{w .allcolor}} { 392 catch {destroy $w} 393 toplevel $w 394 wm title $w "All Colors" 395 396 set n 0 397 for {set j 0} {$j < 11} {incr j} { 398 set f [frame $w.y$j] 399 pack $f -side top -fill x 400 for {set i 0} {$i < 12} {incr i} { 401 set clr [color_value [color_generate $n]] 402 button $f.b$i -bg $clr -activebackground $clr 403 pack $f.b$i -side left 404 incr n 405 } 406 } 407} 408 409 410