#! /usr/bin/wish -f

## ColorSwitch is a TkDesk color configuration utility by Lionel Kirsher.
## Copyright (C) 1999  Lionel Kirsher  (kirsherATyahoo.com)

## This program is free software. 
## The author of this program disclaims all responsibility.
 

###############################
##
##	The "setsDirectory" contains  the following:
##		- The file "ACTIVE_colorset"  (necessary)
##		- Alternate color set files (optional)
##		
##	The full path to the "ACTIVE_colorset" file must be  
##	given in the "source" command at the start of the 
##	"Color Settings" section of you "~/.tkdesk/System" file.
##	If you change the location of the setsDirectory (here),
##	you must also correct the System file. 
##
##	The "homeDirectory" should contain the following:
##		- ColorSwitch (executable)
##		- README
##		- ColorSwitch_HELP
##################

set setsDirectory ~/.tkdesk/ColorSets
set homeDirectory /usr/local/share/ColorSwitch

##################
##  The following array provides the feature descriptions
##################

array set FeatureDescriptions {
	a_BGcolor "Basic Background"
	b_FGcolor "Basic Foreground"
	c_INfocus "Focus Rectangle On"
	d_OUTfocus "Focus Rectangle Off"
	e_BGlist "Listbox Background"
	f_SELECTlist "Listbox Selection"
	g_Xbox "Checkbox Enabled"
	h_BGtext "Text Background"
	i_FGtext "Text Foreground"
	j_BGentry "Entry Field Background"
	k_FGentry "Entry Text Foreground"
	l_INSERTtext "Insertion Cursor"
	m_SELtextFG "Text Selection Foreground"
	n_SELtextBG "Text Selection Background"
	o_DDcursor "Drag-n-Drop Cursor"
	p_NoteColor "Annotation Color"
	}


##################
##  The following array provides default color assignments.
##  Subsequent sourcing of the "ACTIVE_colorset" file should
##  override these settings. IF you get these colors (red on blue)
##  in ColorSwitch, you'll know there was a problem sourcing the
## "ACTIVE_colorset" file.
##################

array set ColorValues {
	a_BGcolor #3333FF
	b_FGcolor #FF3333
	c_INfocus #ffec8b
	d_OUTfocus #838b83
	e_BGlist #a0cda4
	f_SELECTlist #ea847e
	g_Xbox #005151
	h_BGtext #005151
	i_FGtext #f0fff0
	j_BGentry #005151
	k_FGentry #f0fff0		
	l_INSERTtext #ffc125
	m_SELtextFG #000000
	n_SELtextBG #59df8e
	o_DDcursor #ffc125
	p_NoteColor #9c4426
	}
	
source $setsDirectory/ACTIVE_colorset

set setColor #6e7b8b

#######################

wm withdraw . 
set w .colorswitch
catch {destroy $w}
toplevel $w -background #a0a0a0
wm title $w "ColorSwitch"
wm iconname $w "ColorSwitch"


################..........Build the Widgets........

frame $w.body -background #a0a0a0 
pack $w.body -side left -anchor n -ipady 5 -padx 10 -fill x

frame $w.body.buttons -background #a0a0a0 
pack $w.body.buttons -side top -anchor w



button $w.body.buttons.save -text "Save Set" -background #a0a0a0 \
	-activebackground #707075 -activeforeground #a0a0a0 -command "okay" 
	
button $w.body.buttons.load -text "Open Set" -command "loadset" \
	-background #a0a0a0 -activebackground #707075 -activeforeground #a0a0a0  
	
pack $w.body.buttons.save $w.body.buttons.load -side left -padx 5 -pady 5 -anchor w

button $w.body.buttons.help -text "?" -command "helptext" -relief flat \
	-highlightthickness 0 -background #a0a0a0 -activebackground #a0a0a0 
	
pack $w.body.buttons.help -side left -pady 5 -padx 12 -anchor e





button $w.body.buttons.names -text ">>" -command "showNames" -relief flat \
	-highlightthickness 0 -background #a0a0a0 -activebackground #a0a0a0 
	
