figenc

[RADIOACTIVE] rsa and symmetric key encryption scripts and executables
git clone git://git.figbert.com/figenc.git
Log | Files | Refs | README

clrpick.tcl (21432B)


      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 (Motif style) 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 	return -code error -errorcode [list TK LOOKUP COLOR $data(-initialcolor)] \
    194 	    $err
    195     }
    196 
    197     if {![winfo exists $data(-parent)]} {
    198 	return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
    199 	    "bad window path name \"$data(-parent)\""
    200     }
    201 }
    202 
    203 # ::tk::dialog::color::BuildDialog --
    204 #
    205 #	Build the dialog.
    206 #
    207 proc ::tk::dialog::color::BuildDialog {w} {
    208     upvar ::tk::dialog::color::[winfo name $w] data
    209 
    210     # TopFrame contains the color strips and the color selection
    211     #
    212     set topFrame [frame $w.top -relief raised -bd 1]
    213 
    214     # StripsFrame contains the colorstrips and the individual RGB entries
    215     set stripsFrame [frame $topFrame.colorStrip]
    216 
    217     set maxWidth [::tk::mcmaxamp &Red &Green &Blue]
    218     set maxWidth [expr {$maxWidth<6 ? 6 : $maxWidth}]
    219     set colorList {
    220 	red   "&Red"
    221 	green "&Green"
    222 	blue  "&Blue"
    223     }
    224     foreach {color l} $colorList {
    225 	# each f frame contains an [R|G|B] entry and the equiv. color strip.
    226 	set f [frame $stripsFrame.$color]
    227 
    228 	# The box frame contains the label and entry widget for an [R|G|B]
    229 	set box [frame $f.box]
    230 
    231 	::tk::AmpWidget label $box.label -text "[mc $l]:" \
    232 		-width $maxWidth -anchor ne
    233 	bind $box.label <<AltUnderlined>> [list focus $box.entry]
    234 
    235 	entry $box.entry -textvariable \
    236 		::tk::dialog::color::[winfo name $w]($color,intensity) \
    237 		-width 4
    238 	pack $box.label -side left -fill y -padx 2 -pady 3
    239 	pack $box.entry -side left -anchor n -pady 0
    240 	pack $box -side left -fill both
    241 
    242 	set height [expr {
    243 	    [winfo reqheight $box.entry] -
    244 	    2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])
    245 	}]
    246 
    247 	canvas $f.color -height $height \
    248 		-width $data(BARS_WIDTH) -relief sunken -bd 2
    249 	canvas $f.sel -height $data(PLGN_HEIGHT) \
    250 		-width $data(canvasWidth) -highlightthickness 0
    251 	pack $f.color -expand yes -fill both
    252 	pack $f.sel -expand yes -fill both
    253 
    254 	pack $f -side top -fill x -padx 0 -pady 2
    255 
    256 	set data($color,entry) $box.entry
    257 	set data($color,col) $f.color
    258 	set data($color,sel) $f.sel
    259 
    260 	bind $data($color,col) <Configure> \
    261 		[list tk::dialog::color::DrawColorScale $w $color 1]
    262 	bind $data($color,col) <Enter> \
    263 		[list tk::dialog::color::EnterColorBar $w $color]
    264 	bind $data($color,col) <Leave> \
    265 		[list tk::dialog::color::LeaveColorBar $w $color]
    266 
    267 	bind $data($color,sel) <Enter> \
    268 		[list tk::dialog::color::EnterColorBar $w $color]
    269 	bind $data($color,sel) <Leave> \
    270 		[list tk::dialog::color::LeaveColorBar $w $color]
    271 
    272 	bind $box.entry <Return> [list tk::dialog::color::HandleRGBEntry $w]
    273     }
    274 
    275     pack $stripsFrame -side left -fill both -padx 4 -pady 10
    276 
    277     # The selFrame contains a frame that demonstrates the currently
    278     # selected color
    279     #
    280     set selFrame [frame $topFrame.sel]
    281     set lab [::tk::AmpWidget label $selFrame.lab \
    282 	    -text [mc "&Selection:"] -anchor sw]
    283     set ent [entry $selFrame.ent \
    284 	    -textvariable ::tk::dialog::color::[winfo name $w](selection) \
    285 	    -width 16]
    286     set f1  [frame $selFrame.f1 -relief sunken -bd 2]
    287     set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
    288 
    289     pack $lab $ent -side top -fill x -padx 4 -pady 2
    290     pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
    291     pack $data(finalCanvas) -expand yes -fill both
    292 
    293     bind $ent <Return> [list tk::dialog::color::HandleSelEntry $w]
    294 
    295     pack $selFrame -side left -fill none -anchor nw
    296     pack $topFrame -side top -expand yes -fill both -anchor nw
    297 
    298     # the botFrame frame contains the buttons
    299     #
    300     set botFrame [frame $w.bot -relief raised -bd 1]
    301 
    302     ::tk::AmpWidget button $botFrame.ok     -text [mc "&OK"]		\
    303 	    -command [list tk::dialog::color::OkCmd $w]
    304     ::tk::AmpWidget button $botFrame.cancel -text [mc "&Cancel"]	\
    305 	    -command [list tk::dialog::color::CancelCmd $w]
    306 
    307     set data(okBtn)      $botFrame.ok
    308     set data(cancelBtn)  $botFrame.cancel
    309 
    310     grid x $botFrame.ok x $botFrame.cancel x -sticky ew
    311     grid configure $botFrame.ok $botFrame.cancel -padx 10 -pady 10
    312     grid columnconfigure $botFrame {0 4} -weight 1 -uniform space
    313     grid columnconfigure $botFrame {1 3} -weight 1 -uniform button
    314     grid columnconfigure $botFrame 2 -weight 2 -uniform space
    315     pack $botFrame -side bottom -fill x
    316 
    317     # Accelerator bindings
    318     bind $lab <<AltUnderlined>> [list focus $ent]
    319     bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
    320     bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
    321 
    322     wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w]
    323     bind $lab <Destroy> [list tk::dialog::color::CancelCmd $w]
    324 }
    325 
    326 # ::tk::dialog::color::SetRGBValue --
    327 #
    328 #	Sets the current selection of the dialog box
    329 #
    330 proc ::tk::dialog::color::SetRGBValue {w color} {
    331     upvar ::tk::dialog::color::[winfo name $w] data
    332 
    333     set data(red,intensity)   [lindex $color 0]
    334     set data(green,intensity) [lindex $color 1]
    335     set data(blue,intensity)  [lindex $color 2]
    336 
    337     RedrawColorBars $w all
    338 
    339     # Now compute the new x value of each colorbars pointer polygon
    340     foreach color {red green blue} {
    341 	set x [RgbToX $w $data($color,intensity)]
    342 	MoveSelector $w $data($color,sel) $color $x 0
    343     }
    344 }
    345 
    346 # ::tk::dialog::color::XToRgb --
    347 #
    348 #	Converts a screen coordinate to intensity
    349 #
    350 proc ::tk::dialog::color::XToRgb {w x} {
    351     upvar ::tk::dialog::color::[winfo name $w] data
    352 
    353     set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
    354     if {$x > 255} {
    355 	set x 255
    356     }
    357     return $x
    358 }
    359 
    360 # ::tk::dialog::color::RgbToX
    361 #
    362 #	Converts an intensity to screen coordinate.
    363 #
    364 proc ::tk::dialog::color::RgbToX {w color} {
    365     upvar ::tk::dialog::color::[winfo name $w] data
    366 
    367     return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
    368 }
    369 
    370 # ::tk::dialog::color::DrawColorScale --
    371 #
    372 #	Draw color scale is called whenever the size of one of the color
    373 #	scale canvases is changed.
    374 #
    375 proc ::tk::dialog::color::DrawColorScale {w c {create 0}} {
    376     upvar ::tk::dialog::color::[winfo name $w] data
    377 
    378     # col: color bar canvas
    379     # sel: selector canvas
    380     set col $data($c,col)
    381     set sel $data($c,sel)
    382 
    383     # First handle the case that we are creating everything for the first time.
    384     if {$create} {
    385 	# First remove all the lines that already exist.
    386 	if { $data(lines,$c,last) > $data(lines,$c,start)} {
    387 	    for {set i $data(lines,$c,start)} \
    388 		    {$i <= $data(lines,$c,last)} {incr i} {
    389 		$sel delete $i
    390 	    }
    391 	}
    392 	# Delete the selector if it exists
    393 	if {[info exists data($c,index)]} {
    394 	    $sel delete $data($c,index)
    395 	}
    396 
    397 	# Draw the selection polygons
    398 	CreateSelector $w $sel $c
    399 	$sel bind $data($c,index) <ButtonPress-1> \
    400 		[list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1]
    401 	$sel bind $data($c,index) <B1-Motion> \
    402 		[list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
    403 	$sel bind $data($c,index) <ButtonRelease-1> \
    404 		[list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]
    405 
    406 	set height [winfo height $col]
    407 	# Create an invisible region under the colorstrip to catch mouse clicks
    408 	# that aren't on the selector.
    409 	set data($c,clickRegion) [$sel create rectangle 0 0 \
    410 		$data(canvasWidth) $height -fill {} -outline {}]
    411 
    412 	bind $col <ButtonPress-1> \
    413 		[list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)]
    414 	bind $col <B1-Motion> \
    415 		[list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)]
    416 	bind $col <ButtonRelease-1> \
    417 		[list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)]
    418 
    419 	$sel bind $data($c,clickRegion) <ButtonPress-1> \
    420 		[list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)]
    421 	$sel bind $data($c,clickRegion) <B1-Motion> \
    422 		[list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
    423 	$sel bind $data($c,clickRegion) <ButtonRelease-1> \
    424 		[list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]
    425     } else {
    426 	# l is the canvas index of the first colorbar.
    427 	set l $data(lines,$c,start)
    428     }
    429 
    430     # Draw the color bars.
    431     set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]
    432     for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
    433 	set intensity [expr {$i * $data(intensityIncr)}]
    434 	set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
    435 	if {$c eq "red"} {
    436 	    set color [format "#%02x%02x%02x" \
    437 		    $intensity $data(green,intensity) $data(blue,intensity)]
    438 	} elseif {$c eq "green"} {
    439 	    set color [format "#%02x%02x%02x" \
    440 		    $data(red,intensity) $intensity $data(blue,intensity)]
    441 	} else {
    442 	    set color [format "#%02x%02x%02x" \
    443 		    $data(red,intensity) $data(green,intensity) $intensity]
    444 	}
    445 
    446 	if {$create} {
    447 	    set index [$col create rect $startx $highlightW \
    448 		    [expr {$startx +$data(colorbarWidth)}] \
    449 		    [expr {[winfo height $col] + $highlightW}] \
    450 		    -fill $color -outline $color]
    451 	} else {
    452 	    $col itemconfigure $l -fill $color -outline $color
    453 	    incr l
    454 	}
    455     }
    456     $sel raise $data($c,index)
    457 
    458     if {$create} {
    459 	set data(lines,$c,last) $index
    460 	set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
    461     }
    462 
    463     RedrawFinalColor $w
    464 }
    465 
    466 # ::tk::dialog::color::CreateSelector --
    467 #
    468 #	Creates and draws the selector polygon at the position
    469 #	$data($c,intensity).
    470 #
    471 proc ::tk::dialog::color::CreateSelector {w sel c } {
    472     upvar ::tk::dialog::color::[winfo name $w] data
    473     set data($c,index) [$sel create polygon \
    474 	    0 $data(PLGN_HEIGHT) \
    475 	    $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
    476 	    $data(indent) 0]
    477     set data($c,x) [RgbToX $w $data($c,intensity)]
    478     $sel move $data($c,index) $data($c,x) 0
    479 }
    480 
    481 # ::tk::dialog::color::RedrawFinalColor
    482 #
    483 #	Combines the intensities of the three colors into the final color
    484 #
    485 proc ::tk::dialog::color::RedrawFinalColor {w} {
    486     upvar ::tk::dialog::color::[winfo name $w] data
    487 
    488     set color [format "#%02x%02x%02x" $data(red,intensity) \
    489 	    $data(green,intensity) $data(blue,intensity)]
    490 
    491     $data(finalCanvas) configure -bg $color
    492     set data(finalColor) $color
    493     set data(selection) $color
    494     set data(finalRGB) [list \
    495 	    $data(red,intensity) \
    496 	    $data(green,intensity) \
    497 	    $data(blue,intensity)]
    498 }
    499 
    500 # ::tk::dialog::color::RedrawColorBars --
    501 #
    502 # Only redraws the colors on the color strips that were not manipulated.
    503 # Params: color of colorstrip that changed. If color is not [red|green|blue]
    504 #         Then all colorstrips will be updated
    505 #
    506 proc ::tk::dialog::color::RedrawColorBars {w colorChanged} {
    507     upvar ::tk::dialog::color::[winfo name $w] data
    508 
    509     switch $colorChanged {
    510 	red {
    511 	    DrawColorScale $w green
    512 	    DrawColorScale $w blue
    513 	}
    514 	green {
    515 	    DrawColorScale $w red
    516 	    DrawColorScale $w blue
    517 	}
    518 	blue {
    519 	    DrawColorScale $w red
    520 	    DrawColorScale $w green
    521 	}
    522 	default {
    523 	    DrawColorScale $w red
    524 	    DrawColorScale $w green
    525 	    DrawColorScale $w blue
    526 	}
    527     }
    528     RedrawFinalColor $w
    529 }
    530 
    531 #----------------------------------------------------------------------
    532 #			Event handlers
    533 #----------------------------------------------------------------------
    534 
    535 # ::tk::dialog::color::StartMove --
    536 #
    537 #	Handles a mousedown button event over the selector polygon.
    538 #	Adds the bindings for moving the mouse while the button is
    539 #	pressed.  Sets the binding for the button-release event.
    540 #
    541 # Params: sel is the selector canvas window, color is the color of the strip.
    542 #
    543 proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} {
    544     upvar ::tk::dialog::color::[winfo name $w] data
    545 
    546     if {!$dontMove} {
    547 	MoveSelector $w $sel $color $x $delta
    548     }
    549 }
    550 
    551 # ::tk::dialog::color::MoveSelector --
    552 #
    553 # Moves the polygon selector so that its middle point has the same
    554 # x value as the specified x. If x is outside the bounds [0,255],
    555 # the selector is set to the closest endpoint.
    556 #
    557 # Params: sel is the selector canvas, c is [red|green|blue]
    558 #         x is a x-coordinate.
    559 #
    560 proc ::tk::dialog::color::MoveSelector {w sel color x delta} {
    561     upvar ::tk::dialog::color::[winfo name $w] data
    562 
    563     incr x -$delta
    564 
    565     if { $x < 0 } {
    566 	set x 0
    567     } elseif { $x > $data(BARS_WIDTH)} {
    568 	set x $data(BARS_WIDTH)
    569     }
    570     set diff [expr {$x - $data($color,x)}]
    571     $sel move $data($color,index) $diff 0
    572     set data($color,x) [expr {$data($color,x) + $diff}]
    573 
    574     # Return the x value that it was actually set at
    575     return $x
    576 }
    577 
    578 # ::tk::dialog::color::ReleaseMouse
    579 #
    580 # Removes mouse tracking bindings, updates the colorbars.
    581 #
    582 # Params: sel is the selector canvas, color is the color of the strip,
    583 #         x is the x-coord of the mouse.
    584 #
    585 proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} {
    586     upvar ::tk::dialog::color::[winfo name $w] data
    587 
    588     set x [MoveSelector $w $sel $color $x $delta]
    589 
    590     # Determine exactly what color we are looking at.
    591     set data($color,intensity) [XToRgb $w $x]
    592 
    593     RedrawColorBars $w $color
    594 }
    595 
    596 # ::tk::dialog::color::ResizeColorbars --
    597 #
    598 #	Completely redraws the colorbars, including resizing the
    599 #	colorstrips
    600 #
    601 proc ::tk::dialog::color::ResizeColorBars {w} {
    602     upvar ::tk::dialog::color::[winfo name $w] data
    603 
    604     if {
    605 	($data(BARS_WIDTH) < $data(NUM_COLORBARS)) ||
    606 	(($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)
    607     } then {
    608 	set data(BARS_WIDTH) $data(NUM_COLORBARS)
    609     }
    610     InitValues [winfo name $w]
    611     foreach color {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 {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 or destroys window
    691 #
    692 proc ::tk::dialog::color::CancelCmd {w} {
    693     variable ::tk::Priv
    694     set Priv(selectColor) ""
    695 }