head	1.7;
access;
symbols
	core-8-5-9:1.6
	core-8-5-8:1.6
	macosx-cocoa-merge:1.7
	macosx-cocoa-premerge:1.7
	macosx-carbon-freeze:1.7
	core-8-5-7:1.6
	core-8-5-6:1.6
	core-8-6-b1:1.6
	core-8-6-a3:1.6
	core-8-5-5:1.6
	core-8-6-a2:1.6
	core-8-5-4:1.6
	core-8-5-3:1.6
	core-8-6-a1:1.6
	core-8-4-19:1.3
	core-8-5-branch:1.6.0.2
	core-8-5-2:1.6
	core-8-4-18:1.3
	core-8-5-1:1.6
	core-8-4-17:1.3
	core-8-5-0:1.6
	core-8-5-b3:1.5
	core-8-5-b2:1.4
	core-8-4-16:1.3
	core-8-5-b1:1.4
	core-stablilizer-merge:1.4
	core-stabilizer-branch:1.4.0.4
	core-stabilizer-merge:1.6
	core-8-4-15:1.3
	core-8-5-a6:1.4
	core-8-5-a5:1.4
	core-8-4-14:1.3
	core-8-5-a4:1.4
	core-8-4-13:1.3
	core-8-4-12:1.3
	core-8-4-11:1.3
	core-8-5-a3:1.4
	core-8-4-10:1.3
	core-8-4-9-branch:1.3.0.4
	core-8-5-a2:1.4
	core-8-4-9:1.3
	core-8-4-8:1.3
	core-8-4-7:1.3
	core-8-5-a1:1.4
	core-8-4-6:1.3
	core-8-4-5:1.3
	mistachkin-dev-branch:1.4.0.2
	core-8-4-4:1.3
	core-8-4-3:1.3
	core-8-4-branch:1.3.0.2
	core-8-4-2:1.3
	core-8-4-1:1.3
	core-8-3-5:1.2.18.1
	core-8-4-0:1.3
	macosx-8-4-merge-2002-08-31-trunk:1.3
	macosx-8-4-premerge-2002-08-31-branch:1.2.24.1
	macosx-8-4-premerge-2002-08-31-trunk:1.3
	macosx-8-4-merge-2002-08-30-branch:1.2.24.1
	macosx-8-4-merge-2002-08-30-trunk:1.3
	macosx-8-4-merge-2002-08-20-branch:1.2.24.1
	macosx-8-4-merge-2002-08-20-trunk:1.3
	core-8-4-b2:1.3
	core-8-4-b1:1.3
	macosx-premerge-6-9-02:1.2.24.1
	core-8-4-a4:1.3
	core-8-3-4:1.2.18.1
	macosx-8-4-branch:1.2.0.24
	macosx-8-4-branchpoint:1.2
	core-8-4-a3:1.2
	core-8-3-3:1.2
	dgp-privates-into-namespace:1.2.0.22
	tclpro-1-5-0:1.2
	core-8-4-win-speedup:1.2.0.20
	core-8-4-a2:1.2
	tclpro-1-4-1:1.2
	tclpro-1-4-0:1.2
	core-8-3-2:1.2
	ajuba-ajuba2-2-1-base:1.2
	ajuba-ajuba2-2-0:1.2
	core-8-4-a1:1.2
	core-8-3-1-branch:1.2.0.18
	core-8-3-1:1.2
	scriptics-sc-2-0-b5:1.2
	scriptics-sc-2-0-fixed:1.2
	scriptics-sc-2-0-b2:1.2
	scriptics-sc-2-0-b1:1.2
	core-8-3-0:1.2
	core-8-3-b2:1.2
	core-8-3-b1:1.2
	scriptics-sc-1-1:1.2
	scriptics-sc-1-1-b1:1.2
	core-8-2-3:1.2
	scriptics-sc-1-1-branch:1.2.0.16
	scriptics-sc-1-1-base:1.2
	scriptics-sc-1-0:1.2
	scriptics-sc-1-0-branch:1.2.0.14
	scriptics-sc-1-0-base:1.2
	core-8-2-2:1.2
	core-8-2-1:1.2
	scriptics-bc-1-0-b1:1.2
	core-8-2-1-branch:1.2.0.12
	scriptics-tclpro-1-3-0:1.2
	core-8-2-0:1.2
	core-8-2-b3-branch:1.2.0.10
	core-8-2-b3-base:1.2
	scriptics-tclpro-1-3-b4:1.2
	core-8-2-b2:1.2
	scriptics-tclpro-1-3-b3:1.2
	core-8-2-b1:1.2
	scriptics-tclpro-1-3-b2:1.2
	merge-to-mainline-5/21/99:1.2
	scriptics-tclpro-1-3-b2-branch:1.2.0.8
	core-8-1-1:1.2
	scriptics-tclpro-1-3-b1:1.2
	core-8-1-1-base:1.2
	core-8-1-0:1.2
	merge-to-mainline-4-29-99:1.2
	merge-to-mainline-4-23-99:1.2
	core-8-1-branch-old:1.1.0.4
	core-8-0-6-branch:1.2.0.6
	core-8-0-6-base:1.2
	core-8-0-5:1.2
	core-8-1-b3:1.1.4.1
	core-8-1-b2:1.1.4.1
	dev-8-1-stubs-branch:1.1.4.1.0.2
	dev-stubs-branch:1.2.0.4
	scriptics-tclpro-1-2:1.2
	scriptics-tclpro-1-2-b2:1.2
	core-8-1-merge-2/10/99:1.2
	core-8-0-5-branch:1.2.0.2
	core-8-0-5-base:1.2
	scriptics-tclpro-1-2-b1:1.2
	scriptics-tclpro-1-2-a1:1.2
	core-8-1-b1:1.1.4.1
	core-8-0-4:1.2
	core-8-1-a2:1.1
	core-8-0-2:1.1
	core-8-0-3:1.2;