pack $w.body.buttons.names -side left -pady 5 -padx 5  -anchor e



frame $w.body.left -background #a0a0a0
pack $w.body.left -side top -anchor w -padx 5

set cc $w.body.left.textframe
text $cc -spacing2 .38c -yscrollcommand "$w.body.left.scroll set" \
	-width 35 -height 20 -highlightcolor #000000 \
	-highlightbackground #000000 -cursor left_ptr \
	-state disabled
pack $cc -side left -anchor n -expand 0

scrollbar $w.body.left.scroll -command "$cc yview" -troughcolor #6a6a6a \
	-highlightcolor #000000 -highlightbackground #000000 \
	-background #999999 -activebackground #707075 -width 12
pack $w.body.left.scroll -side left -fill y

set sortedFeatures [lsort [array names ColorValues]]



foreach item $sortedFeatures {
	set thisColor $ColorValues($item)
	frame $cc.frame$item
	canvas $cc.frame$item.cv -height 32 -width 56
	pack $cc.frame$item.cv -side left -padx 5
	
	$cc.frame$item.cv create rectangle 0 0 56 32 -fill $thisColor -tags swatch
	$cc.frame$item.cv bind swatch <Button-2> "replaceThis %W"
	$cc.frame$item.cv bind swatch <Button-1> "getThis %W"
	$cc.frame$item.cv bind swatch <Double-1> "changeColor %W"
	
	entry $cc.frame$item.en -exportselection 1 \
		-font -*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-* \
		-relief flat

	pack $cc.frame$item.en -side bottom -anchor w
	
	$cc.frame$item.en insert end $thisColor

	bind $cc.frame$item.en <Return> "applyEntry %W"

	label $cc.frame$item.label -text $FeatureDescriptions($item)
	pack $cc.frame$item.label -side top -anchor w
	$cc window create end -window $cc.frame$item
}

################ 


button $w.body.close -text "Exit" -command "destroy ." \
	-background #a0a0a0 -activebackground #707075 \
	-activeforeground #a0a0a0 -highlightthickness 0
pack $w.body.close -side right -pady 5 -padx 9 -anchor n



################..........Procedures.........................

proc changeColor {home} {
	global cc setColor
	set thisLabel [string trimright $home cv]en
	$thisLabel selection range 0 end
	while {1} {
	    	set setColor [tk_chooseColor -initialcolor [selection get]]
	   	if {$setColor == ""} {break}
		set caller [string trimright $home .cv]
		updateArray $caller
		updateMessage $caller
		updateSwatch $caller
		break
	}
}


proc applyEntry {home} {
	global cc setColor
	set thisColor [$home get]
		
	## abort on invalid color and restore previous (valid) color

	set setColor $thisColor
	set caller [string trimright $home .en]
	updateArray $caller
	updateSwatch $caller
}	


		
	
proc getThis {home} {
	global cc setColor 
	set this [string trimright $home cv]en 
	$this selection range 0 end
	set setColor [selection get]
	focus $this
}

		
proc replaceThis {home} {
	global cc setColor 
	set caller [string trimright $home .cv]   
	updateArray $caller
	updateMessage $caller
	updateSwatch $caller

	focus [subst $caller].en
}


proc updateMessage {home} {
	global cc setColor ColorValues
	set feature [string range $home 38 end]
	set thisLabel [subst $home].en
	$thisLabel delete 0 end
	$thisLabel insert end $ColorValues($feature)
	$thisLabel selection range 0 end
	selection get
}


proc updateSwatch {home} {
	global cc setColor ColorValues
	set feature [string range $home 38 end]
	[subst $home].cv itemconfigure swatch -fill $ColorValues($feature)
}
		


