#
# 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.


set wFile ""


# 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 color255 255000000
set updating 0
set autoUpdate 0
set name ""


# The procedure below handles the "+" and "-" buttons next to
# the adjustor scales.  They just increment or decrement the
# appropriate scale value.

proc tc_inc {scale inc} {
    global wFile
    $wFile.scale$scale set [expr [$wFile.scale$scale get]+$inc]
}

# 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 wFile
    global red green blue colorSpace color color255 updating autoUpdate
    if $updating {
	return
    }
    if {$colorSpace == "rgb"} {
	set red   [format %.0f [expr [$wFile.scale1 get]*65.535]]
	set green [format %.0f [expr [$wFile.scale2 get]*65.535]]
	set blue  [format %.0f [expr [$wFile.scale3 get]*65.535]]
    } else {
	if {$colorSpace == "cmy"} {
	    set red   [format %.0f [expr {65535 - [$wFile.scale1 get]*65.535}]]
	    set green [format %.0f [expr {65535 - [$wFile.scale2 get]*65.535}]]
	    set blue  [format %.0f [expr {65535 - [$wFile.scale3 get]*65.535}]]
	} else {
	    set list [hsbToRgb [expr {[$wFile.scale1 get]/1000.0}] \
		    [expr {[$wFile.scale2 get]/1000.0}] \
		    [expr {[$wFile.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]
    set color255 [format "%3.3i%3.3i%3.3i" [expr $red*255/65535]  \
	    [expr $green*255/65535] [expr $blue*255/65535]]
    $wFile.swatch config -bg $color
    if $autoUpdate doUpdate
    update idletasks

#    $wFile.name delete 0 end
#    $wFile.name insert 0 $color
}

# 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 wFile
    global red green blue colorSpace updating
    set updating 1
    if {$colorSpace == "rgb"} {
	$wFile.scale1 set [format %.0f [expr $red/65.535]]
	$wFile.scale2 set [format %.0f [expr $green/65.535]]
	$wFile.scale3 set [format %.0f [expr $blue/65.535]]
    } else {
	if {$colorSpace == "cmy"} {
	    $wFile.scale1 set [format %.0f [expr (65535-$red)/65.535]]
	    $wFile.scale2 set [format %.0f [expr (65535-$green)/65.535]]
	    $wFile.scale3 set [format %.0f [expr (65535-$blue)/65.535]]
	} else {
	    set list [rgbToHsv $red $green $blue]
	    $wFile.scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]
	    $wFile.scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]
	    $wFile.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 colname {
    global wFile 
    global red green blue color color255 autoUpdate name

    if {[string index $colname 0] != "#"} {
	set list [winfo rgb $wFile.swatch $colname]
	set red [lindex $list 0]
	set green [lindex $list 1]
	set blue [lindex $list 2]
    } else {
	case [string length $colname] {
	    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 colname \"$colname\""}
	}
	if {[scan $colname $format red green blue] != 3} {
	    error "syntax error in color colname \"$colname\""
	}
	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]
    set color255 [format "%3.3i%3.3i%3.3i" [expr $red*255/65535]  \
	    [expr $green*255/65535] [expr $blue*255/65535]]
    $wFile.swatch config -bg $color
    if $autoUpdate doUpdate

    if { [string compare $name $colname] !=0 } {
	$wFile.name delete 0 end
	$wFile.name insert 0 $colname
    } else {
	$wFile.names select clear
	for {set i 0} {$i < [$wFile.names size]} {incr i} {
	    if { [string compare $colname [$wFile.names get $i]] == 0 } {
		$wFile.names select adjust $i
		$wFile.names  yview $i
		break
	    }
	}
    }
}

# 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 wFile
    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)}]
	    }
	}
    }
    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 color255 command
#    set newCmd $command
#    regsub -all %% $command $color newCmd
    set newCmd "$command $color255"
    eval $newCmd
}



#
#  Main Program
#

