#!/usr/local/bin/wish -f

#
# This application 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.
#
# Stolen right from the Tk distribution.  94/07/21
#
# Modified by Stephen O. Lidie, Lehigh University Computing Center, 94/07/24.  lusol@Lehigh.EDU
#   and ...
# Michael D. Moore, mdm@cis.ohio-state.edu.
#
# This is a general purpose stand-alone application that can be used by any application requiring a color editor.  It supports
# all standard Tk color attributes and provides a default color configurator.  It is also rather customizable so you can use
# your own color configuration procedure, and add/delete color attributes from the Color menu.
#
# The Tk `send' command is required.
#

if { $argc != 2 } {
    wm withdraw .
    tk_dialog .help "Color Editor Usage Error" "Usage:  $argv0 appName cursor" error 0 OK
    exit 1
}

#
# Where:
#   
#   appName     = application name of caller, used to `send' commands back.
#   cursor      = cursor to use over "hot" widgets, in a format suitable for
#                 the -cursor configuration option.
#
# For examnple:
#
#    #
#    # Start/resume a color editor so the user can change various application colors.  Then send
#    # `color_editor' the window in our application to update, and de-iconify `color_editor'.
#    #
#
#    global LIBDIR cursor color_editor_pid Tk_ColorEditorApplicationName
#
#    if { $color_editor_pid == "" } {
#	set color_editor_pid [exec ${LIBDIR}/color_editor [winfo name .] $cursor &]
#	tkwait variable Tk_ColorEditorApplicationName
#    }
#
#    send $Tk_ColorEditorApplicationName "set window .; wm deiconify ."
#    
# There are a few items worth noting:
#
#  . Save the PID of the `color_editor' process so it can be terminated later.
#  . Wait for the global variable "Tk_ColorEditorApplicationName" in your application to change; it's set via `color_editor'
#    using a `send' command.  You need this name to send further configuration information, and only `color_editor' knows its
#    own application name.
#  . Update this global variable in `color_editor' using `send' as shown:
#
#        window           The window to recursively update in your application.
#
#  . De-iconify `color_editor' using `send' as shown.
#
# And don't forget to kill `color_editor' upon program exit:
#
#    if { $color_editor_pid != "" } {
#        catch {exec kill $color_editor_pid}
#    }
#
# Color Editor Customization
#
# `color_editor' provides menu selections for all standard Tk color attributes, and installs a default color configurator
# into your application's interpreter.  If the application has special needs, like new color attributes, removing standard
# color attributes from the `color_editor' menu, or a special color configurator, then you must supply a procedure in your
# application named "Tk_ConfigureApplicationColorHooks".  This procedure returns a list of command/value pairs; the current
# options are:
#
#    {add newColorAttribute}                     - The `add' command adds new color attributes to the menu.  If the value is
#                                                  "SEP" then a menu separator item is added.
#    {apply newColorApplyCommand}                - The name of the Tcl procedure to envoke when clicking the Apply button.
#    {delete sliderforeground}                   - The `delete' command deletes color attributes from the menu, in this case
#                                                  the application has no widgets with a sliderforeground attribute.  If the
#                                                  value is "Tk_ConfigureApplicationColorStatus" then the status window is
#                                                  not displayed.
#
# For example:
#
#    proc Tk_ConfigureApplicationColorHooks {} {
#
#        return { {add SEP} {add articleForeground} {apply configure_tknews_colors} {delete disabledforeground} }
#
#    }; # end Tk_ConfigureApplicationColorHooks
#
# Here the menu item disabledforeground is deleted from the menu, a new menu separator and color attribute articleForeground
# are added, and the special color configurator command `configure_tknews_colors' replaces Tk_ConfigureApplicationColors.
#


tk_bindForTraversal .
wm withdraw .
toplevel .t
wm geometry .t +0+0
wm title .t " "
message .t.m -text "Initializing Color Editor ..." -aspect 800
pack .t.m -in .t
update

# Here is the procedure `Tk_ConfigureApplicationColors' which gets registered in the caller's interpreter via `send'.