proc updateArray {home} {
	global cc setColor ColorValues
				
	array set ColorValues [list \
		[string range $home 38 end ] $setColor]
}


	
proc okay {} {
	global ColorValues cc setsDirectory

	set filename [tk_getSaveFile -initialdir $setsDirectory \
		-initialfile ACTIVE_colorset]
	if {$filename == ""} {return}
	set output [open $filename w]
	puts $output "#   This file is output by ColorSwitch, a utility"
	puts $output "#   for configuring the colors of TkDesk."
	puts $output "#"
	puts $output "#   version 0.2"
	puts $output "##################################################"
	puts $output "\n\n"
	

	
	foreach item [array names ColorValues] {
		puts $output "set $item $ColorValues($item)"
		}
	puts $output "##################################################"
	puts $output "\n\n"
	
		set arrayContents [array get ColorValues]	
	puts $output "array set ColorValues [list $arrayContents]"
	
	flush $output
	close $output
}
	
	
	
	
	

	
proc loadset {} {
	global cc setsDirectory ColorValues
	
	set loadfile [tk_getOpenFile -initialdir $setsDirectory]
	if {$loadfile == ""} {return}
	source $loadfile
	
	foreach item [array names ColorValues] {
			set setColor $ColorValues($item)
			set home $cc.frame$item
			updateMessage $home
			updateSwatch $home
	}
}
	
	
proc helptext {} {
	global homeDirectory
	set h .helpwin
	catch {destroy $h}
	toplevel $h -background #a0a0a0
	wm title $h "ColorSwitch Help"
	
	button $h.bye -text "Done" -command "destroy $h" \
		-background #a0a0a0 -activebackground #707075 \
		-activeforeground #a0a0a0 -highlightthickness 0
	pack $h.bye -side top -anchor e -padx 10 -pady 5
	
	text $h.text_area -yscroll "$h.text_scroll set" -width 78 -height 22 \
		-wrap word -padx 15 -pady 5 -highlightcolor #000000 \
		-highlightbackground #000000 -setgrid 1
		
	scrollbar $h.text_scroll -command "$h.text_area yview" -troughcolor #6a6a6a \
		-highlightcolor #000000 -highlightbackground #000000 \
		-background #999999 -activebackground #707075 -width 12 
	
	pack $h.text_scroll -side right -fill y
	pack $h.text_area -side left -fill both -expand 1
	
	set hlpfile [open $homeDirectory/ColorSwitch_Help]	

	$h.text_area insert end [read $hlpfile] 
	close $hlpfile
}	
	
############ resetButton kills showNames and returns the show command to the button 

proc resetButton {} {
	global w
	destroy $w.right
	$w.body.buttons.names configure -text ">>" -command "showNames"
}

############ showNames builds/displays the listbox named color selector