proc RamColor {{w .ramcolor} CommandToExec} {
    global wFile
    catch {destroy $w}
    toplevel $w
    wm title $w [_ "RamColor"]
    wm iconname $w "RamColor"
    wm minsize $w 100 100
    wm geometry $w +500+300

    set wFile $w

    tk_bindForTraversal $w
    focus $w
    global colorSpace red green blue color color255 updating autoUpdate name command

    set command $CommandToExec

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

    frame $wFile.menu -relief raised -borderwidth 2
    pack $wFile.menu -side top -fill x
    menubutton $wFile.menu.file -text [_ "File"] -menu $wFile.menu.file.m -underline 0
    menu $wFile.menu.file.m
    $wFile.menu.file.m add radio -label [_ "RGB color space"] -variable colorSpace \
	    -value rgb -underline 0 -command {changeColorSpace rgb}
    $wFile.menu.file.m add radio -label [_ "CMY color space"] -variable colorSpace \
	    -value cmy -underline 0 -command {changeColorSpace cmy}
    $wFile.menu.file.m add radio -label [_ "HSB color space"] -variable colorSpace \
	    -value hsb -underline 0 -command {changeColorSpace hsb}
    $wFile.menu.file.m add separator
    $wFile.menu.file.m add radio -label [_ "Automatic updates"] -variable autoUpdate \
	    -value 1 -underline 0
    $wFile.menu.file.m add radio -label [_ "Manual updates"] -variable autoUpdate \
	    -value 0 -underline 0
    $wFile.menu.file.m add separator
    $wFile.menu.file.m add command -label [_ "Exit"] -underline 0 \
	    -command "destroy $wFile"
    pack $wFile.menu.file -side left
    tk_menuBar $wFile.menu $wFile.menu.file

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

    frame $wFile.bot -relief raised -borderwidth 2
    pack $wFile.bot -side bottom -fill x
#    label $wFile.commandLabel -text "Widget to Send:"
#    entry $wFile.command -relief sunken -borderwidth 2 -textvariable command \
#	    -font -Adobe-Courier-Medium-R-Normal-*-120-*
#    label $wFile.command -relief sunken -borderwidth 2 -text $command \
#	    -font -Adobe-Courier-Medium-R-Normal-*-120-* -anchor w
    button $wFile.update -text [_ "Update"] -command doUpdate
    button $wFile.cancel -text [_ "Cancel"] -command "destroy $w"
#    pack $wFile.commandLabel -in $wFile.bot -side left
    pack $wFile.update -in $wFile.bot -side right -pady .1c -padx .25c
    pack $wFile.cancel -in $wFile.bot -side right -pady .1c -padx .25c
#    pack $wFile.command -in $wFile.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 $wFile.middle -relief raised -borderwidth 2
    pack $wFile.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} {
	if ![file readable $i] {
	    continue;
	}
	set f [open $i]
	frame $wFile.middle.left
	pack $wFile.middle.left -side left -padx .25c -pady .25c
	listbox $wFile.names -width 20 -height 12 -yscrollcommand "$wFile.scroll set" \
		-relief sunken -borderwidth 2 -exportselection false
	bind $wFile.names <ButtonRelease-1> {
	    tc_loadNamedColor [$wFile.names get [$wFile.names curselection]]
	}
	scrollbar $wFile.scroll -orient vertical -command "$wFile.names yview" \
		-relief sunken -borderwidth 2
	pack $wFile.names -in $wFile.middle.left -side left
	pack $wFile.scroll -in $wFile.middle.left -side right -fill y
	while {[gets $f line] >= 0} {
	    if {[llength $line] == 4} {
		$wFile.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 $wFile.middle.middle
    pack $wFile.middle.middle -side left -expand yes -fill y
    frame $wFile.middle.middle.1
    frame $wFile.middle.middle.2
    frame $wFile.middle.middle.3
    frame $wFile.middle.middle.4
    pack $wFile.middle.middle.1 $wFile.middle.middle.2 $wFile.middle.middle.3 -side top -expand yes
    pack $wFile.middle.middle.4 -side top -expand yes -fill x
    foreach i {1 2 3} {
	label $wFile.label$i -textvariable label$i
	scale $wFile.scale$i -from 0 -to 1000 -length 10c -orient horizontal \
		-command tc_scaleChanged
	button $wFile.up$i -width 2 -text + -command "tc_inc $i 1"
	button $wFile.down$i -width 2 -text - -command "tc_inc $i -1"
	pack $wFile.label$i -in $wFile.middle.middle.$i -side top -anchor w
	pack $wFile.down$i -in $wFile.middle.middle.$i -side left -padx .25c
	pack $wFile.scale$i -in $wFile.middle.middle.$i -side left
	pack $wFile.up$i -in $wFile.middle.middle.$i -side left -padx .25c
    }
    label $wFile.nameLabel -text [_ "Name of color:"]
    entry $wFile.name -relief sunken -borderwidth 2 -textvariable name -width 30 \
	    -font -Adobe-Courier-Medium-R-Normal-*-120-*
    pack $wFile.nameLabel $wFile.name -in $wFile.middle.middle.4 -side left
    bind $wFile.name <Return> {tc_loadNamedColor $name}

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

    frame $wFile.middle.right
    pack $wFile.middle.right -side left -pady .25c -padx .25c -anchor s
    frame $wFile.swatch -width 2c -height 5c -background $color
    label $wFile.value -textvariable color255 -width 13 \
	    -font -Adobe-Courier-Medium-R-Normal-*-120-*
    pack $wFile.swatch -in $wFile.middle.right -side top -expand yes -fill both
    pack $wFile.value -in $wFile.middle.right -side bottom -pady .25c

    changeColorSpace hsb
}