set Tk_ConfigureApplicationColors_proc \
{proc Tk_ConfigureApplicationColors {win type color} {

    #
    # Recursively descend the widget tree $win and configure the attribute $type for color $color.
    #
    # If $color == UseWidgetDefaultColor then reset all colors to the Tk defaults.
    #

    if { $win == ".tk_ConfigureApplicationColors" } {
	return; # ignore status window
    }

    global Tk_ConfigureApplicationColorStatus

    set reset [expr { ($color == "UseWidgetDefaultColor") ? 1 : 0 }]

    if { $Tk_ConfigureApplicationColorStatus } {
	set destroy_win ""
	if { ! [winfo exists .tk_ConfigureApplicationColors] } {
	    toplevel .tk_ConfigureApplicationColors
	    wm geometry .tk_ConfigureApplicationColors +0+0
	    label .tk_ConfigureApplicationColors.l -width 50 -anchor w
	    pack .tk_ConfigureApplicationColors.l -in .tk_ConfigureApplicationColors -side top
	    set destroy_win $win
	}
	wm title .tk_ConfigureApplicationColors "Configure $type"
	.tk_ConfigureApplicationColors.l configure -text "WIDGET:  $win"
	update
    } 

    foreach child [winfo children $win] {
	
	switch -regexp [winfo class $child] {

	    {^Button|Canvas|Checkbutton|Entry|Frame|Label|Listbox|Menu|Menubutton|Message|Radiobutton|Scale|Scrollbar|Text|Toplevel$} {
		if { $reset } {
		    catch {set color [lindex [$child configure -${type}] 3]}
		}
		catch {$child configure -${type} $color}
	    }

	}; # switchend

	Tk_ConfigureApplicationColors $child $type $color; # configure kids

    }; # forend all child widgets

    if { $Tk_ConfigureApplicationColorStatus } {
	if { $destroy_win == $win } {
	    destroy .tk_ConfigureApplicationColors
	}
    }

}; # end Tk_ConfigureApplicationColors
}

# Get command line parameters, then configure the calling application.  After that, see if any "color hooks" are defined.

set appname [lindex $argv 0]
set cursor [lindex $argv 1]

send $appname "set Tk_ConfigureApplicationColorStatus 1; set Tk_ColorEditorApplicationName \"[winfo name .]\""
catch {set color_hooks [send $appname Tk_ConfigureApplicationColorHooks]}

# 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.
# window -			Holds the application window to update.
# name -			Name for new color, typed into entry.
# highlight_list -              list of color attributes
# applyProc -                   name of color configurator

global colorSpace label1 label2 label3 red green blue color updating window name cursor applyProc

set colorSpace hsb
set red 65535
set green 0
set blue 0
set color #ffff00000000
set updating 0
set name ""
set highlight_list {foreground background SEP activeforeground activebackground SEP selectforeground selectbackground SEP \
    disabledforeground insertbackground selector sliderforeground}
set applyProc ""

# Create the menu bar at the top of the window for the File and Colors menubuttons.

frame .menu -relief raised -borderwidth 2
pack .menu -side top -fill x
menubutton .menu.file   -text File           -menu .menu.file.m   -underline 0 -cursor $cursor -bd 1 -relief raised
menu .menu.file.m
set close_command {wm withdraw .; return}
.menu.file.m add command -label Close -underline 0 -command "$close_command" -accelerator "Ctrl-w"
bind . <Control-Key-w> "$close_command"

menubutton .menu.colors -text Colors        -menu .menu.colors.m -underline 0 -cursor $cursor -bd 1 -relief raised
menu .menu.colors.m
.menu.colors.m add cascade -label "Color Attributes" -underline 6 -menu .menu.colors.m.color_attributes
menu .menu.colors.m.color_attributes

# Create the default color attributes.

foreach highlight $highlight_list {
    if { $highlight == "SEP" } {
	.menu.colors.m.color_attributes add separator
    } else {
	.menu.colors.m.color_attributes add command -label "$highlight" \
	    -command "wm title . \"$highlight Color Editor\"; set highlight \"$highlight\""
    }
}

# Process color hooks now:  add new menu entries, delete those not required and/or define a new color Apply processor.
# If no Apply processor is defined, install our default, Tk_ConfigureApplicationColors, in the caller's interpreter.
# As menu items are deleted, update $highlight_list by removing them.