locks; strict;
comment	@# @;


1.7
date	2009.03.25.23.27.14;	author nijtmans;	state Exp;
branches;
next	1.6;

1.6
date	2007.12.13.15.27.07;	author dgp;	state Exp;
branches;
next	1.5;

1.5
date	2007.10.30.01.57.55;	author hobbs;	state Exp;
branches;
next	1.4;

1.4
date	2003.09.30.14.54.30;	author dkf;	state Exp;
branches
	1.4.4.1;
next	1.3;

1.3
date	2001.10.29.16.23.32;	author dkf;	state Exp;
branches;
next	1.2;

1.2
date	98.09.14.18.23.30;	author stanton;	state Exp;
branches
	1.2.18.1
	1.2.20.1
	1.2.24.1;
next	1.1;

1.1
date	98.04.01.09.54.30;	author rjohnson;	state Exp;
branches
	1.1.4.1;
next	;

1.1.4.1
date	98.09.30.02.17.55;	author stanton;	state Exp;
branches;
next	;

1.2.18.1
date	2001.10.12.10.56.13;	author dkf;	state Exp;
branches;
next	;

1.2.20.1
date	2002.04.02.20.58.51;	author hobbs;	state Exp;
branches;
next	;

1.2.24.1
date	2002.02.05.02.25.16;	author wolfsuit;	state Exp;
branches;
next	;

1.4.4.1
date	2007.11.01.16.37.22;	author dgp;	state Exp;
branches;
next	;


desc
@@


1.7
log
@bring doc and demos in line with http://wiki.tcl.tk/812
@
text
@#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@@"}

# tcolor --
# This script implements a simple color editor, where you can
# create colors using either the RGB, HSB, or CYM color spaces
# and apply the color to existing applications.
#
# RCS: @@(#) $Id: tcolor,v 1.6 2007/12/13 15:27:07 dgp Exp $

package require Tk 8.4
wm title . "Color Editor"

# Global variables that control the program:
#
# colorSpace -			Color space currently being used for
#				editing.  Must be "rgb", "cmy", or "hsb".
# label1, label2, label3 -	Labels for the scales.
# red, green, blue -		Current color intensities in decimal
#				on a scale of 0-65535.
# color -			A string giving the current color value
#				in the proper form for x:
#				#RRRRGGGGBBBB
# updating -			Non-zero means that we're in the middle of
#				updating the scales to load a new color,so
#				information shouldn't be propagating back
#				from the scales to other elements of the
#				program:  this would make an infinite loop.
# command -			Holds the command that has been typed
#				into the "Command" entry.
# autoUpdate -			1 means execute the update command
#				automatically whenever the color changes.
# name -			Name for new color, typed into entry.

set colorSpace hsb
set red 65535
set green 0
set blue 0
set color #ffff00000000
set updating 0
set autoUpdate 1
set name ""

# Create the menu bar at the top of the window.

. configure -menu [menu .menu]
menu .menu.file
.menu add cascade  -menu .menu.file  -label File  -underline 0
.menu.file add radio -label "RGB color space" -variable colorSpace \
	-value rgb -underline 0 -command {changeColorSpace rgb}
.menu.file add radio -label "CMY color space" -variable colorSpace \
	-value cmy -underline 0 -command {changeColorSpace cmy}
.menu.file add radio -label "HSB color space" -variable colorSpace \
	-value hsb -underline 0 -command {changeColorSpace hsb}
.menu.file add separator
.menu.file add radio -label "Automatic updates" -variable autoUpdate \
	-value 1 -underline 0
.menu.file add radio -label "Manual updates" -variable autoUpdate \
	-value 0 -underline 0
.menu.file add separator
.menu.file add command -label "Exit program" -underline 0 -command {exit}

# Create the command entry window at the bottom of the window, along
# with the update button.

labelframe .command -text "Command:" -padx {1m 0}
entry .command.e -textvariable command
button .command.update -text Update -command doUpdate
pack .command.update -side right -pady .1c -padx {.25c 0}
pack .command.e -expand yes -fill x -ipadx 0.25c


# Create the listbox that holds all of the color names in rgb.txt,
# if an rgb.txt file can be found.

grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m}

grid columnconfigure . {1 2} -weight 1
grid rowconfigure . 0 -weight 1
foreach i {
    /usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
    /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
    /usr/openwin/lib/X11/rgb.txt
} {
    if {![file readable $i]} {
	continue;
    }
    set f [open $i]
    labelframe .names -text "Select:" -padx .1c -pady .1c
    grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2
    grid columnconfigure . 0 -weight 1
    listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \
	-exportselection false
    bind .names.lb <Double-1> {
	    tc_loadNamedColor [.names.lb get [.names.lb curselection]]
    }
    scrollbar .names.s -orient vertical -command ".names.lb yview"
    pack .names.lb .names.s -side left -fill y -expand 1
    while {[gets $f line] >= 0} {
	if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} {
	    .names.lb insert end $col
	}
    }
    close $f
    break
}

# Create the three scales for editing the color, and the entry for
# typing in a color value.

frame .adjust
foreach i {1 2 3} {
    label .adjust.l$i -textvariable label$i -pady 0
    labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m
    scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
	    -command tc_scaleChanged
    pack .scale$i -in .adjust.$i
    pack .adjust.$i
}
grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c

labelframe .name -text "Name:" -padx 1m -pady 1m
entry .name.e -textvariable name -width 10
pack .name.e -side right -expand 1 -fill x
bind .name.e <Return> {tc_loadNamedColor $name}
grid .name   -column 1 -row 1 -sticky nsew -padx .15c -pady .15c

