Initial revision

1 files changed, 358 insertions, 0 deletions

diff --git a/library/demos/tcolor b/library/demos/tcolor
new file mode 100644
index 0000000..50c0e68
--- /dev/null
+++ b/library/demos/tcolor
@@ -0,0 +1,358 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# 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.
+#
+# SCCS: @(#) tcolor 1.11 96/06/24 16:43:11
+
+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.
+
+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 \
+	-value rgb -underline 0 -command {changeColorSpace rgb}
+.menu.file.m add radio -label "CMY color space" -variable colorSpace \
+	-value cmy -underline 0 -command {changeColorSpace cmy}
+.menu.file.m add radio -label "HSB color space" -variable colorSpace \
+	-value hsb -underline 0 -command {changeColorSpace hsb}
+.menu.file.m add separator
+.menu.file.m add radio -label "Automatic updates" -variable autoUpdate \
+	-value 1 -underline 0
+.menu.file.m add radio -label "Manual updates" -variable autoUpdate \
+	-value 0 -underline 0
+.menu.file.m add separator
+.menu.file.m add command -label "Exit program" -underline 0 \
+	-command "destroy ."
+pack .menu.file -side left
+
+# Create the command entry window at the bottom of the window, along
+# with the update button.
+
+frame .bot -relief raised -borderwidth 2
+pack .bot -side bottom -fill x
+label .commandLabel -text "Command:"
+entry .command -relief sunken -borderwidth 2 -textvariable command \
+	-font {Courier 12}
+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
+
+# Create the listbox that holds all of the color names in rgb.txt,
+# if an rgb.txt file can be found.
+
+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] {
+	continue;
+    }
+    set f [open $i]
+    frame .middle.left
+    pack .middle.left -side left -padx .25c -pady .25c
+    listbox .names -width 20 -height 12 -yscrollcommand ".scroll set" \
+	    -relief sunken -borderwidth 2 -exportselection false
+    bind .names <Double-1> {
+	    tc_loadNamedColor [.names get [.names curselection]]
+    }
+    scrollbar .scroll -orient vertical -command ".names yview" \
+	    -relief sunken -borderwidth 2
+    pack .names -in .middle.left -side left
+    pack .scroll -in .middle.left -side right -fill y
+    while {[gets $f line] >= 0} {
+	if {[llength $line] == 4} {
+	    .names insert end [lindex $line 3]
+	}
+    }
+    close $f
+    break
+}
+
+# Create the three scales for editing the color, and the entry for
+# typing in a color value.
+
+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
+foreach i {1 2 3} {
+    label .label$i -textvariable label$i
+    scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
+	    -command tc_scaleChanged
+    pack .scale$i .label$i -in .middle.middle.$i -side top -anchor w
+}
+label .nameLabel -text "Name:"
+entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \
+	-font {Courier 12}
+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}
+
+# Create the color display swatch on the right side of the window.
+
+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
+
+# 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
+    }
+    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"} {
+	    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}]]
+	} else {
+	    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]
+    .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
+    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 {
+	    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 .swatch $name]
+	set red [lindex $list 0]
+	set green [lindex $list 1]
+	set blue [lindex $list 2]
+    } else {
+	case [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]
+    .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
+    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
+    }
+}
+
+# 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 $red.0
+	set min $green.0
+    } else {
+	set max $green.0
+	set min $red.0
+    }
+    if {$blue > $max} {
+	set max $blue.0
+    } else {
+	if {$blue < $min} {
+	    set min $blue.0
+	}
+    }
+    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 {.166667*($bc - $gc)}]
+	} else {
+	    if {$green == $max} {
+		set hue [expr {.166667*(2 + $rc - $bc)}]
+	    } else {
+		set hue [expr {.166667*(4 + $gc - $rc)}]
+	    }
+	}
+	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)))}]]
+	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"} \
+	    5 {return "$v $p $q"}
+	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