mingw/lib/tk8.5/clrpick.tcl

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