# Create the color display swatch on the right side of the window.

labelframe .sample -text "Color:" -padx 1m -pady 1m
frame .sample.swatch -width 2c -height 5c -background $color
label .sample.value -textvariable color -width 13 -font {Courier 12}
pack .sample.swatch -side top -expand yes -fill both
pack .sample.value -side bottom -pady .25c
grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2


# The procedure below is invoked when one of the scales is adjusted.
# It propagates color information from the current scale readings
# to everywhere else that it is used.

proc tc_scaleChanged args {
    global red green blue colorSpace color updating autoUpdate
    if {$updating} {
	return
    }
    switch $colorSpace {
	rgb {
	    set red   [format %.0f [expr {[.scale1 get]*65.535}]]
	    set green [format %.0f [expr {[.scale2 get]*65.535}]]
	    set blue  [format %.0f [expr {[.scale3 get]*65.535}]]
	}
	cmy {
	    set red   [format %.0f [expr {65535 - [.scale1 get]*65.535}]]
	    set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]]
	    set blue  [format %.0f [expr {65535 - [.scale3 get]*65.535}]]
	}
	hsb {
	    set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \
		    [expr {[.scale2 get]/1000.0}] \
		    [expr {[.scale3 get]/1000.0}]]
	    set red [lindex $list 0]
	    set green [lindex $list 1]
	    set blue [lindex $list 2]
	}
    }
    set color [format "#%04x%04x%04x" $red $green $blue]
    .sample.swatch config -bg $color
    if {$autoUpdate} doUpdate
    update idletasks
}

# The procedure below is invoked to update the scales from the
# current red, green, and blue intensities.  It's invoked after
# a change in the color space and after a named color value has
# been loaded.

proc tc_setScales {} {
    global red green blue colorSpace updating
    set updating 1
    switch $colorSpace {
	rgb {
	    .scale1 set [format %.0f [expr {$red/65.535}]]
	    .scale2 set [format %.0f [expr {$green/65.535}]]
	    .scale3 set [format %.0f [expr {$blue/65.535}]]
	}
	cmy {
	    .scale1 set [format %.0f [expr {(65535-$red)/65.535}]]
	    .scale2 set [format %.0f [expr {(65535-$green)/65.535}]]
	    .scale3 set [format %.0f [expr {(65535-$blue)/65.535}]]
	}
	hsb {
	    set list [rgbToHsv $red $green $blue]
	    .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]
	    .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]
	    .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]]
	}
    }
    set updating 0
}

# The procedure below is invoked when a named color has been
# selected from the listbox or typed into the entry.  It loads
# the color into the editor.

proc tc_loadNamedColor name {
    global red green blue color autoUpdate

    if {[string index $name 0] != "#"} {
	set list [winfo rgb .sample.swatch $name]
	set red [lindex $list 0]
	set green [lindex $list 1]
	set blue [lindex $list 2]
    } else {
	switch [string length $name] {
	    4  {set format "#%1x%1x%1x"; set shift 12}
	    7  {set format "#%2x%2x%2x"; set shift 8}
	    10 {set format "#%3x%3x%3x"; set shift 4}
	    13 {set format "#%4x%4x%4x"; set shift 0}
	    default {error "syntax error in color name \"$name\""}
	}
	if {[scan $name $format red green blue] != 3} {
	    error "syntax error in color name \"$name\""
	}
	set red   [expr {$red<<$shift}]
	set green [expr {$green<<$shift}]
	set blue  [expr {$blue<<$shift}]
    }
    tc_setScales
    set color [format "#%04x%04x%04x" $red $green $blue]
    .sample.swatch config -bg $color
    if {$autoUpdate} doUpdate
}

# The procedure below is invoked when a new color space is selected.
# It changes the labels on the scales and re-loads the scales with
# the appropriate values for the current color in the new color space

proc changeColorSpace space {
    global label1 label2 label3
    switch $space {
	rgb {
	    set label1 "Adjust Red:"
	    set label2 "Adjust Green:"
	    set label3 "Adjust Blue:"
	    tc_setScales
	    return
	}
	cmy {
	    set label1 "Adjust Cyan:"
	    set label2 "Adjust Magenta:"
	    set label3 "Adjust Yellow:"
	    tc_setScales
	    return
	}
	hsb {
	    set label1 "Adjust Hue:"
	    set label2 "Adjust Saturation:"
	    set label3 "Adjust Brightness:"
	    tc_setScales
	    return
	}
    }
}

# The procedure below converts an RGB value to HSB.  It takes red, green,
# and blue components (0-65535) as arguments, and returns a list containing
# HSB components (floating-point, 0-1) as result.  The code here is a copy
# of the code on page 615 of "Fundamentals of Interactive Computer Graphics"
# by Foley and Van Dam.

proc rgbToHsv {red green blue} {
    if {$red > $green} {
	set max [expr {double($red)}]
	set min [expr {double($green)}]
    } else {
	set max [expr {double($green)}]
	set min [expr {double($red)}]
    }
    if {$blue > $max} {
	set max [expr {double($blue)}]
    } elseif {$blue < $min} {
	set min [expr {double($blue)}]
    }
    set range [expr {$max-$min}]
    if {$max == 0} {
	set sat 0
    } else {
	set sat [expr {($max-$min)/$max}]
    }
    if {$sat == 0} {
	set hue 0
    } else {
	set rc [expr {($max - $red)/$range}]
	set gc [expr {($max - $green)/$range}]
	set bc [expr {($max - $blue)/$range}]
	if {$red == $max} {
	    set hue [expr {($bc - $gc)/6.0}]
	} elseif {$green == $max} {
	    set hue [expr {(2 + $rc - $bc)/6.0}]
	} else {
	    set hue [expr {(4 + $gc - $rc)/6.0}]
	}
	if {$hue < 0.0} {
	    set hue [expr {$hue + 1.0}]
	}
    }
    return [list $hue $sat [expr {$max/65535}]]
}

