lib/tk8.4/clrpick.tcl

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