home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tk8.4 / clrpick.tcl < prev    next >
Text File  |  2003-02-21  |  21KB  |  698 lines
  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 2003/02/21 14:40:26 dkf 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 || [string compare $sc [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)] && \
  175.         [string compare $Priv(selectColor) ""]} {
  176.     set defaultColor $Priv(selectColor)
  177.     } else {
  178.     set defaultColor [. cget -background]
  179.     }
  180.  
  181.     set specs [list \
  182.         [list -initialcolor "" "" $defaultColor] \
  183.         [list -parent "" "" "."] \
  184.         [list -title "" "" [mc "Color"]] \
  185.         ]
  186.  
  187.     # 2: parse the arguments
  188.     #
  189.     tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList
  190.  
  191.     if {[string equal $data(-title) ""]} {
  192.     set data(-title) " "
  193.     }
  194.     if {[catch {winfo rgb . $data(-initialcolor)} err]} {
  195.     error $err
  196.     }
  197.  
  198.     if {![winfo exists $data(-parent)]} {
  199.     error "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 [list \
  220.         red        [mc "&Red"]    \
  221.         green    [mc "&Green"]    \
  222.         blue    [mc "&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.     bind [::tk::AmpWidget label $box.label -text $l: -width $maxWidth \
  232.         -anchor ne] <<AltUnderlined>> [list focus $box.entry]
  233.     
  234.     entry $box.entry -textvariable \
  235.         ::tk::dialog::color::[winfo name $w]($color,intensity) \
  236.         -width 4
  237.     pack $box.label -side left -fill y -padx 2 -pady 3
  238.     pack $box.entry -side left -anchor n -pady 0
  239.     pack $box -side left -fill both
  240.  
  241.     set height [expr \
  242.         {[winfo reqheight $box.entry] - \
  243.         2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]
  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 -text [mc "&Selection:"] \
  280.         -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.  
  316.     # Accelerator bindings
  317.     bind $lab <<AltUnderlined>> [list focus $ent]
  318.     bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
  319.     bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
  320.  
  321.     wm protocol $w WM_DELETE_WINDOW [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 [list 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} { set x 255 }
  353.     return $x
  354. }
  355.  
  356. # ::tk::dialog::color::RgbToX
  357. #
  358. #    Converts an intensity to screen coordinate.
  359. #
  360. proc ::tk::dialog::color::RgbToX {w color} {
  361.     upvar ::tk::dialog::color::[winfo name $w] data
  362.     
  363.     return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
  364. }
  365.  
  366.  
  367. # ::tk::dialog::color::DrawColorScale --
  368. # 
  369. #    Draw color scale is called whenever the size of one of the color
  370. #    scale canvases is changed.
  371. #
  372. proc ::tk::dialog::color::DrawColorScale {w c {create 0}} {
  373.     upvar ::tk::dialog::color::[winfo name $w] data
  374.  
  375.     # col: color bar canvas
  376.     # sel: selector canvas
  377.     set col $data($c,col)
  378.     set sel $data($c,sel)
  379.  
  380.     # First handle the case that we are creating everything for the first time.
  381.     if {$create} {
  382.     # First remove all the lines that already exist.
  383.     if { $data(lines,$c,last) > $data(lines,$c,start)} {
  384.         for {set i $data(lines,$c,start)} \
  385.         {$i <= $data(lines,$c,last)} { incr i} {
  386.         $sel delete $i
  387.         }
  388.     }
  389.     # Delete the selector if it exists
  390.     if {[info exists data($c,index)]} {
  391.         $sel delete $data($c,index)
  392.     }
  393.     
  394.     # Draw the selection polygons
  395.     CreateSelector $w $sel $c
  396.     $sel bind $data($c,index) <ButtonPress-1> \
  397.         [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1]
  398.     $sel bind $data($c,index) <B1-Motion> \
  399.         [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
  400.     $sel bind $data($c,index) <ButtonRelease-1> \
  401.         [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]
  402.  
  403.     set height [winfo height $col]
  404.     # Create an invisible region under the colorstrip to catch mouse clicks
  405.     # that aren't on the selector.
  406.     set data($c,clickRegion) [$sel create rectangle 0 0 \
  407.         $data(canvasWidth) $height -fill {} -outline {}]
  408.  
  409.     bind $col <ButtonPress-1> \
  410.         [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)]
  411.     bind $col <B1-Motion> \
  412.         [list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)]
  413.     bind $col <ButtonRelease-1> \
  414.         [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)]
  415.  
  416.     $sel bind $data($c,clickRegion) <ButtonPress-1> \
  417.         [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)]
  418.     $sel bind $data($c,clickRegion) <B1-Motion> \
  419.         [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
  420.     $sel bind $data($c,clickRegion) <ButtonRelease-1> \
  421.         [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]
  422.     } else {
  423.     # l is the canvas index of the first colorbar.
  424.     set l $data(lines,$c,start)
  425.     }
  426.     
  427.     # Draw the color bars.
  428.     set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]
  429.     for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
  430.     set intensity [expr {$i * $data(intensityIncr)}]
  431.     set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
  432.     if {[string equal $c "red"]} {
  433.         set color [format "#%02x%02x%02x" \
  434.                $intensity \
  435.                $data(green,intensity) \
  436.                $data(blue,intensity)]
  437.     } elseif {[string equal $c "green"]} {
  438.         set color [format "#%02x%02x%02x" \
  439.                $data(red,intensity) \
  440.                $intensity \
  441.                $data(blue,intensity)]
  442.     } else {
  443.         set color [format "#%02x%02x%02x" \
  444.                $data(red,intensity) \
  445.                $data(green,intensity) \
  446.                $intensity]
  447.     }
  448.  
  449.     if {$create} {
  450.         set index [$col create rect $startx $highlightW \
  451.             [expr {$startx +$data(colorbarWidth)}] \
  452.             [expr {[winfo height $col] + $highlightW}]\
  453.             -fill $color -outline $color]
  454.     } else {
  455.         $col itemconfigure $l -fill $color -outline $color
  456.         incr l
  457.     }
  458.     }
  459.     $sel raise $data($c,index)
  460.  
  461.     if {$create} {
  462.     set data(lines,$c,last) $index
  463.     set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
  464.     }
  465.  
  466.     RedrawFinalColor $w
  467. }
  468.  
  469. # ::tk::dialog::color::CreateSelector --
  470. #
  471. #    Creates and draws the selector polygon at the position
  472. #    $data($c,intensity).
  473. #
  474. proc ::tk::dialog::color::CreateSelector {w sel c } {
  475.     upvar ::tk::dialog::color::[winfo name $w] data
  476.     set data($c,index) [$sel create polygon \
  477.     0 $data(PLGN_HEIGHT) \
  478.     $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
  479.     $data(indent) 0]
  480.     set data($c,x) [RgbToX $w $data($c,intensity)]
  481.     $sel move $data($c,index) $data($c,x) 0
  482. }
  483.  
  484. # ::tk::dialog::color::RedrawFinalColor
  485. #
  486. #    Combines the intensities of the three colors into the final color
  487. #
  488. proc ::tk::dialog::color::RedrawFinalColor {w} {
  489.     upvar ::tk::dialog::color::[winfo name $w] data
  490.  
  491.     set color [format "#%02x%02x%02x" $data(red,intensity) \
  492.     $data(green,intensity) $data(blue,intensity)]
  493.     
  494.     $data(finalCanvas) configure -bg $color
  495.     set data(finalColor) $color
  496.     set data(selection) $color
  497.     set data(finalRGB) [list \
  498.         $data(red,intensity) \
  499.         $data(green,intensity) \
  500.         $data(blue,intensity)]
  501. }
  502.  
  503. # ::tk::dialog::color::RedrawColorBars --
  504. #
  505. # Only redraws the colors on the color strips that were not manipulated.
  506. # Params: color of colorstrip that changed. If color is not [red|green|blue]
  507. #         Then all colorstrips will be updated
  508. #
  509. proc ::tk::dialog::color::RedrawColorBars {w colorChanged} {
  510.     upvar ::tk::dialog::color::[winfo name $w] data
  511.  
  512.     switch $colorChanged {
  513.     red { 
  514.         DrawColorScale $w green
  515.         DrawColorScale $w blue
  516.     }
  517.     green {
  518.         DrawColorScale $w red
  519.         DrawColorScale $w blue
  520.     }
  521.     blue {
  522.         DrawColorScale $w red
  523.         DrawColorScale $w green
  524.     }
  525.     default {
  526.         DrawColorScale $w red
  527.         DrawColorScale $w green
  528.         DrawColorScale $w blue
  529.     }
  530.     }
  531.     RedrawFinalColor $w
  532. }
  533.  
  534. #----------------------------------------------------------------------
  535. #            Event handlers
  536. #----------------------------------------------------------------------
  537.  
  538. # ::tk::dialog::color::StartMove --
  539. #
  540. #    Handles a mousedown button event over the selector polygon.
  541. #    Adds the bindings for moving the mouse while the button is
  542. #    pressed.  Sets the binding for the button-release event.
  543. # 
  544. # Params: sel is the selector canvas window, color is the color of the strip.
  545. #
  546. proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} {
  547.     upvar ::tk::dialog::color::[winfo name $w] data
  548.  
  549.     if {!$dontMove} {
  550.     MoveSelector $w $sel $color $x $delta
  551.     }
  552. }
  553.  
  554. # ::tk::dialog::color::MoveSelector --
  555. # 
  556. # Moves the polygon selector so that its middle point has the same
  557. # x value as the specified x. If x is outside the bounds [0,255],
  558. # the selector is set to the closest endpoint.
  559. #
  560. # Params: sel is the selector canvas, c is [red|green|blue]
  561. #         x is a x-coordinate.
  562. #
  563. proc ::tk::dialog::color::MoveSelector {w sel color x delta} {
  564.     upvar ::tk::dialog::color::[winfo name $w] data
  565.  
  566.     incr x -$delta
  567.  
  568.     if { $x < 0 } {
  569.     set x 0
  570.     } elseif { $x > $data(BARS_WIDTH)} {
  571.     set x $data(BARS_WIDTH)
  572.     }
  573.     set diff [expr {$x - $data($color,x)}]
  574.     $sel move $data($color,index) $diff 0
  575.     set data($color,x) [expr {$data($color,x) + $diff}]
  576.     
  577.     # Return the x value that it was actually set at
  578.     return $x
  579. }
  580.  
  581. # ::tk::dialog::color::ReleaseMouse
  582. #
  583. # Removes mouse tracking bindings, updates the colorbars.
  584. #
  585. # Params: sel is the selector canvas, color is the color of the strip,
  586. #         x is the x-coord of the mouse.
  587. #
  588. proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} {
  589.     upvar ::tk::dialog::color::[winfo name $w] data 
  590.  
  591.     set x [MoveSelector $w $sel $color $x $delta]
  592.     
  593.     # Determine exactly what color we are looking at.
  594.     set data($color,intensity) [XToRgb $w $x]
  595.  
  596.     RedrawColorBars $w $color
  597. }
  598.  
  599. # ::tk::dialog::color::ResizeColorbars --
  600. #
  601. #    Completely redraws the colorbars, including resizing the
  602. #    colorstrips
  603. #
  604. proc ::tk::dialog::color::ResizeColorBars {w} {
  605.     upvar ::tk::dialog::color::[winfo name $w] data
  606.     
  607.     if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || 
  608.      (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
  609.     set data(BARS_WIDTH) $data(NUM_COLORBARS)
  610.     }
  611.     InitValues [winfo name $w]
  612.     foreach color [list red green blue ] {
  613.     $data($color,col) configure -width $data(canvasWidth)
  614.     DrawColorScale $w $color 1
  615.     }
  616. }
  617.  
  618. # ::tk::dialog::color::HandleSelEntry --
  619. #
  620. #    Handles the return keypress event in the "Selection:" entry
  621. #
  622. proc ::tk::dialog::color::HandleSelEntry {w} {
  623.     upvar ::tk::dialog::color::[winfo name $w] data
  624.  
  625.     set text [string trim $data(selection)]
  626.     # Check to make sure that the color is valid
  627.     if {[catch {set color [winfo rgb . $text]} ]} {
  628.     set data(selection) $data(finalColor)
  629.     return
  630.     }
  631.     
  632.     set R [expr {[lindex $color 0]/0x100}]
  633.     set G [expr {[lindex $color 1]/0x100}]
  634.     set B [expr {[lindex $color 2]/0x100}]
  635.  
  636.     SetRGBValue $w "$R $G $B"
  637.     set data(selection) $text
  638. }
  639.  
  640. # ::tk::dialog::color::HandleRGBEntry --
  641. #
  642. #    Handles the return keypress event in the R, G or B entry
  643. #
  644. proc ::tk::dialog::color::HandleRGBEntry {w} {
  645.     upvar ::tk::dialog::color::[winfo name $w] data
  646.  
  647.     foreach c [list red green blue] {
  648.     if {[catch {
  649.         set data($c,intensity) [expr {int($data($c,intensity))}]
  650.     }]} {
  651.         set data($c,intensity) 0
  652.     }
  653.  
  654.     if {$data($c,intensity) < 0} {
  655.         set data($c,intensity) 0
  656.     }
  657.     if {$data($c,intensity) > 255} {
  658.         set data($c,intensity) 255
  659.     }
  660.     }
  661.  
  662.     SetRGBValue $w "$data(red,intensity) \
  663.     $data(green,intensity) $data(blue,intensity)"
  664. }    
  665.  
  666. # mouse cursor enters a color bar
  667. #
  668. proc ::tk::dialog::color::EnterColorBar {w color} {
  669.     upvar ::tk::dialog::color::[winfo name $w] data
  670.  
  671.     $data($color,sel) itemconfig $data($color,index) -fill red
  672. }
  673.  
  674. # mouse leaves enters a color bar
  675. #
  676. proc ::tk::dialog::color::LeaveColorBar {w color} {
  677.     upvar ::tk::dialog::color::[winfo name $w] data
  678.  
  679.     $data($color,sel) itemconfig $data($color,index) -fill black
  680. }
  681.  
  682. # user hits OK button
  683. #
  684. proc ::tk::dialog::color::OkCmd {w} {
  685.     variable ::tk::Priv
  686.     upvar ::tk::dialog::color::[winfo name $w] data
  687.  
  688.     set Priv(selectColor) $data(finalColor)
  689. }
  690.  
  691. # user hits Cancel button
  692. #
  693. proc ::tk::dialog::color::CancelCmd {w} {
  694.     variable ::tk::Priv
  695.     set Priv(selectColor) ""
  696. }
  697.  
  698.