# The procedure below converts an HSB value to RGB.  It takes hue, saturation,
# and value components (floating-point, 0-1.0) as arguments, and returns a
# list containing RGB components (integers, 0-65535) as result.  The code
# here is a copy of the code on page 616 of "Fundamentals of Interactive
# Computer Graphics" by Foley and Van Dam.

proc hsbToRgb {hue sat value} {
    set v [format %.0f [expr {65535.0*$value}]]
    if {$sat == 0} {
	return "$v $v $v"
    } else {
	set hue [expr {$hue*6.0}]
	if {$hue >= 6.0} {
	    set hue 0.0
	}
	scan $hue. %d i
	set f [expr {$hue-$i}]
	set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
	set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
	set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
	switch $i {
	    0 {return "$v $t $p"}
	    1 {return "$q $v $p"}
	    2 {return "$p $v $t"}
	    3 {return "$p $q $v"}
	    4 {return "$t $p $v"}
	    5 {return "$v $p $q"}
	    default {error "i value $i is out of range"}
	}
    }
}

# The procedure below is invoked when the "Update" button is pressed,
# and whenever the color changes if update mode is enabled.  It
# propagates color information as determined by the command in the
# Command entry.

proc doUpdate {} {
    global color command
    set newCmd $command
    regsub -all %% $command $color newCmd
    eval $newCmd
}

changeColorSpace hsb

# Local Variables:
# mode: tcl
# End:
@


1.6
log
@merge stable branch onto HEAD
@
text
@d3 1
a3 1
exec wish "$0" "$@@"
d10 1
a10 1
# RCS: @@(#) $Id: tcolor,v 1.4.4.1 2007/11/01 16:37:22 dgp Exp $
@