proc showNames {} {
	global setColor w namedColors
	set setColor aquamarine4

	frame $w.right -background #a0a0a0
	pack $w.right -side left -anchor n -padx 15

	$w.body.buttons.names configure -text "<<" -command "resetButton"

	canvas $w.right.canv -width 122 -height 50 -background $setColor \
		-highlightcolor #000000 -highlightbackground #000000
	pack $w.right.canv -side top -anchor w -pady 10 

	entry $w.right.entrail -width 15 -justify center -relief flat \
		-insertbackground $setColor \
		-background $setColor -exportselection 1 \
		-highlightcolor $setColor -highlightbackground $setColor
	
	$w.right.canv create window 62 25 -window $w.right.entrail 

	focus $w.right.entrail
	bind $w.right <Enter> "focus $w.right.entrail"

	scrollbar $w.right.scroll -command "$w.right.list yview" \
 		-troughcolor #6a6a6a -highlightcolor #000000 \
 		-highlightbackground #000000 \
 		-background #999999 -activebackground #707075 -width 12
	
	listbox $w.right.list -yscroll "$w.right.scroll set" \
		-width 14 -height 15 -setgrid 1 -highlightcolor #000000 \
		-highlightbackground #000000
	
	pack $w.right.list $w.right.scroll -side left -fill y -expand 1

	bind $w.right.list <Double-1> {
		set setColor [selection get]
		$w.right.entrail configure -background $setColor \
			-insertbackground $setColor -highlightcolor $setColor \
			-highlightbackground $setColor
		$w.right.canv configure -background $setColor
	}

	bind $w.right.entrail <Enter> {
		$w.right.entrail delete 0 end
	}
	
	bind $w.right.canv <Leave> {
		if {[$w.right.entrail get] != ""} {
			$w.right.list see \
			[lsearch [string tolower $namedColors] \
			[string tolower [$w.right.entrail get]*]]
		}
	}
	
	bind $w.right.entrail <Return> {
		if {[$w.right.entrail get] != ""} {
			$w.right.list see \
			[lsearch [string tolower $namedColors] [$w.right.entrail get]*]
			}
	}

	set namedColors \
		{AliceBlue AntiqueWhite AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 AntiqueWhite4 aquamarine aquamarine1 aquamarine2 aquamarine3 aquamarine4 azure azure1 azure2 azure3 azure4 beige bisque bisque1 bisque2 bisque3 bisque4 black BlanchedAlmond blue1 blue2 blue3 blue4 BlueViolet brown brown1 brown2 brown3 brown4 burlywood burlywood1 burlywood2 burlywood3 burlywood4 CadetBlue CadetBlue1 CadetBlue2 CadetBlue3 CadetBlue4 chartreuse chartreuse1 chartreuse2 chartreuse3 chartreuse4 chocolate chocolate1 chocolate2 chocolate3 chocolate4 coral coral1 coral2 coral3 coral4 CornflowerBlue cornsilk cornsilk1 cornsilk2 cornsilk3 cornsilk4 cyan cyan1 cyan2 cyan3 cyan4 DarkBlue DarkCyan DarkGoldenrod DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3 DarkGoldenrod4 DarkGray DarkGreen DarkGrey DarkKhaki DarkMagenta DarkOliveGreen DarkOliveGreen1 DarkOliveGreen2 DarkOliveGreen3 DarkOliveGreen4 DarkOrange DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4 DarkOrchid DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 DarkRed DarkSalmon DarkSeaGreen DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 DarkSeaGreen4 DarkSlateBlue DarkSlateGray DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 DarkSlateGray4 DarkSlateGrey DarkTurquoise DarkViolet DeepPink DeepPink1 DeepPink2 DeepPink3 DeepPink4 DeepSkyBlue DeepSkyBlue1 DeepSkyBlue2 DeepSkyBlue3 DeepSkyBlue4 DimGray DodgerBlue DodgerBlue1 DodgerBlue2 DodgerBlue3 DodgerBlue4 firebrick firebrick1 firebrick2 firebrick3 firebrick4 FloralWhite ForestGreen gainsboro GhostWhite gold gold1 gold2 gold3 gold4 goldenrod goldenrod1 goldenrod2 goldenrod3 goldenrod4 gray gray0 gray1 gray2 gray3 gray4 gray5 gray6 gray7 gray8 gray9 gray10 gray11 gray12 gray13 gray14 gray15 gray16 gray17 gray18 gray19 gray20 gray21 gray22 gray23 gray24 gray25 gray26 gray27 gray28 gray29 gray30 gray31 gray32 gray33 gray34 gray35 gray36 gray37 gray38 gray39 gray40 gray41 gray42 gray43 gray44 gray45 gray46 gray47 gray48 gray49 gray50 gray51 gray52 gray53 gray54 gray55 gray56 gray57 gray58 gray59 gray60 gray61 gray62 gray63 gray64 gray65 gray66 gray67 gray68 gray69 gray70 gray71 gray72 gray73 gray74 gray75 gray76 gray77 gray78 gray79 gray80 gray81 gray82 gray83 gray84 gray85 gray86 gray87 gray88 gray89 gray90 gray91 gray92 gray93 gray94 gray95 gray96 gray97 gray98 gray99 gray100 green green1 green2 green3 green4 GreenYellow honeydew honeydew1 honeydew2 honeydew3 honeydew4 HotPink HotPink1 HotPink2 HotPink3 HotPink4 IndianRed IndianRed1 IndianRed2 IndianRed3 IndianRed4 ivory ivory1 ivory2 ivory3 ivory4 khaki khaki1 khaki2 khaki3 khaki4 lavender LavenderBlush LavenderBlush1 LavenderBlush2 LavenderBlush3 LavenderBlush4 LawnGreen LemonChiffon LemonChiffon1 LemonChiffon2 LemonChiffon3 LemonChiffon4 LightBlue LightBlue1 LightBlue2 LightBlue3 LightBlue4 LightCoral LightCyan LightCyan1 LightCyan2 LightCyan3 LightCyan4 LightGoldenrod LightGoldenrod1 LightGoldenrod2 LightGoldenrod3 LightGoldenrod4 LightGoldenrodYellow LightGray LightGreen LightPink LightPink1 LightPink2 LightPink3 LightPink4 LightSalmon LightSalmon1 LightSalmon2 LightSalmon3 LightSalmon4 LightSeaGreen LightSkyBlue LightSkyBlue1 LightSkyBlue2 LightSkyBlue3 LightSkyBlue4 LightSlateBlue LightSlateGray LightSteelBlue LightSteelBlue1 LightSteelBlue2 LightSteelBlue3 LightSteelBlue4 LightYellow LightYellow1 LightYellow2 LightYellow3 LightYellow4 LimeGreen linen magenta magenta1 magenta2 magenta3 magenta4 maroon maroon1 maroon2 maroon3 maroon4 MediumAquamarine MediumBlue MediumOrchid MediumOrchid1 MediumOrchid2 MediumOrchid3 MediumOrchid4 MediumPurple MediumPurple1 MediumPurple2 MediumPurple3 MediumSeaGreen MediumSlateBlue MediumSpringGreen MediumTurquoise MediumVioletRed MidnightBlue MintCream MistyRose MistyRose1 MistyRose2 MistyRose3 MistyRose4 moccasin NavajoWhite NavajoWhite1 NavajoWhite2 NavajoWhite3 NavajoWhite4 navy NavyBlue OldLace OliveDrab OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 orange orange1 orange2 orange3 orange4 OrangeRed OrangeRed1 OrangeRed2 OrangeRed3 OrangeRed4 orchid orchid1 orchid2 orchid3 orchid4 PaleGoldenrod PaleGreen PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 PaleTurquoise PaleTurquoise1 PaleTurquoise2 PaleTurquoise3 PaleTurquoise4 PaleVioletRed PaleVioletRed1 PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 PapayaWhip PeachPuff PeachPuff1 PeachPuff2 PeachPuff3 PeachPuff4 peru pink pink1 pink2 pink3 pink4 plum plum1 plum2 plum3 plum4 PowderBlue purple purple purple1 purple2 purple3 purple4 red red1 red2 red3 red4 RosyBrown RosyBrown1 RosyBrown2 RosyBrown3 RosyBrown4 RoyalBlue RoyalBlue1 RoyalBlue2 RoyalBlue3 RoyalBlue4 SaddleBrown salmon salmon1 salmon2 salmon3 salmon4 SandyBrown SeaGreen SeaGreen1 SeaGreen2 SeaGreen3 SeaGreen4 seashell seashell1 seashell2 seashell3 seashell4 sienna sienna1 sienna2 sienna3 sienna4 SkyBlue SkyBlue1 SkyBlue2 SkyBlue3 SkyBlue4 SlateBlue SlateBlue1 SlateBlue2 SlateBlue3 SlateBlue4 SlateGray SlateGray1 SlateGray2 SlateGray3 SlateGray4 SlateGrey snow snow1 snow2 snow3 snow4 SpringGreen SpringGreen1 SpringGreen2 SpringGreen3 SpringGreen4 SteelBlue SteelBlue1 SteelBlue2 SteelBlue3 SteelBlue4 tan tan1 tan2 tan3 tan4 thistle thistle1 thistle2 thistle3 thistle4 tomato tomato1 tomato2 tomato3 tomato4 turquoise turquoise turquoise1 turquoise2 turquoise3 turquoise4 violet VioletRed VioletRed1 VioletRed2 VioletRed3 VioletRed4 wheat wheat1 wheat2 wheat3 wheat4 white WhiteSmoke yellow yellow1 yellow2 yellow3 yellow4 YellowGreen}


	foreach oneColor $namedColors {
		$w.right.list insert end $oneColor
	}

}         ;# End of showNames procedure



