[37] | 1 | # clrpick.tcl -- |
---|
| 2 | # |
---|
| 3 | # Color selection dialog for platforms that do not support a |
---|
| 4 | # standard color selection dialog. |
---|
| 5 | # |
---|
| 6 | # RCS: @(#) $Id: clrpick.tcl,v 1.10 2000/04/04 08:09:24 hobbs Exp $ |
---|
| 7 | # |
---|
| 8 | # Copyright (c) 1996 Sun Microsystems, Inc. |
---|
| 9 | # |
---|
| 10 | # See the file "license.terms" for information on usage and redistribution |
---|
| 11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 12 | # |
---|
| 13 | # ToDo: |
---|
| 14 | # |
---|
| 15 | # (1): Find out how many free colors are left in the colormap and |
---|
| 16 | # don't allocate too many colors. |
---|
| 17 | # (2): Implement HSV color selection. |
---|
| 18 | # |
---|
| 19 | |
---|
| 20 | # tkColorDialog -- |
---|
| 21 | # |
---|
| 22 | # Create a color dialog and let the user choose a color. This function |
---|
| 23 | # should not be called directly. It is called by the tk_chooseColor |
---|
| 24 | # function when a native color selector widget does not exist |
---|
| 25 | # |
---|
| 26 | proc tkColorDialog {args} { |
---|
| 27 | global tkPriv |
---|
| 28 | set w .__tk__color |
---|
| 29 | upvar #0 $w data |
---|
| 30 | |
---|
| 31 | # The lines variables track the start and end indices of the line |
---|
| 32 | # elements in the colorbar canvases. |
---|
| 33 | set data(lines,red,start) 0 |
---|
| 34 | set data(lines,red,last) -1 |
---|
| 35 | set data(lines,green,start) 0 |
---|
| 36 | set data(lines,green,last) -1 |
---|
| 37 | set data(lines,blue,start) 0 |
---|
| 38 | set data(lines,blue,last) -1 |
---|
| 39 | |
---|
| 40 | # This is the actual number of lines that are drawn in each color strip. |
---|
| 41 | # Note that the bars may be of any width. |
---|
| 42 | # However, NUM_COLORBARS must be a number that evenly divides 256. |
---|
| 43 | # Such as 256, 128, 64, etc. |
---|
| 44 | set data(NUM_COLORBARS) 8 |
---|
| 45 | |
---|
| 46 | # BARS_WIDTH is the number of pixels wide the color bar portion of the |
---|
| 47 | # canvas is. This number must be a multiple of NUM_COLORBARS |
---|
| 48 | set data(BARS_WIDTH) 128 |
---|
| 49 | |
---|
| 50 | # PLGN_WIDTH is the number of pixels wide of the triangular selection |
---|
| 51 | # polygon. This also results in the definition of the padding on the |
---|
| 52 | # left and right sides which is half of PLGN_WIDTH. Make this number even. |
---|
| 53 | set data(PLGN_HEIGHT) 10 |
---|
| 54 | |
---|
| 55 | # PLGN_HEIGHT is the height of the selection polygon and the height of the |
---|
| 56 | # selection rectangle at the bottom of the color bar. No restrictions. |
---|
| 57 | set data(PLGN_WIDTH) 10 |
---|
| 58 | |
---|
| 59 | tkColorDialog_Config $w $args |
---|
| 60 | tkColorDialog_InitValues $w |
---|
| 61 | |
---|
| 62 | set sc [winfo screen $data(-parent)] |
---|
| 63 | set winExists [winfo exists $w] |
---|
| 64 | if {!$winExists || [string compare $sc [winfo screen $w]]} { |
---|
| 65 | if {$winExists} { |
---|
| 66 | destroy $w |
---|
| 67 | } |
---|
| 68 | toplevel $w -class tkColorDialog -screen $sc |
---|
| 69 | tkColorDialog_BuildDialog $w |
---|
| 70 | } |
---|
| 71 | |
---|
| 72 | wm transient $w $data(-parent) |
---|
| 73 | |
---|
| 74 | # 5. Withdraw the window, then update all the geometry information |
---|
| 75 | # so we know how big it wants to be, then center the window in the |
---|
| 76 | # display and de-iconify it. |
---|
| 77 | |
---|
| 78 | ::tk::PlaceWindow $w widget $data(-parent) |
---|
| 79 | wm title $w $data(-title) |
---|
| 80 | |
---|
| 81 | # 6. Set a grab and claim the focus too. |
---|
| 82 | |
---|
| 83 | ::tk::SetFocusGrab $w $data(okBtn) |
---|
| 84 | |
---|
| 85 | # 7. Wait for the user to respond, then restore the focus and |
---|
| 86 | # return the index of the selected button. Restore the focus |
---|
| 87 | # before deleting the window, since otherwise the window manager |
---|
| 88 | # may take the focus away so we can't redirect it. Finally, |
---|
| 89 | # restore any grab that was in effect. |
---|
| 90 | |
---|
| 91 | vwait tkPriv(selectColor) |
---|
| 92 | ::tk::RestoreFocusGrab $w $data(okBtn) |
---|
| 93 | unset data |
---|
| 94 | |
---|
| 95 | return $tkPriv(selectColor) |
---|
| 96 | } |
---|
| 97 | |
---|
| 98 | # tkColorDialog_InitValues -- |
---|
| 99 | # |
---|
| 100 | # Get called during initialization or when user resets NUM_COLORBARS |
---|
| 101 | # |
---|
| 102 | proc tkColorDialog_InitValues {w} { |
---|
| 103 | upvar #0 $w data |
---|
| 104 | |
---|
| 105 | # IntensityIncr is the difference in color intensity between a colorbar |
---|
| 106 | # and its neighbors. |
---|
| 107 | set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}] |
---|
| 108 | |
---|
| 109 | # ColorbarWidth is the width of each colorbar |
---|
| 110 | set data(colorbarWidth) \ |
---|
| 111 | [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}] |
---|
| 112 | |
---|
| 113 | # Indent is the width of the space at the left and right side of the |
---|
| 114 | # colorbar. It is always half the selector polygon width, because the |
---|
| 115 | # polygon extends into the space. |
---|
| 116 | set data(indent) [expr {$data(PLGN_WIDTH) / 2}] |
---|
| 117 | |
---|
| 118 | set data(colorPad) 2 |
---|
| 119 | set data(selPad) [expr {$data(PLGN_WIDTH) / 2}] |
---|
| 120 | |
---|
| 121 | # |
---|
| 122 | # minX is the x coordinate of the first colorbar |
---|
| 123 | # |
---|
| 124 | set data(minX) $data(indent) |
---|
| 125 | |
---|
| 126 | # |
---|
| 127 | # maxX is the x coordinate of the last colorbar |
---|
| 128 | # |
---|
| 129 | set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}] |
---|
| 130 | |
---|
| 131 | # |
---|
| 132 | # canvasWidth is the width of the entire canvas, including the indents |
---|
| 133 | # |
---|
| 134 | set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}] |
---|
| 135 | |
---|
| 136 | # Set the initial color, specified by -initialcolor, or the |
---|
| 137 | # color chosen by the user the last time. |
---|
| 138 | set data(selection) $data(-initialcolor) |
---|
| 139 | set data(finalColor) $data(-initialcolor) |
---|
| 140 | set rgb [winfo rgb . $data(selection)] |
---|
| 141 | |
---|
| 142 | set data(red,intensity) [expr {[lindex $rgb 0]/0x100}] |
---|
| 143 | set data(green,intensity) [expr {[lindex $rgb 1]/0x100}] |
---|
| 144 | set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}] |
---|
| 145 | } |
---|
| 146 | |
---|
| 147 | # tkColorDialog_Config -- |
---|
| 148 | # |
---|
| 149 | # Parses the command line arguments to tk_chooseColor |
---|
| 150 | # |
---|
| 151 | proc tkColorDialog_Config {w argList} { |
---|
| 152 | global tkPriv |
---|
| 153 | upvar #0 $w data |
---|
| 154 | |
---|
| 155 | # 1: the configuration specs |
---|
| 156 | # |
---|
| 157 | if {[info exists tkPriv(selectColor)] && \ |
---|
| 158 | [string compare $tkPriv(selectColor) ""]} { |
---|
| 159 | set defaultColor $tkPriv(selectColor) |
---|
| 160 | } else { |
---|
| 161 | set defaultColor [. cget -background] |
---|
| 162 | } |
---|
| 163 | |
---|
| 164 | set specs [list \ |
---|
| 165 | [list -initialcolor "" "" $defaultColor] \ |
---|
| 166 | [list -parent "" "" "."] \ |
---|
| 167 | [list -title "" "" "Color"] \ |
---|
| 168 | ] |
---|
| 169 | |
---|
| 170 | # 2: parse the arguments |
---|
| 171 | # |
---|
| 172 | tclParseConfigSpec $w $specs "" $argList |
---|
| 173 | |
---|
| 174 | if {[string equal $data(-title) ""]} { |
---|
| 175 | set data(-title) " " |
---|
| 176 | } |
---|
| 177 | if {[catch {winfo rgb . $data(-initialcolor)} err]} { |
---|
| 178 | error $err |
---|
| 179 | } |
---|
| 180 | |
---|
| 181 | if {![winfo exists $data(-parent)]} { |
---|
| 182 | error "bad window path name \"$data(-parent)\"" |
---|
| 183 | } |
---|
| 184 | } |
---|
| 185 | |
---|
| 186 | # tkColorDialog_BuildDialog -- |
---|
| 187 | # |
---|
| 188 | # Build the dialog. |
---|
| 189 | # |
---|
| 190 | proc tkColorDialog_BuildDialog {w} { |
---|
| 191 | upvar #0 $w data |
---|
| 192 | |
---|
| 193 | # TopFrame contains the color strips and the color selection |
---|
| 194 | # |
---|
| 195 | set topFrame [frame $w.top -relief raised -bd 1] |
---|
| 196 | |
---|
| 197 | # StripsFrame contains the colorstrips and the individual RGB entries |
---|
| 198 | set stripsFrame [frame $topFrame.colorStrip] |
---|
| 199 | |
---|
| 200 | foreach c { Red Green Blue } { |
---|
| 201 | set color [string tolower $c] |
---|
| 202 | |
---|
| 203 | # each f frame contains an [R|G|B] entry and the equiv. color strip. |
---|
| 204 | set f [frame $stripsFrame.$color] |
---|
| 205 | |
---|
| 206 | # The box frame contains the label and entry widget for an [R|G|B] |
---|
| 207 | set box [frame $f.box] |
---|
| 208 | |
---|
| 209 | label $box.label -text $c: -width 6 -under 0 -anchor ne |
---|
| 210 | entry $box.entry -textvariable [format %s $w]($color,intensity) \ |
---|
| 211 | -width 4 |
---|
| 212 | pack $box.label -side left -fill y -padx 2 -pady 3 |
---|
| 213 | pack $box.entry -side left -anchor n -pady 0 |
---|
| 214 | pack $box -side left -fill both |
---|
| 215 | |
---|
| 216 | set height [expr \ |
---|
| 217 | {[winfo reqheight $box.entry] - \ |
---|
| 218 | 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}] |
---|
| 219 | |
---|
| 220 | canvas $f.color -height $height\ |
---|
| 221 | -width $data(BARS_WIDTH) -relief sunken -bd 2 |
---|
| 222 | canvas $f.sel -height $data(PLGN_HEIGHT) \ |
---|
| 223 | -width $data(canvasWidth) -highlightthickness 0 |
---|
| 224 | pack $f.color -expand yes -fill both |
---|
| 225 | pack $f.sel -expand yes -fill both |
---|
| 226 | |
---|
| 227 | pack $f -side top -fill x -padx 0 -pady 2 |
---|
| 228 | |
---|
| 229 | set data($color,entry) $box.entry |
---|
| 230 | set data($color,col) $f.color |
---|
| 231 | set data($color,sel) $f.sel |
---|
| 232 | |
---|
| 233 | bind $data($color,col) <Configure> \ |
---|
| 234 | [list tkColorDialog_DrawColorScale $w $color 1] |
---|
| 235 | bind $data($color,col) <Enter> \ |
---|
| 236 | [list tkColorDialog_EnterColorBar $w $color] |
---|
| 237 | bind $data($color,col) <Leave> \ |
---|
| 238 | [list tkColorDialog_LeaveColorBar $w $color] |
---|
| 239 | |
---|
| 240 | bind $data($color,sel) <Enter> \ |
---|
| 241 | [list tkColorDialog_EnterColorBar $w $color] |
---|
| 242 | bind $data($color,sel) <Leave> \ |
---|
| 243 | [list tkColorDialog_LeaveColorBar $w $color] |
---|
| 244 | |
---|
| 245 | bind $box.entry <Return> [list tkColorDialog_HandleRGBEntry $w] |
---|
| 246 | } |
---|
| 247 | |
---|
| 248 | pack $stripsFrame -side left -fill both -padx 4 -pady 10 |
---|
| 249 | |
---|
| 250 | # The selFrame contains a frame that demonstrates the currently |
---|
| 251 | # selected color |
---|
| 252 | # |
---|
| 253 | set selFrame [frame $topFrame.sel] |
---|
| 254 | set lab [label $selFrame.lab -text "Selection:" -under 0 -anchor sw] |
---|
| 255 | set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \ |
---|
| 256 | -width 16] |
---|
| 257 | set f1 [frame $selFrame.f1 -relief sunken -bd 2] |
---|
| 258 | set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70] |
---|
| 259 | |
---|
| 260 | pack $lab $ent -side top -fill x -padx 4 -pady 2 |
---|
| 261 | pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10 |
---|
| 262 | pack $data(finalCanvas) -expand yes -fill both |
---|
| 263 | |
---|
| 264 | bind $ent <Return> [list tkColorDialog_HandleSelEntry $w] |
---|
| 265 | |
---|
| 266 | pack $selFrame -side left -fill none -anchor nw |
---|
| 267 | pack $topFrame -side top -expand yes -fill both -anchor nw |
---|
| 268 | |
---|
| 269 | # the botFrame frame contains the buttons |
---|
| 270 | # |
---|
| 271 | set botFrame [frame $w.bot -relief raised -bd 1] |
---|
| 272 | button $botFrame.ok -text OK -width 8 -under 0 \ |
---|
| 273 | -command [list tkColorDialog_OkCmd $w] |
---|
| 274 | button $botFrame.cancel -text Cancel -width 8 -under 0 \ |
---|
| 275 | -command [list tkColorDialog_CancelCmd $w] |
---|
| 276 | |
---|
| 277 | set data(okBtn) $botFrame.ok |
---|
| 278 | set data(cancelBtn) $botFrame.cancel |
---|
| 279 | |
---|
| 280 | pack $botFrame.ok $botFrame.cancel \ |
---|
| 281 | -padx 10 -pady 10 -expand yes -side left |
---|
| 282 | pack $botFrame -side bottom -fill x |
---|
| 283 | |
---|
| 284 | |
---|
| 285 | # Accelerator bindings |
---|
| 286 | |
---|
| 287 | bind $w <Alt-r> [list focus $data(red,entry)] |
---|
| 288 | bind $w <Alt-g> [list focus $data(green,entry)] |
---|
| 289 | bind $w <Alt-b> [list focus $data(blue,entry)] |
---|
| 290 | bind $w <Alt-s> [list focus $ent] |
---|
| 291 | bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)] |
---|
| 292 | bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)] |
---|
| 293 | bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)] |
---|
| 294 | |
---|
| 295 | wm protocol $w WM_DELETE_WINDOW [list tkColorDialog_CancelCmd $w] |
---|
| 296 | } |
---|
| 297 | |
---|
| 298 | # tkColorDialog_SetRGBValue -- |
---|
| 299 | # |
---|
| 300 | # Sets the current selection of the dialog box |
---|
| 301 | # |
---|
| 302 | proc tkColorDialog_SetRGBValue {w color} { |
---|
| 303 | upvar #0 $w data |
---|
| 304 | |
---|
| 305 | set data(red,intensity) [lindex $color 0] |
---|
| 306 | set data(green,intensity) [lindex $color 1] |
---|
| 307 | set data(blue,intensity) [lindex $color 2] |
---|
| 308 | |
---|
| 309 | tkColorDialog_RedrawColorBars $w all |
---|
| 310 | |
---|
| 311 | # Now compute the new x value of each colorbars pointer polygon |
---|
| 312 | foreach color { red green blue } { |
---|
| 313 | set x [tkColorDialog_RgbToX $w $data($color,intensity)] |
---|
| 314 | tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0 |
---|
| 315 | } |
---|
| 316 | } |
---|
| 317 | |
---|
| 318 | # tkColorDialog_XToRgb -- |
---|
| 319 | # |
---|
| 320 | # Converts a screen coordinate to intensity |
---|
| 321 | # |
---|
| 322 | proc tkColorDialog_XToRgb {w x} { |
---|
| 323 | upvar #0 $w data |
---|
| 324 | |
---|
| 325 | return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}] |
---|
| 326 | } |
---|
| 327 | |
---|
| 328 | # tkColorDialog_RgbToX |
---|
| 329 | # |
---|
| 330 | # Converts an intensity to screen coordinate. |
---|
| 331 | # |
---|
| 332 | proc tkColorDialog_RgbToX {w color} { |
---|
| 333 | upvar #0 $w data |
---|
| 334 | |
---|
| 335 | return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}] |
---|
| 336 | } |
---|
| 337 | |
---|
| 338 | |
---|
| 339 | # tkColorDialog_DrawColorScale -- |
---|
| 340 | # |
---|
| 341 | # Draw color scale is called whenever the size of one of the color |
---|
| 342 | # scale canvases is changed. |
---|
| 343 | # |
---|
| 344 | proc tkColorDialog_DrawColorScale {w c {create 0}} { |
---|
| 345 | global lines |
---|
| 346 | upvar #0 $w data |
---|
| 347 | |
---|
| 348 | # col: color bar canvas |
---|
| 349 | # sel: selector canvas |
---|
| 350 | set col $data($c,col) |
---|
| 351 | set sel $data($c,sel) |
---|
| 352 | |
---|
| 353 | # First handle the case that we are creating everything for the first time. |
---|
| 354 | if {$create} { |
---|
| 355 | # First remove all the lines that already exist. |
---|
| 356 | if { $data(lines,$c,last) > $data(lines,$c,start)} { |
---|
| 357 | for {set i $data(lines,$c,start)} \ |
---|
| 358 | {$i <= $data(lines,$c,last)} { incr i} { |
---|
| 359 | $sel delete $i |
---|
| 360 | } |
---|
| 361 | } |
---|
| 362 | # Delete the selector if it exists |
---|
| 363 | if {[info exists data($c,index)]} { |
---|
| 364 | $sel delete $data($c,index) |
---|
| 365 | } |
---|
| 366 | |
---|
| 367 | # Draw the selection polygons |
---|
| 368 | tkColorDialog_CreateSelector $w $sel $c |
---|
| 369 | $sel bind $data($c,index) <ButtonPress-1> \ |
---|
| 370 | [list tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1] |
---|
| 371 | $sel bind $data($c,index) <B1-Motion> \ |
---|
| 372 | [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)] |
---|
| 373 | $sel bind $data($c,index) <ButtonRelease-1> \ |
---|
| 374 | [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)] |
---|
| 375 | |
---|
| 376 | set height [winfo height $col] |
---|
| 377 | # Create an invisible region under the colorstrip to catch mouse clicks |
---|
| 378 | # that aren't on the selector. |
---|
| 379 | set data($c,clickRegion) [$sel create rectangle 0 0 \ |
---|
| 380 | $data(canvasWidth) $height -fill {} -outline {}] |
---|
| 381 | |
---|
| 382 | bind $col <ButtonPress-1> \ |
---|
| 383 | [list tkColorDialog_StartMove $w $sel $c %x $data(colorPad)] |
---|
| 384 | bind $col <B1-Motion> \ |
---|
| 385 | [list tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)] |
---|
| 386 | bind $col <ButtonRelease-1> \ |
---|
| 387 | [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)] |
---|
| 388 | |
---|
| 389 | $sel bind $data($c,clickRegion) <ButtonPress-1> \ |
---|
| 390 | [list tkColorDialog_StartMove $w $sel $c %x $data(selPad)] |
---|
| 391 | $sel bind $data($c,clickRegion) <B1-Motion> \ |
---|
| 392 | [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)] |
---|
| 393 | $sel bind $data($c,clickRegion) <ButtonRelease-1> \ |
---|
| 394 | [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)] |
---|
| 395 | } else { |
---|
| 396 | # l is the canvas index of the first colorbar. |
---|
| 397 | set l $data(lines,$c,start) |
---|
| 398 | } |
---|
| 399 | |
---|
| 400 | # Draw the color bars. |
---|
| 401 | set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}] |
---|
| 402 | for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} { |
---|
| 403 | set intensity [expr {$i * $data(intensityIncr)}] |
---|
| 404 | set startx [expr {$i * $data(colorbarWidth) + $highlightW}] |
---|
| 405 | if {[string equal $c "red"]} { |
---|
| 406 | set color [format "#%02x%02x%02x" \ |
---|
| 407 | $intensity \ |
---|
| 408 | $data(green,intensity) \ |
---|
| 409 | $data(blue,intensity)] |
---|
| 410 | } elseif {[string equal $c "green"]} { |
---|
| 411 | set color [format "#%02x%02x%02x" \ |
---|
| 412 | $data(red,intensity) \ |
---|
| 413 | $intensity \ |
---|
| 414 | $data(blue,intensity)] |
---|
| 415 | } else { |
---|
| 416 | set color [format "#%02x%02x%02x" \ |
---|
| 417 | $data(red,intensity) \ |
---|
| 418 | $data(green,intensity) \ |
---|
| 419 | $intensity] |
---|
| 420 | } |
---|
| 421 | |
---|
| 422 | if {$create} { |
---|
| 423 | set index [$col create rect $startx $highlightW \ |
---|
| 424 | [expr {$startx +$data(colorbarWidth)}] \ |
---|
| 425 | [expr {[winfo height $col] + $highlightW}]\ |
---|
| 426 | -fill $color -outline $color] |
---|
| 427 | } else { |
---|
| 428 | $col itemconfigure $l -fill $color -outline $color |
---|
| 429 | incr l |
---|
| 430 | } |
---|
| 431 | } |
---|
| 432 | $sel raise $data($c,index) |
---|
| 433 | |
---|
| 434 | if {$create} { |
---|
| 435 | set data(lines,$c,last) $index |
---|
| 436 | set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}] |
---|
| 437 | } |
---|
| 438 | |
---|
| 439 | tkColorDialog_RedrawFinalColor $w |
---|
| 440 | } |
---|
| 441 | |
---|
| 442 | # tkColorDialog_CreateSelector -- |
---|
| 443 | # |
---|
| 444 | # Creates and draws the selector polygon at the position |
---|
| 445 | # $data($c,intensity). |
---|
| 446 | # |
---|
| 447 | proc tkColorDialog_CreateSelector {w sel c } { |
---|
| 448 | upvar #0 $w data |
---|
| 449 | set data($c,index) [$sel create polygon \ |
---|
| 450 | 0 $data(PLGN_HEIGHT) \ |
---|
| 451 | $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \ |
---|
| 452 | $data(indent) 0] |
---|
| 453 | set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)] |
---|
| 454 | $sel move $data($c,index) $data($c,x) 0 |
---|
| 455 | } |
---|
| 456 | |
---|
| 457 | # tkColorDialog_RedrawFinalColor |
---|
| 458 | # |
---|
| 459 | # Combines the intensities of the three colors into the final color |
---|
| 460 | # |
---|
| 461 | proc tkColorDialog_RedrawFinalColor {w} { |
---|
| 462 | upvar #0 $w data |
---|
| 463 | |
---|
| 464 | set color [format "#%02x%02x%02x" $data(red,intensity) \ |
---|
| 465 | $data(green,intensity) $data(blue,intensity)] |
---|
| 466 | |
---|
| 467 | $data(finalCanvas) configure -bg $color |
---|
| 468 | set data(finalColor) $color |
---|
| 469 | set data(selection) $color |
---|
| 470 | set data(finalRGB) [list \ |
---|
| 471 | $data(red,intensity) \ |
---|
| 472 | $data(green,intensity) \ |
---|
| 473 | $data(blue,intensity)] |
---|
| 474 | } |
---|
| 475 | |
---|
| 476 | # tkColorDialog_RedrawColorBars -- |
---|
| 477 | # |
---|
| 478 | # Only redraws the colors on the color strips that were not manipulated. |
---|
| 479 | # Params: color of colorstrip that changed. If color is not [red|green|blue] |
---|
| 480 | # Then all colorstrips will be updated |
---|
| 481 | # |
---|
| 482 | proc tkColorDialog_RedrawColorBars {w colorChanged} { |
---|
| 483 | upvar #0 $w data |
---|
| 484 | |
---|
| 485 | switch $colorChanged { |
---|
| 486 | red { |
---|
| 487 | tkColorDialog_DrawColorScale $w green |
---|
| 488 | tkColorDialog_DrawColorScale $w blue |
---|
| 489 | } |
---|
| 490 | green { |
---|
| 491 | tkColorDialog_DrawColorScale $w red |
---|
| 492 | tkColorDialog_DrawColorScale $w blue |
---|
| 493 | } |
---|
| 494 | blue { |
---|
| 495 | tkColorDialog_DrawColorScale $w red |
---|
| 496 | tkColorDialog_DrawColorScale $w green |
---|
| 497 | } |
---|
| 498 | default { |
---|
| 499 | tkColorDialog_DrawColorScale $w red |
---|
| 500 | tkColorDialog_DrawColorScale $w green |
---|
| 501 | tkColorDialog_DrawColorScale $w blue |
---|
| 502 | } |
---|
| 503 | } |
---|
| 504 | tkColorDialog_RedrawFinalColor $w |
---|
| 505 | } |
---|
| 506 | |
---|
| 507 | #---------------------------------------------------------------------- |
---|
| 508 | # Event handlers |
---|
| 509 | #---------------------------------------------------------------------- |
---|
| 510 | |
---|
| 511 | # tkColorDialog_StartMove -- |
---|
| 512 | # |
---|
| 513 | # Handles a mousedown button event over the selector polygon. |
---|
| 514 | # Adds the bindings for moving the mouse while the button is |
---|
| 515 | # pressed. Sets the binding for the button-release event. |
---|
| 516 | # |
---|
| 517 | # Params: sel is the selector canvas window, color is the color of the strip. |
---|
| 518 | # |
---|
| 519 | proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} { |
---|
| 520 | upvar #0 $w data |
---|
| 521 | |
---|
| 522 | if {!$dontMove} { |
---|
| 523 | tkColorDialog_MoveSelector $w $sel $color $x $delta |
---|
| 524 | } |
---|
| 525 | } |
---|
| 526 | |
---|
| 527 | # tkColorDialog_MoveSelector -- |
---|
| 528 | # |
---|
| 529 | # Moves the polygon selector so that its middle point has the same |
---|
| 530 | # x value as the specified x. If x is outside the bounds [0,255], |
---|
| 531 | # the selector is set to the closest endpoint. |
---|
| 532 | # |
---|
| 533 | # Params: sel is the selector canvas, c is [red|green|blue] |
---|
| 534 | # x is a x-coordinate. |
---|
| 535 | # |
---|
| 536 | proc tkColorDialog_MoveSelector {w sel color x delta} { |
---|
| 537 | upvar #0 $w data |
---|
| 538 | |
---|
| 539 | incr x -$delta |
---|
| 540 | |
---|
| 541 | if { $x < 0 } { |
---|
| 542 | set x 0 |
---|
| 543 | } elseif { $x >= $data(BARS_WIDTH)} { |
---|
| 544 | set x [expr {$data(BARS_WIDTH) - 1}] |
---|
| 545 | } |
---|
| 546 | set diff [expr {$x - $data($color,x)}] |
---|
| 547 | $sel move $data($color,index) $diff 0 |
---|
| 548 | set data($color,x) [expr {$data($color,x) + $diff}] |
---|
| 549 | |
---|
| 550 | # Return the x value that it was actually set at |
---|
| 551 | return $x |
---|
| 552 | } |
---|
| 553 | |
---|
| 554 | # tkColorDialog_ReleaseMouse |
---|
| 555 | # |
---|
| 556 | # Removes mouse tracking bindings, updates the colorbars. |
---|
| 557 | # |
---|
| 558 | # Params: sel is the selector canvas, color is the color of the strip, |
---|
| 559 | # x is the x-coord of the mouse. |
---|
| 560 | # |
---|
| 561 | proc tkColorDialog_ReleaseMouse {w sel color x delta} { |
---|
| 562 | upvar #0 $w data |
---|
| 563 | |
---|
| 564 | set x [tkColorDialog_MoveSelector $w $sel $color $x $delta] |
---|
| 565 | |
---|
| 566 | # Determine exactly what color we are looking at. |
---|
| 567 | set data($color,intensity) [tkColorDialog_XToRgb $w $x] |
---|
| 568 | |
---|
| 569 | tkColorDialog_RedrawColorBars $w $color |
---|
| 570 | } |
---|
| 571 | |
---|
| 572 | # tkColorDialog_ResizeColorbars -- |
---|
| 573 | # |
---|
| 574 | # Completely redraws the colorbars, including resizing the |
---|
| 575 | # colorstrips |
---|
| 576 | # |
---|
| 577 | proc tkColorDialog_ResizeColorBars {w} { |
---|
| 578 | upvar #0 $w data |
---|
| 579 | |
---|
| 580 | if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || |
---|
| 581 | (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} { |
---|
| 582 | set data(BARS_WIDTH) $data(NUM_COLORBARS) |
---|
| 583 | } |
---|
| 584 | tkColorDialog_InitValues $w |
---|
| 585 | foreach color { red green blue } { |
---|
| 586 | $data($color,col) configure -width $data(canvasWidth) |
---|
| 587 | tkColorDialog_DrawColorScale $w $color 1 |
---|
| 588 | } |
---|
| 589 | } |
---|
| 590 | |
---|
| 591 | # tkColorDialog_HandleSelEntry -- |
---|
| 592 | # |
---|
| 593 | # Handles the return keypress event in the "Selection:" entry |
---|
| 594 | # |
---|
| 595 | proc tkColorDialog_HandleSelEntry {w} { |
---|
| 596 | upvar #0 $w data |
---|
| 597 | |
---|
| 598 | set text [string trim $data(selection)] |
---|
| 599 | # Check to make sure that the color is valid |
---|
| 600 | if {[catch {set color [winfo rgb . $text]} ]} { |
---|
| 601 | set data(selection) $data(finalColor) |
---|
| 602 | return |
---|
| 603 | } |
---|
| 604 | |
---|
| 605 | set R [expr {[lindex $color 0]/0x100}] |
---|
| 606 | set G [expr {[lindex $color 1]/0x100}] |
---|
| 607 | set B [expr {[lindex $color 2]/0x100}] |
---|
| 608 | |
---|
| 609 | tkColorDialog_SetRGBValue $w "$R $G $B" |
---|
| 610 | set data(selection) $text |
---|
| 611 | } |
---|
| 612 | |
---|
| 613 | # tkColorDialog_HandleRGBEntry -- |
---|
| 614 | # |
---|
| 615 | # Handles the return keypress event in the R, G or B entry |
---|
| 616 | # |
---|
| 617 | proc tkColorDialog_HandleRGBEntry {w} { |
---|
| 618 | upvar #0 $w data |
---|
| 619 | |
---|
| 620 | foreach c {red green blue} { |
---|
| 621 | if {[catch { |
---|
| 622 | set data($c,intensity) [expr {int($data($c,intensity))}] |
---|
| 623 | }]} { |
---|
| 624 | set data($c,intensity) 0 |
---|
| 625 | } |
---|
| 626 | |
---|
| 627 | if {$data($c,intensity) < 0} { |
---|
| 628 | set data($c,intensity) 0 |
---|
| 629 | } |
---|
| 630 | if {$data($c,intensity) > 255} { |
---|
| 631 | set data($c,intensity) 255 |
---|
| 632 | } |
---|
| 633 | } |
---|
| 634 | |
---|
| 635 | tkColorDialog_SetRGBValue $w "$data(red,intensity) $data(green,intensity) \ |
---|
| 636 | $data(blue,intensity)" |
---|
| 637 | } |
---|
| 638 | |
---|
| 639 | # mouse cursor enters a color bar |
---|
| 640 | # |
---|
| 641 | proc tkColorDialog_EnterColorBar {w color} { |
---|
| 642 | upvar #0 $w data |
---|
| 643 | |
---|
| 644 | $data($color,sel) itemconfig $data($color,index) -fill red |
---|
| 645 | } |
---|
| 646 | |
---|
| 647 | # mouse leaves enters a color bar |
---|
| 648 | # |
---|
| 649 | proc tkColorDialog_LeaveColorBar {w color} { |
---|
| 650 | upvar #0 $w data |
---|
| 651 | |
---|
| 652 | $data($color,sel) itemconfig $data($color,index) -fill black |
---|
| 653 | } |
---|
| 654 | |
---|
| 655 | # user hits OK button |
---|
| 656 | # |
---|
| 657 | proc tkColorDialog_OkCmd {w} { |
---|
| 658 | global tkPriv |
---|
| 659 | upvar #0 $w data |
---|
| 660 | |
---|
| 661 | set tkPriv(selectColor) $data(finalColor) |
---|
| 662 | } |
---|
| 663 | |
---|
| 664 | # user hits Cancel button |
---|
| 665 | # |
---|
| 666 | proc tkColorDialog_CancelCmd {w} { |
---|
| 667 | global tkPriv |
---|
| 668 | |
---|
| 669 | set tkPriv(selectColor) "" |
---|
| 670 | } |
---|
| 671 | |
---|