1.5
log
@	* tests/listbox.test, tests/panedwindow.test, tests/scrollbar.test:
	* library/bgerror.tcl, library/dialog.tcl, library/listbox.tcl:
	* library/msgbox.tcl, library/optMenu.tcl, library/tclIndex:
	* library/tkfbox.tcl, library/demos/floor.tcl, library/demos/rmt:
	* library/demos/tcolor, library/demos/text.tcl:
	* library/demos/twind.tcl, library/demos/widget: Buh-bye Motif look
	* library/ttk/fonts.tcl:    Update of Tk default look in 8.5
	* macosx/tkMacOSXDefault.h: Trims border sizes, cleaner X11 look
	* unix/tkUnixDefault.h:     with minor modifications for Win32/Aqua.
	* win/tkWinDefault.h:       Uses Tk*Font definitions throughout for
	* win/tkWinFont.c:          classic widgets. [Bug #1820344]
	* library/obsolete.tcl (::tk::classic::restore): This restores
	changes made to defaults in 8.5 using the 'option' command,
	segmented into logical groups.
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: tcolor,v 1.4 2003/09/30 14:54:30 dkf Exp $
@


1.4
log
@Added [package require] to demos. [FRQ 815118]
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: tcolor,v 1.3 2001/10/29 16:23:32 dkf Exp $
a44 4
if {$tcl_platform(platform) eq "unix"} {
    option add *Entry.background white
}

d68 1
a68 2
entry .command.e -relief sunken -borderwidth 2 -textvariable command \
	-font {Courier 12}
d94 1
a94 1
	    -relief sunken -borderwidth 2 -exportselection false
d98 1
a98 2
    scrollbar .names.s -orient vertical -command ".names.lb yview" \
	    -relief sunken -borderwidth 2
d124 1
a124 2
entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \
	-font {Courier 12}
@


1.4.4.1
log
@merge updates from HEAD
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: tcolor,v 1.4 2003/09/30 14:54:30 dkf Exp $
d45 4
d72 2
a73 1
entry .command.e -textvariable command
d99 1
a99 1
	-exportselection false
d103 2
a104 1
    scrollbar .names.s -orient vertical -command ".names.lb yview"
d130 2
a131 1
entry .name.e -textvariable name -width 10
@


1.3
log
@Improvements to the demo scripts, mostly up-ported from 8.3.4
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: tcolor,v 1.2 1998/09/14 18:23:30 stanton Exp $
d12 1
@


1.2
log
@Replaced SCCS strings, fixed binary files
@
text
@d10 1
a10 1
# RCS: @@(#) $Id$
d44 4
d50 4
a53 5
frame .menu -relief raised -borderwidth 2
pack .menu -side top -fill x
menubutton .menu.file -text File -menu .menu.file.m -underline 0
menu .menu.file.m
.menu.file.m add radio -label "RGB color space" -variable colorSpace \
d55 1
a55 1
.menu.file.m add radio -label "CMY color space" -variable colorSpace \
d57 1
a57 1
.menu.file.m add radio -label "HSB color space" -variable colorSpace \
d59 2
a60 2
.menu.file.m add separator
.menu.file.m add radio -label "Automatic updates" -variable autoUpdate \
d62 1
a62 1
.menu.file.m add radio -label "Manual updates" -variable autoUpdate \
d64 2
a65 4
.menu.file.m add separator
.menu.file.m add command -label "Exit program" -underline 0 \
	-command "destroy ."
pack .menu.file -side left
d70 2
a71 4
frame .bot -relief raised -borderwidth 2
pack .bot -side bottom -fill x
label .commandLabel -text "Command:"
entry .command -relief sunken -borderwidth 2 -textvariable command \
d73 4
a76 4
button .update -text Update -command doUpdate
pack .commandLabel -in .bot -side left
pack .update -in .bot -side right -pady .1c -padx .25c
pack .command -in .bot -expand yes -fill x -ipadx 0.25c
d81 10
a90 6
frame .middle -relief raised -borderwidth 2
pack .middle -side top -fill both
foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
	/X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
	/usr/openwin/lib/X11/rgb.txt} {
    if ![file readable $i] {
d94 4
a97 3
    frame .middle.left
    pack .middle.left -side left -padx .25c -pady .25c
    listbox .names -width 20 -height 12 -yscrollcommand ".scroll set" \
d99 2
a100 2
    bind .names <Double-1> {
	    tc_loadNamedColor [.names get [.names curselection]]
d102 1
a102 1
    scrollbar .scroll -orient vertical -command ".names yview" \
d104 1
a104 2
    pack .names -in .middle.left -side left
    pack .scroll -in .middle.left -side right -fill y
d106 2
a107 2
	if {[llength $line] == 4} {
	    .names insert end [lindex $line 3]
d117 1
a117 8
frame .middle.middle
pack .middle.middle -side left -expand yes -fill y
frame .middle.middle.1
frame .middle.middle.2
frame .middle.middle.3
frame .middle.middle.4
pack .middle.middle.1 .middle.middle.2 .middle.middle.3 -side top -expand yes
pack .middle.middle.4 -side top -expand yes -fill x
d119 2
a120 1
    label .label$i -textvariable label$i
d123 2
a124 1
    pack .scale$i .label$i -in .middle.middle.$i -side top -anchor w
d126 4
a129 2
label .nameLabel -text "Name:"
entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \
d131 3
a133 3
pack .nameLabel -in .middle.middle.4 -side left
pack .name -in .middle.middle.4 -side right -expand 1 -fill x
bind .name <Return> {tc_loadNamedColor $name}
d137 7
a143 6
frame .middle.right
pack .middle.right -side left -pady .25c -padx .25c -anchor s
frame .swatch -width 2c -height 5c -background $color
label .value -textvariable color -width 13 -font {Courier 12}
pack .swatch -in .middle.right -side top -expand yes -fill both
pack .value -in .middle.right -side bottom -pady .25c
d151 1
a151 1
    if $updating {
d154 7
a160 6
    if {$colorSpace == "rgb"} {
	set red   [format %.0f [expr [.scale1 get]*65.535]]
	set green [format %.0f [expr [.scale2 get]*65.535]]
	set blue  [format %.0f [expr [.scale3 get]*65.535]]
    } else {
	if {$colorSpace == "cmy"} {
d164 2
a165 1
	} else {
d175 2
a176 2
    .swatch config -bg $color
    if $autoUpdate doUpdate
d188 12
a199 10
    if {$colorSpace == "rgb"} {
	.scale1 set [format %.0f [expr $red/65.535]]
	.scale2 set [format %.0f [expr $green/65.535]]
	.scale3 set [format %.0f [expr $blue/65.535]]
    } else {
	if {$colorSpace == "cmy"} {
	    .scale1 set [format %.0f [expr (65535-$red)/65.535]]
	    .scale2 set [format %.0f [expr (65535-$green)/65.535]]
	    .scale3 set [format %.0f [expr (65535-$blue)/65.535]]
	} else {
d217 1
a217 1
	set list [winfo rgb .swatch $name]
d222 3
a224 3
	case [string length $name] {
	    4 {set format "#%1x%1x%1x"; set shift 12}
	    7 {set format "#%2x%2x%2x"; set shift 8}
d232 3
a234 3
	set red [expr $red<<$shift]
	set green [expr $green<<$shift]
	set blue [expr $blue<<$shift]
d238 2
a239 2
    .swatch config -bg $color
    if $autoUpdate doUpdate
d248 22
a269 20
    if {$space == "rgb"} {
	set label1 Red
	set label2 Green
	set label3 Blue
	tc_setScales
	return
    }
    if {$space == "cmy"} {
	set label1 Cyan
	set label2 Magenta
	set label3 Yellow
	tc_setScales
	return
    }
    if {$space == "hsb"} {
	set label1 Hue
	set label2 Saturation
	set label3 Brightness
	tc_setScales
	return
d281 2
a282 2
	set max $red.0
	set min $green.0
d284 2
a285 2
	set max $green.0
	set min $red.0
d288 3
a290 5
	set max $blue.0
    } else {
	if {$blue < $min} {
	    set min $blue.0
	}
d292 1
a292 1
    set range [expr $max-$min]
d305 3
a307 1
	    set hue [expr {.166667*($bc - $gc)}]
d309 1
a309 5
	    if {$green == $max} {
		set hue [expr {.166667*(2 + $rc - $bc)}]
	    } else {
		set hue [expr {.166667*(4 + $gc - $rc)}]
	    }
d312 1
a312 1
	    set hue [expr $hue + 1.0]
d325 1
a325 1
    set v [format %.0f [expr 65535.0*$value]]
d329 1
a329 1
	set hue [expr $hue*6.0]
d334 1
a334 1
	set f [expr $hue-$i]
d338 6
a343 6
	case $i \
	    0 {return "$v $t $p"} \
	    1 {return "$q $v $p"} \
	    2 {return "$p $v $t"} \
	    3 {return "$p $q $v"} \
	    4 {return "$t $p $v"} \
d345 2
a346 1
	error "i value $i is out of range"
d363 4
@


1.2.20.1
log
@sync with head
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: tcolor,v 1.3 2001/10/29 16:23:32 dkf Exp $
a43 4
if {$tcl_platform(platform) eq "unix"} {
    option add *Entry.background white
}

d46 5
a50 4
. configure -menu [menu .menu]
menu .menu.file
.menu add cascade  -menu .menu.file  -label File  -underline 0
.menu.file add radio -label "RGB color space" -variable colorSpace \
d52 1
a52 1
.menu.file add radio -label "CMY color space" -variable colorSpace \
d54 1
a54 1
.menu.file add radio -label "HSB color space" -variable colorSpace \
d56 2
a57 2
.menu.file add separator
.menu.file add radio -label "Automatic updates" -variable autoUpdate \
d59 1
a59 1
.menu.file add radio -label "Manual updates" -variable autoUpdate \
d61 4
a64 2
.menu.file add separator
.menu.file add command -label "Exit program" -underline 0 -command {exit}
d69 4
a72 2
labelframe .command -text "Command:" -padx {1m 0}
entry .command.e -relief sunken -borderwidth 2 -textvariable command \
d74 4
a77 4
button .command.update -text Update -command doUpdate
pack .command.update -side right -pady .1c -padx {.25c 0}
pack .command.e -expand yes -fill x -ipadx 0.25c

d82 6
a87 10
grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m}

grid columnconfigure . {1 2} -weight 1
grid rowconfigure . 0 -weight 1
foreach i {
    /usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
    /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
    /usr/openwin/lib/X11/rgb.txt
} {
    if {![file readable $i]} {
d91 3
a93 4
    labelframe .names -text "Select:" -padx .1c -pady .1c
    grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2
    grid columnconfigure . 0 -weight 1
    listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \
d95 2
a96 2
    bind .names.lb <Double-1> {
	    tc_loadNamedColor [.names.lb get [.names.lb curselection]]
d98 1
a98 1
    scrollbar .names.s -orient vertical -command ".names.lb yview" \
d100 2
a101 1
    pack .names.lb .names.s -side left -fill y -expand 1
d103 2
a104 2
	if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} {
	    .names.lb insert end $col
d114 8
a121 1
frame .adjust
d123 1
a123 2
    label .adjust.l$i -textvariable label$i -pady 0
    labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m
d126 1
a126 2
    pack .scale$i -in .adjust.$i
    pack .adjust.$i
d128 2
a129 4
grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c

labelframe .name -text "Name:" -padx 1m -pady 1m
entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \
d131 3
a133 3
pack .name.e -side right -expand 1 -fill x
bind .name.e <Return> {tc_loadNamedColor $name}
grid .name   -column 1 -row 1 -sticky nsew -padx .15c -pady .15c
d137 6
a142 7
labelframe .sample -text "Color:" -padx 1m -pady 1m
frame .sample.swatch -width 2c -height 5c -background $color
label .sample.value -textvariable color -width 13 -font {Courier 12}
pack .sample.swatch -side top -expand yes -fill both
pack .sample.value -side bottom -pady .25c
grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2

d150 1
a150 1
    if {$updating} {
d153 6
a158 7
    switch $colorSpace {
	rgb {
	    set red   [format %.0f [expr {[.scale1 get]*65.535}]]
	    set green [format %.0f [expr {[.scale2 get]*65.535}]]
	    set blue  [format %.0f [expr {[.scale3 get]*65.535}]]
	}
	cmy {
d162 1
a162 2
	}
	hsb {
d172 2
a173 2
    .sample.swatch config -bg $color
    if {$autoUpdate} doUpdate
d185 10
a194 12
    switch $colorSpace {
	rgb {
	    .scale1 set [format %.0f [expr {$red/65.535}]]
	    .scale2 set [format %.0f [expr {$green/65.535}]]
	    .scale3 set [format %.0f [expr {$blue/65.535}]]
	}
	cmy {
	    .scale1 set [format %.0f [expr {(65535-$red)/65.535}]]
	    .scale2 set [format %.0f [expr {(65535-$green)/65.535}]]
	    .scale3 set [format %.0f [expr {(65535-$blue)/65.535}]]
	}
	hsb {
d212 1
a212 1
	set list [winfo rgb .sample.swatch $name]
d217 3
a219 3
	switch [string length $name] {
	    4  {set format "#%1x%1x%1x"; set shift 12}
	    7  {set format "#%2x%2x%2x"; set shift 8}
d227 3
a229 3
	set red   [expr {$red<<$shift}]
	set green [expr {$green<<$shift}]
	set blue  [expr {$blue<<$shift}]
d233 2
a234 2
    .sample.swatch config -bg $color
    if {$autoUpdate} doUpdate
d243 20
a262 22
    switch $space {
	rgb {
	    set label1 "Adjust Red:"
	    set label2 "Adjust Green:"
	    set label3 "Adjust Blue:"
	    tc_setScales
	    return
	}
	cmy {
	    set label1 "Adjust Cyan:"
	    set label2 "Adjust Magenta:"
	    set label3 "Adjust Yellow:"
	    tc_setScales
	    return
	}
	hsb {
	    set label1 "Adjust Hue:"
	    set label2 "Adjust Saturation:"
	    set label3 "Adjust Brightness:"
	    tc_setScales
	    return
	}
d274 2
a275 2
	set max [expr {double($red)}]
	set min [expr {double($green)}]
d277 2
a278 2
	set max [expr {double($green)}]
	set min [expr {double($red)}]
d281 5
a285 3
	set max [expr {double($blue)}]
    } elseif {$blue < $min} {
	set min [expr {double($blue)}]
d287 1
a287 1
    set range [expr {$max-$min}]
d300 1
a300 3
	    set hue [expr {($bc - $gc)/6.0}]
	} elseif {$green == $max} {
	    set hue [expr {(2 + $rc - $bc)/6.0}]
d302 5
a306 1
	    set hue [expr {(4 + $gc - $rc)/6.0}]
d309 1
a309 1
	    set hue [expr {$hue + 1.0}]
d322 1
a322 1
    set v [format %.0f [expr {65535.0*$value}]]
d326 1
a326 1
	set hue [expr {$hue*6.0}]
d331 1
a331 1
	set f [expr {$hue-$i}]
d335 6
a340 6
	switch $i {
	    0 {return "$v $t $p"}
	    1 {return "$q $v $p"}
	    2 {return "$p $v $t"}
	    3 {return "$p $q $v"}
	    4 {return "$t $p $v"}
d342 1
a342 2
	    default {error "i value $i is out of range"}
	}
a358 4

# Local Variables:
# mode: tcl
# End:
@


1.2.24.1
log
@Merge with current TOT
Added support for the wm stackorder command
Fixed crash when selecting Menu items in the Application menu that we didn't
put there.
Added first bits of the use of CG for low-level drawing.  The line-drawing works,
the rest doesn't yet.  You have to set the file static useCGDrawing to 1 and
rebuild to activate this code.
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: tcolor,v 1.2 1998/09/14 18:23:30 stanton Exp $
a43 4
if {$tcl_platform(platform) eq "unix"} {
    option add *Entry.background white
}

d46 5
a50 4
. configure -menu [menu .menu]
menu .menu.file
.menu add cascade  -menu .menu.file  -label File  -underline 0
.menu.file add radio -label "RGB color space" -variable colorSpace \
d52 1
a52 1
.menu.file add radio -label "CMY color space" -variable colorSpace \
d54 1
a54 1
.menu.file add radio -label "HSB color space" -variable colorSpace \
d56 2
a57 2
.menu.file add separator
.menu.file add radio -label "Automatic updates" -variable autoUpdate \
d59 1
a59 1
.menu.file add radio -label "Manual updates" -variable autoUpdate \
d61 4
a64 2
.menu.file add separator
.menu.file add command -label "Exit program" -underline 0 -command {exit}
d69 4
a72 2
labelframe .command -text "Command:" -padx {1m 0}
entry .command.e -relief sunken -borderwidth 2 -textvariable command \
d74 4
a77 4
button .command.update -text Update -command doUpdate
pack .command.update -side right -pady .1c -padx {.25c 0}
pack .command.e -expand yes -fill x -ipadx 0.25c

d82 6
a87 10
grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m}

grid columnconfigure . {1 2} -weight 1
grid rowconfigure . 0 -weight 1
foreach i {
    /usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
    /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
    /usr/openwin/lib/X11/rgb.txt
} {
    if {![file readable $i]} {
d91 3
a93 4
    labelframe .names -text "Select:" -padx .1c -pady .1c
    grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2
    grid columnconfigure . 0 -weight 1
    listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \
d95 2
a96 2
    bind .names.lb <Double-1> {
	    tc_loadNamedColor [.names.lb get [.names.lb curselection]]
d98 1
a98 1
    scrollbar .names.s -orient vertical -command ".names.lb yview" \
d100 2
a101 1
    pack .names.lb .names.s -side left -fill y -expand 1
d103 2
a104 2
	if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} {
	    .names.lb insert end $col
d114 8
a121 1
frame .adjust
d123 1
a123 2
    label .adjust.l$i -textvariable label$i -pady 0
    labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m
d126 1
a126 2
    pack .scale$i -in .adjust.$i
    pack .adjust.$i
d128 2
a129 4
grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c

labelframe .name -text "Name:" -padx 1m -pady 1m
entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \
d131 3
a133 3
pack .name.e -side right -expand 1 -fill x
bind .name.e <Return> {tc_loadNamedColor $name}
grid .name   -column 1 -row 1 -sticky nsew -padx .15c -pady .15c
d137 6
a142 7
labelframe .sample -text "Color:" -padx 1m -pady 1m
frame .sample.swatch -width 2c -height 5c -background $color
label .sample.value -textvariable color -width 13 -font {Courier 12}
pack .sample.swatch -side top -expand yes -fill both
pack .sample.value -side bottom -pady .25c
grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2

d150 1
a150 1
    if {$updating} {
d153 6
a158 7
    switch $colorSpace {
	rgb {
	    set red   [format %.0f [expr {[.scale1 get]*65.535}]]
	    set green [format %.0f [expr {[.scale2 get]*65.535}]]
	    set blue  [format %.0f [expr {[.scale3 get]*65.535}]]
	}
	cmy {
d162 1
a162 2
	}
	hsb {
d172 2
a173 2
    .sample.swatch config -bg $color
    if {$autoUpdate} doUpdate
d185 10
a194 12
    switch $colorSpace {
	rgb {
	    .scale1 set [format %.0f [expr {$red/65.535}]]
	    .scale2 set [format %.0f [expr {$green/65.535}]]
	    .scale3 set [format %.0f [expr {$blue/65.535}]]
	}
	cmy {
	    .scale1 set [format %.0f [expr {(65535-$red)/65.535}]]
	    .scale2 set [format %.0f [expr {(65535-$green)/65.535}]]
	    .scale3 set [format %.0f [expr {(65535-$blue)/65.535}]]
	}
	hsb {
d212 1
a212 1
	set list [winfo rgb .sample.swatch $name]
d217 3
a219 3
	switch [string length $name] {
	    4  {set format "#%1x%1x%1x"; set shift 12}
	    7  {set format "#%2x%2x%2x"; set shift 8}
d227 3
a229 3
	set red   [expr {$red<<$shift}]
	set green [expr {$green<<$shift}]
	set blue  [expr {$blue<<$shift}]
d233 2
a234 2
    .sample.swatch config -bg $color
    if {$autoUpdate} doUpdate
d243 20
a262 22
    switch $space {
	rgb {
	    set label1 "Adjust Red:"
	    set label2 "Adjust Green:"
	    set label3 "Adjust Blue:"
	    tc_setScales
	    return
	}
	cmy {
	    set label1 "Adjust Cyan:"
	    set label2 "Adjust Magenta:"
	    set label3 "Adjust Yellow:"
	    tc_setScales
	    return
	}
	hsb {
	    set label1 "Adjust Hue:"
	    set label2 "Adjust Saturation:"
	    set label3 "Adjust Brightness:"
	    tc_setScales
	    return
	}
d274 2
a275 2
	set max [expr {double($red)}]
	set min [expr {double($green)}]
d277 2
a278 2
	set max [expr {double($green)}]
	set min [expr {double($red)}]
d281 5
a285 3
	set max [expr {double($blue)}]
    } elseif {$blue < $min} {
	set min [expr {double($blue)}]
d287 1
a287 1
    set range [expr {$max-$min}]
d300 1
a300 3
	    set hue [expr {($bc - $gc)/6.0}]
	} elseif {$green == $max} {
	    set hue [expr {(2 + $rc - $bc)/6.0}]
d302 5
a306 1
	    set hue [expr {(4 + $gc - $rc)/6.0}]
d309 1
a309 1
	    set hue [expr {$hue + 1.0}]
d322 1
a322 1
    set v [format %.0f [expr {65535.0*$value}]]
d326 1
a326 1
	set hue [expr {$hue*6.0}]
d331 1
a331 1
	set f [expr {$hue-$i}]
d335 6
a340 6
	switch $i {
	    0 {return "$v $t $p"}
	    1 {return "$q $v $p"}
	    2 {return "$p $v $t"}
	    3 {return "$p $q $v"}
	    4 {return "$t $p $v"}
d342 1
a342 2
	    default {error "i value $i is out of range"}
	}
a358 4

# Local Variables:
# mode: tcl
# End:
@


1.2.18.1
log
@Updates to demos
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: tcolor,v 1.2 1998/09/14 18:23:30 stanton Exp $
d84 4
a87 6
foreach i {
    /usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
    /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
    /usr/openwin/lib/X11/rgb.txt
} {
    if {![file readable $i]} {
d103 2
a104 2
	if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} {
	    .names insert end [lrange $line 3 end]
d150 1
a150 1
    if {$updating} {
d153 6
a158 7
    switch $colorSpace {
	rgb {
	    set red   [format %.0f [expr {[.scale1 get]*65.535}]]
	    set green [format %.0f [expr {[.scale2 get]*65.535}]]
	    set blue  [format %.0f [expr {[.scale3 get]*65.535}]]
	}
	cmy {
d162 1
a162 2
	}
	hsb {
d173 1
a173 1
    if {$autoUpdate} doUpdate
d185 10
a194 12
    switch $colorSpace {
	rgb {
	    .scale1 set [format %.0f [expr {$red/65.535}]]
	    .scale2 set [format %.0f [expr {$green/65.535}]]
	    .scale3 set [format %.0f [expr {$blue/65.535}]]
	}
	cmy {
	    .scale1 set [format %.0f [expr {(65535-$red)/65.535}]]
	    .scale2 set [format %.0f [expr {(65535-$green)/65.535}]]
	    .scale3 set [format %.0f [expr {(65535-$blue)/65.535}]]
	}
	hsb {
d217 3
a219 3
	switch [string length $name] {
	    4  {set format "#%1x%1x%1x"; set shift 12}
	    7  {set format "#%2x%2x%2x"; set shift 8}
d227 3
a229 3
	set red   [expr {$red   << $shift}]
	set green [expr {$green << $shift}]
	set blue  [expr {$blue  << $shift}]
d234 1
a234 1
    if {$autoUpdate} doUpdate
d243 20
a262 22
    switch $space {
	rgb {
	    set label1 Red
	    set label2 Green
	    set label3 Blue
	    tc_setScales
	    return
	}
	cmy {
	    set label1 Cyan
	    set label2 Magenta
	    set label3 Yellow
	    tc_setScales
	    return
	}
	hsb {
	    set label1 Hue
	    set label2 Saturation
	    set label3 Brightness
	    tc_setScales
	    return
	}
d274 2
a275 2
	set max [expr {double($red)}]
	set min [expr {double($green)}]
d277 2
a278 2
	set max [expr {double($green)}]
	set min [expr {double($red)}]
d281 5
a285 3
	set max [expr {double($blue)}]
    } elseif {$blue < $min} {
	set min [expr {double($blue)}]
d287 1
a287 1
    set range [expr {$max-$min}]
d300 1
a300 3
	    set hue [expr {($bc - $gc)/6.0}]
	} elseif {$green == $max} {
	    set hue [expr {(2 + $rc - $bc)/6.0}]
d302 5
a306 1
	    set hue [expr {(4 + $gc - $rc)/6.0}]
d309 1
a309 1
	    set hue [expr {$hue + 1.0}]
d322 1
a322 1
    set v [format %.0f [expr {65535.0*$value}]]
d326 1
a326 1
	set hue [expr {$hue*6.0}]
d331 1
a331 1
	set f [expr {$hue-$i}]
d335 6
a340 6
	switch $i {
	    0 {return "$v $t $p"}
	    1 {return "$q $v $p"}
	    2 {return "$p $v $t"}
	    3 {return "$p $q $v"}
	    4 {return "$t $p $v"}
d342 1
a342 2
	    default {error "i value $i is out of range"}
	}
a358 4

# Local Variables:
# mode: tcl
# End:
@


1.1
log
@Initial revision
@
text
@d10 1
a10 1
# SCCS: @@(#) tcolor 1.11 96/06/24 16:43:11
@


1.1.4.1
log
@Merged 8.0.3 changes into 8.1
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: tcolor,v 1.2 1998/09/14 18:23:30 stanton Exp $
@


