diff options
author | stanton <stanton> | 1998-09-30 02:19:04 (GMT) |
---|---|---|
committer | stanton <stanton> | 1998-09-30 02:19:04 (GMT) |
commit | da9d3d17d12952676d1c5a7a8424221f708d4a0e (patch) | |
tree | 2ab332f7ff062a2df7010439c8d332e4f71ade6d /library/palette.tcl | |
parent | 139cae1fba039b0ff1c8d5e8f563903d2fd52c72 (diff) | |
download | tk-da9d3d17d12952676d1c5a7a8424221f708d4a0e.zip tk-da9d3d17d12952676d1c5a7a8424221f708d4a0e.tar.gz tk-da9d3d17d12952676d1c5a7a8424221f708d4a0e.tar.bz2 |
Merged 8.0.3 changes into 8.1
Diffstat (limited to 'library/palette.tcl')
-rw-r--r-- | library/palette.tcl | 222 |
1 files changed, 0 insertions, 222 deletions
diff --git a/library/palette.tcl b/library/palette.tcl deleted file mode 100644 index 572e1e3..0000000 --- a/library/palette.tcl +++ /dev/null @@ -1,222 +0,0 @@ -# palette.tcl -- -# -# This file contains procedures that change the color palette used -# by Tk. -# -# RCS: @(#) $Id: palette.tcl,v 1.3 1998/09/14 18:23:24 stanton Exp $ -# -# Copyright (c) 1995-1997 Sun Microsystems, Inc. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# - -# tk_setPalette -- -# Changes the default color scheme for a Tk application by setting -# default colors in the option database and by modifying all of the -# color options for existing widgets that have the default value. -# -# Arguments: -# The arguments consist of either a single color name, which -# will be used as the new background color (all other colors will -# be computed from this) or an even number of values consisting of -# option names and values. The name for an option is the one used -# for the option database, such as activeForeground, not -activeforeground. - -proc tk_setPalette {args} { - global tkPalette - - # Create an array that has the complete new palette. If some colors - # aren't specified, compute them from other colors that are specified. - - if {[llength $args] == 1} { - set new(background) [lindex $args 0] - } else { - array set new $args - } - if {![info exists new(background)]} { - error "must specify a background color" - } - if {![info exists new(foreground)]} { - set new(foreground) black - } - set bg [winfo rgb . $new(background)] - set fg [winfo rgb . $new(foreground)] - set darkerBg [format #%02x%02x%02x [expr {(9*[lindex $bg 0])/2560}] \ - [expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]] - foreach i {activeForeground insertBackground selectForeground \ - highlightColor} { - if {![info exists new($i)]} { - set new($i) $new(foreground) - } - } - if {![info exists new(disabledForeground)]} { - set new(disabledForeground) [format #%02x%02x%02x \ - [expr {(3*[lindex $bg 0] + [lindex $fg 0])/1024}] \ - [expr {(3*[lindex $bg 1] + [lindex $fg 1])/1024}] \ - [expr {(3*[lindex $bg 2] + [lindex $fg 2])/1024}]] - } - if {![info exists new(highlightBackground)]} { - set new(highlightBackground) $new(background) - } - if {![info exists new(activeBackground)]} { - # Pick a default active background that islighter than the - # normal background. To do this, round each color component - # up by 15% or 1/3 of the way to full white, whichever is - # greater. - - foreach i {0 1 2} { - set light($i) [expr {[lindex $bg $i]/256}] - set inc1 [expr {($light($i)*15)/100}] - set inc2 [expr {(255-$light($i))/3}] - if {$inc1 > $inc2} { - incr light($i) $inc1 - } else { - incr light($i) $inc2 - } - if {$light($i) > 255} { - set light($i) 255 - } - } - set new(activeBackground) [format #%02x%02x%02x $light(0) \ - $light(1) $light(2)] - } - if {![info exists new(selectBackground)]} { - set new(selectBackground) $darkerBg - } - if {![info exists new(troughColor)]} { - set new(troughColor) $darkerBg - } - if {![info exists new(selectColor)]} { - set new(selectColor) #b03060 - } - - # let's make one of each of the widgets so we know what the - # defaults are currently for this platform. - toplevel .___tk_set_palette - wm withdraw .___tk_set_palette - foreach q {button canvas checkbutton entry frame label listbox menubutton menu message \ - radiobutton scale scrollbar text} { - $q .___tk_set_palette.$q - } - - # Walk the widget hierarchy, recoloring all existing windows. - # The option database must be set according to what we do here, - # but it breaks things if we set things in the database while - # we are changing colors...so, tkRecolorTree now returns the - # option database changes that need to be made, and they - # need to be evalled here to take effect. - # We have to walk the whole widget tree instead of just - # relying on the widgets we've created above to do the work - # because different extensions may provide other kinds - # of widgets that we don't currently know about, so we'll - # walk the whole hierarchy just in case. - - eval [tkRecolorTree . new] - - catch {destroy .___tk_set_palette} - - # Change the option database so that future windows will get the - # same colors. - - foreach option [array names new] { - option add *$option $new($option) widgetDefault - } - - # Save the options in the global variable tkPalette, for use the - # next time we change the options. - - array set tkPalette [array get new] -} - -# tkRecolorTree -- -# This procedure changes the colors in a window and all of its -# descendants, according to information provided by the colors -# argument. This looks at the defaults provided by the option -# database, if it exists, and if not, then it looks at the default -# value of the widget itself. -# -# Arguments: -# w - The name of a window. This window and all its -# descendants are recolored. -# colors - The name of an array variable in the caller, -# which contains color information. Each element -# is named after a widget configuration option, and -# each value is the value for that option. - -proc tkRecolorTree {w colors} { - global tkPalette - upvar $colors c - set result {} - foreach dbOption [array names c] { - set option -[string tolower $dbOption] - if {![catch {$w config $option} value]} { - # if the option database has a preference for this - # dbOption, then use it, otherwise use the defaults - # for the widget. - set defaultcolor [option get $w $dbOption widgetDefault] - if {[string match {} $defaultcolor]} { - set defaultcolor [winfo rgb . [lindex $value 3]] - } else { - set defaultcolor [winfo rgb . $defaultcolor] - } - set chosencolor [winfo rgb . [lindex $value 4]] - if {[string match $defaultcolor $chosencolor]} { - # Change the option database so that future windows will get - # the same colors. - append result ";\noption add [list \ - *[winfo class $w].$dbOption $c($dbOption) 60]" - $w configure $option $c($dbOption) - } - } - } - foreach child [winfo children $w] { - append result ";\n[tkRecolorTree $child c]" - } - return $result -} - -# tkDarken -- -# Given a color name, computes a new color value that darkens (or -# brightens) the given color by a given percent. -# -# Arguments: -# color - Name of starting color. -# perecent - Integer telling how much to brighten or darken as a -# percent: 50 means darken by 50%, 110 means brighten -# by 10%. - -proc tkDarken {color percent} { - set l [winfo rgb . $color] - set red [expr {[lindex $l 0]/256}] - set green [expr {[lindex $l 1]/256}] - set blue [expr {[lindex $l 2]/256}] - set red [expr {($red*$percent)/100}] - if {$red > 255} { - set red 255 - } - set green [expr {($green*$percent)/100}] - if {$green > 255} { - set green 255 - } - set blue [expr {($blue*$percent)/100}] - if {$blue > 255} { - set blue 255 - } - format #%02x%02x%02x $red $green $blue -} - -# tk_bisque -- -# Reset the Tk color palette to the old "bisque" colors. -# -# Arguments: -# None. - -proc tk_bisque {} { - tk_setPalette activeBackground #e6ceb1 activeForeground black \ - background #ffe4c4 disabledForeground #b0b0b0 foreground black \ - highlightBackground #ffe4c4 highlightColor black \ - insertBackground black selectColor #b03060 \ - selectBackground #e6ceb1 selectForeground black \ - troughColor #cdb79e -} |