if { [info exists color_hooks] } {
    foreach hook $color_hooks {
	set e0 [lindex $hook 0]
	set e1 [lindex $hook 1]
	switch -exact $e0 {
	    {add} {
		if { $e1 == "SEP" } {
		    .menu.colors.m.color_attributes add separator
		} else {
		    .menu.colors.m.color_attributes add command -label "$e1" \
			-command "wm title . \"$e1 Color Editor\"; set highlight \"$e1\""
		}
	    }
	    {apply} {
		set applyProc $e1
	    }
	    {delete} {
		if { "$e1" == "Tk_ConfigureApplicationColorStatus" } {
		    send $appname "set Tk_ConfigureApplicationColorStatus 0"
		} else {
		    .menu.colors.m.color_attributes delete "$e1"
		    set list_ord [lsearch -exact "$highlight_list" "$e1"]
		    if { $list_ord != -1 } {
			set highlight_list [lreplace $highlight_list $list_ord $list_ord]
		    }
		}
	    }
	    {default} {
		tk_dialog .help "Color Editor Hook Error" "Unknown color hook command:  \"$hook\"" error 0 OK
	    }
	}; # switchend
    }; # forend color_hooks
}; # ifend color_hooks

if { $applyProc == "" } {
    set applyProc "Tk_ConfigureApplicationColors"
    send $appname $Tk_ConfigureApplicationColors_proc
}

set highlight foreground
wm title . "$highlight Color Editor"
.menu.colors.m add separator
.menu.colors.m add cascade -label "Color Spaces" -underline 6 -menu .menu.colors.m.color_spaces
menu .menu.colors.m.color_spaces
.menu.colors.m.color_spaces add radio -label "RGB color space" -variable colorSpace \
    -value rgb -underline 0 -command {changeColorSpace rgb}
.menu.colors.m.color_spaces add radio -label "CMY color space" -variable colorSpace \
    -value cmy -underline 0 -command {changeColorSpace cmy}
.menu.colors.m.color_spaces add radio -label "HSB color space" -variable colorSpace \
    -value hsb -underline 0 -command {changeColorSpace hsb}
.menu.colors.m add separator
.menu.colors.m add command -label "Apply Default Colors" -underline 6 -command {reset_all_colors}
pack .menu.file -side left
pack .menu.colors -side left
tk_menuBar .menu .menu.file .menu.colors

# Create the apply button.

frame .bot -relief raised -borderwidth 2
pack .bot -side bottom -fill x
button .update -text Apply -command {doUpdate} -cursor $cursor
pack .update -in .bot -side left -pady 1 -padx 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 /usr/local/X11R5/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 .middle.left
	pack .middle.left -side left -padx .25c -pady .25c
	listbox .names -geometry 20x12 -yscrollcommand ".scroll set" \
	    -relief sunken -borderwidth 2 -exportselection false
	tk_listboxSingleSelect .names
	bind .names <Double-1> {tc_loadNamedColor [.names get [.names curselection]]}
	scrollbar .scroll -orient vertical -command ".names yview" -cursor $cursor \
	    -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 10c -orient horizontal -command tc_scaleChanged -cursor $cursor
    button .up$i -width 2 -text + -command "tc_inc $i 1" -cursor $cursor
    button .down$i -width 2 -text - -command "tc_inc $i -1" -cursor $cursor
    pack .label$i -in .middle.middle.$i -side top -anchor w
    pack .down$i -in .middle.middle.$i -side left -padx .25c
    pack .scale$i -in .middle.middle.$i -side left
    pack .up$i -in .middle.middle.$i -side left -padx .25c
}
label .nameLabel -text "Name of new color:"
entry .name -relief sunken -borderwidth 2 -textvariable name -width 30 \
    -font -Adobe-Courier-Medium-R-Normal-*-120-*
pack .nameLabel .name -in .middle.middle.4 -side left
bind .name <Return> {tc_loadNamedColor $name}

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

frame .middle.right -bg black -bd 1
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 -Adobe-Courier-Medium-R-Normal-*-120-*
pack .swatch -in .middle.right -side top -expand yes -fill both
pack .value -in .middle.right -side bottom -pady 1

# 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} {
    .scale$scale set [expr [.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 red green blue colorSpace color updating
    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
    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

    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
}

# 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)}]
	    }
	}
    }
    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"
    }
}


proc reset_all_colors {} {

    global highlight_list appname applyProc

    foreach highlight $highlight_list {
	if { $highlight != "SEP" } {
	    send $appname "$applyProc . $highlight UseWidgetDefaultColor"
	}
    }

}; # end reset_all_colors


proc doUpdate {} {

    global color window appname highlight applyProc
    if { $window == "" || $highlight == "" || $color == "" } {
	return
    }
    send $appname "$applyProc $window $highlight $color"
}

destroy .t
changeColorSpace hsb
wm deiconify .
