##	DefineColor
##	(Momo procedure)
#	Define foreground and background Color of all widgets
##
##	k.ohtubo(Tubocky)
##
##	1997.3.16
##	Tcl/Tk version 8.0
##	1998 July 5 GEANT4 Beta-01

proc Define_Color {} {
	global env  FC FR FG FB  BC BR BG BB

	if {![info exists FC]} {
		if {[lsearch [array name env] FORE_GROUND_COLOR] >= 0} {
			set FC $env(FORE_GROUND_COLOR)
			Reset_Color F
		}
	}

	if {![info exists BC]} {
		if {[lsearch [array name env] BACK_GROUND_COLOR] >= 0} {
			set BC $env(BACK_GROUND_COLOR)
			Reset_Color B
		}
	}

	if [winfo exists .dc] {
		raise .dc
		return
	}

	toplevel .dc -highlightthickness 0
	wm title .dc "Define Colors"

	frame .dc.butt -highlightthickness 0
	pack .dc.butt -side top -fill x

	button .dc.butt.change -text "Change Color" -bd 3 \
		-highlightthickness 0 \
		-command {
			Change_Color $FC $BC .
			set env(FORE_GROUND_COLOR) $FC
			set env(BACK_GROUND_COLOR) $BC
			if [winfo exists .cf] {
				Change_Color $FC $BC .cf
			}
			if [winfo exists .se] {
				Change_Color $FC $BC .se
				Put_Env
			}
			Make_Color .dc.fg.main.color
			Make_Color .dc.bg.main.color
		}
	pack .dc.butt.change -side left

	button .dc.butt.default -text Default -bd 3 -highlightthickness 0 \
		-command {
			set FR 0
			set FG 0
			set FB 0
			Make_Color .dc.fg.main.color
			set BR 0.848
			set BG 0.848
			set BB 0.848
			Make_Color .dc.bg.main.color
		}
	pack .dc.butt.default -side left

	button .dc.butt.cancel -text Cancel -bd 3 -highlightthickness 0 \
		-command {
			destroy .dc
		}
	pack .dc.butt.cancel -side left

	frame .dc.space -height 10 -highlightthickness 0
	pack .dc.space -side top


	frame .dc.fg -highlightthickness 0
	pack .dc.fg -side top -fill both


	frame .dc.fg.input -relief raised -bd 1 -highlightthickness 0
	pack .dc.fg.input -side top -fill x

	label .dc.fg.input.label -text Foreground: -highlightthickness 0
	pack .dc.fg.input.label -side left

	entry .dc.fg.input.ent -textvariable FC -state disabled -relief flat \
		 -highlightthickness 0
	pack .dc.fg.input.ent -side left -fill x -expand 1


	frame .dc.fg.main -relief raised -bd 1 -highlightthickness 0
	pack .dc.fg.main -side top -fill x


	frame .dc.fg.main.color -relief sunken -bd 1 -width 70 -height 40 \
		-highlightthickness 0
	pack .dc.fg.main.color -side left -padx 20 -pady 10


	frame .dc.fg.main.scale -highlightthickness 0
	pack .dc.fg.main.scale -side left -fill x -expand 1


	frame .dc.fg.main.scale.r -highlightthickness 0
	pack .dc.fg.main.scale.r -side top -fill x -expand 1

	label .dc.fg.main.scale.r.label -text R -anchor w \
		-highlightthickness 0
	pack .dc.fg.main.scale.r.label -side left

	entry .dc.fg.main.scale.r.ent -width 5 -relief flat \
		-textvariable FR -highlightthickness 0
	pack .dc.fg.main.scale.r.ent -side left

	scale .dc.fg.main.scale.r.scale -from 0 -to 1 -resolution 0.01 \
		-variable FR -orient horizontal -showvalue false \
		-activebackground #fff000000 -troughcolor #bcd000000 \
		-command {Make_Color .dc.fg.main.color} \
		-highlightthickness 0
	pack  .dc.fg.main.scale.r.scale -side left -fill x -expand 1


	frame .dc.fg.main.scale.g -highlightthickness 0
	pack .dc.fg.main.scale.g -side top -fill x -expand 1

	label .dc.fg.main.scale.g.label -text G -anchor w \
		-highlightthickness 0
	pack .dc.fg.main.scale.g.label -side left

	entry .dc.fg.main.scale.g.ent -width 5 -relief flat \
		-textvariable FG -highlightthickness 0
	pack .dc.fg.main.scale.g.ent -side left

	scale .dc.fg.main.scale.g.scale -from 0 -to 1 -resolution 0.01 \
		-variable FG -orient horizontal -showvalue false \
		-activebackground #000fff000 -troughcolor #000bcd000 \
		-command {Make_Color .dc.fg.main.color} \
		-highlightthickness 0
	pack .dc.fg.main.scale.g.scale -side left -fill x -expand 1


	frame .dc.fg.main.scale.b -highlightthickness 0
	pack .dc.fg.main.scale.b -side top -fill x -expand 1

	label .dc.fg.main.scale.b.label -text B -anchor w \
		-highlightthickness 0
	pack .dc.fg.main.scale.b.label -side left

	entry .dc.fg.main.scale.b.ent -width 5 -relief flat \
		-textvariable FB -highlightthickness 0
	pack .dc.fg.main.scale.b.ent -side left

	scale .dc.fg.main.scale.b.scale -from 0 -to 1 -resolution 0.01 \
		-variable FB -orient horizontal -showvalue false \
		-activebackground #000000fff -troughcolor #000000bcd \
		-command {Make_Color .dc.fg.main.color} \
		-highlightthickness 0
	pack .dc.fg.main.scale.b.scale -side left -fill x -expand 1


	frame .dc.between -height 10 -highlightthickness 0
	pack .dc.between -side top -fill x


	frame .dc.bg -highlightthickness 0
	pack .dc.bg -side top -fill both


	frame .dc.bg.input -relief raised -bd 1 -highlightthickness 0
	pack .dc.bg.input -side top -fill x

	label .dc.bg.input.label -text Background: -highlightthickness 0
	pack .dc.bg.input.label -side left

	entry .dc.bg.input.ent -textvariable BC -state disabled \
		-relief flat -highlightthickness 0
	pack .dc.bg.input.ent -side left -fill x -expand 1


	frame .dc.bg.main -relief raised -bd 1 -highlightthickness 0
	pack .dc.bg.main -side top -fill x


	frame .dc.bg.main.color -relief sunken -bd 1 -width 70 -height 40 \
		-highlightthickness 0
	pack .dc.bg.main.color -side left -padx 20 -pady 10


	frame .dc.bg.main.scale -highlightthickness 0
	pack .dc.bg.main.scale -side left -fill x -expand 1


	frame .dc.bg.main.scale.r -highlightthickness 0
	pack .dc.bg.main.scale.r -side top -fill x -expand 1

	label .dc.bg.main.scale.r.label -text R -anchor w \
		-highlightthickness 0
	pack .dc.bg.main.scale.r.label -side left

	entry .dc.bg.main.scale.r.ent -width 5 -relief flat \
		-textvariable BR -highlightthickness 0
	pack .dc.bg.main.scale.r.ent -side left

	scale .dc.bg.main.scale.r.scale -from 0 -to 1 -resolution 0.01 \
		-variable BR -orient horizontal -showvalue false \
		-activebackground #fff000000 -troughcolor #bcd000000 \
		-command {Make_Color .dc.bg.main.color} \
		-highlightthickness 0
	pack .dc.bg.main.scale.r.scale -side left -fill x -expand 1


	frame .dc.bg.main.scale.g -highlightthickness 0
	pack .dc.bg.main.scale.g -side top -fill x -expand 1

	label .dc.bg.main.scale.g.label -text G -anchor w \
		-highlightthickness 0
	pack .dc.bg.main.scale.g.label -side left

	entry .dc.bg.main.scale.g.ent -width 5 -relief flat \
		-textvariable BG -highlightthickness 0
	pack .dc.bg.main.scale.g.ent -side left

	scale .dc.bg.main.scale.g.scale -from 0 -to 1 -resolution 0.01 \
		-variable BG -orient horizontal -showvalue false \
		-activebackground #000fff000 -troughcolor #000bcd000 \
		-command {Make_Color .dc.bg.main.color} \
		-highlightthickness 0
	pack .dc.bg.main.scale.g.scale -side left -fill x -expand 1


	frame .dc.bg.main.scale.b -highlightthickness 0
	pack .dc.bg.main.scale.b -side top -fill x -expand 1

	label .dc.bg.main.scale.b.label -text B -anchor w \
		-highlightthickness 0
	pack .dc.bg.main.scale.b.label -side left

	entry .dc.bg.main.scale.b.ent -width 5 -relief flat \
		-textvariable BB -highlightthickness 0
	pack .dc.bg.main.scale.b.ent -side left

	scale .dc.bg.main.scale.b.scale -from 0 -to 1 -resolution 0.01 \
		-variable BB -orient horizontal -showvalue false \
		-activebackground #000000fff -troughcolor #000000bcd \
		-command {Make_Color .dc.bg.main.color} \
		-highlightthickness 0
	pack .dc.bg.main.scale.b.scale -side left -fill x -expand 1


#	Binding
	foreach BIND {Return Tab Down Control-n} {
		bind .dc.fg.main.scale.r.ent <$BIND> {
			focus .dc.fg.main.scale.g.ent
		}
		bind .dc.fg.main.scale.g.ent <$BIND> {
			focus .dc.fg.main.scale.b.ent
		}
		bind .dc.fg.main.scale.b.ent <$BIND> {
			focus .dc.bg.main.scale.r.ent
		}

		bind .dc.bg.main.scale.r.ent <$BIND> {
			focus .dc.bg.main.scale.g.ent
		}
		bind .dc.bg.main.scale.g.ent <$BIND> {
			focus .dc.bg.main.scale.b.ent
		}
		bind .dc.bg.main.scale.b.ent <$BIND> {
			focus .dc.fg.main.scale.r.ent
		}
	}

	foreach BIND {Shift-Tab Up Control-p} {
		bind .dc.fg.main.scale.r.ent <$BIND> {
			focus .dc.bg.main.scale.b.ent
		}
		bind .dc.fg.main.scale.g.ent <$BIND> {
			focus .dc.fg.main.scale.r.ent
		}
		bind .dc.fg.main.scale.b.ent <$BIND> {
			focus .dc.fg.main.scale.g.ent
		}

		bind .dc.bg.main.scale.r.ent <$BIND> {
			focus .dc.fg.main.scale.b.ent
		}
		bind .dc.bg.main.scale.g.ent <$BIND> {
			focus .dc.bg.main.scale.r.ent
		}
		bind .dc.bg.main.scale.b.ent <$BIND> {
			focus .dc.bg.main.scale.g.ent
		}
	}
	if {[lsearch [array names env] FONT] >= 0} {
		Change_Font $env(FONT) .dc
	}
	Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .dc
	Win_Size .dc
	wm resizable .dc 1 0
	Tab_off
	Control
}

#	Make Color (RGB)
proc Make_Color {w args} {
	switch $w {
		.dc.fg.main.color {
			global FC FR FG FB
			regexp {^[0-9]+} [expr $FR * 4095] red
			regexp {^[0-9]+} [expr $FG * 4095] green
			regexp {^[0-9]+} [expr $FB * 4095] blue
			set FC [format #%03x%03x%03x $red $green $blue]
			$w configure -bg $FC
		}
		.dc.bg.main.color {
			global BC BR BG BB
			regexp {^[0-9]+} [expr $BR * 4095] red
			regexp {^[0-9]+} [expr $BG * 4095] green
			regexp {^[0-9]+} [expr $BB * 4095] blue
			set BC [format #%03x%03x%03x $red $green $blue]
			$w configure -bg $BC
		}
	}
}

#	Set Color(FG BG) value in environment variable
proc Set_Color {} {
	global env FC BC

	set env(FORE_GROUND_COLOR) $FC
	set env(BACK_GROUND_COLOR) $BC
}

#	Reset Color default value
proc Reset_Color SWITCH {
	global FC FR FG FB  BC BR BG BB

	switch $SWITCH {
		F {
			switch [string length $FC] {
				4 {	scan $FC #%01x%01x%01x red green blue
					set FR [expr [format %f $red] / 4095.0]
					set FG [expr [format %f $green] / 4095.0]
					set FB [expr [format %f $blue] / 4095.0]
				}
				7 {	scan $FC #%02x%02x%02x red green blue
					set FR [expr [format %f $red] / 4095.0]
					set FG [expr [format %f $green] / 4095.0]
					set FB [expr [format %f $blue] / 4095.0]
				}
				10 {	scan $FC #%03x%03x%03x red green blue
					set FR [expr [format %f $red] / 4095.0]
					set FG [expr [format %f $green] / 4095.0]
					set FB [expr [format %f $blue] / 4095.0]
				}
			}
		}
		B {
			switch [string length $BC] {
				4 {	scan $BC #%01x%01x%01x red green blue
					set BR [expr [format %f $red] / 4095.0]
					set BG [expr [format %f $green] / 4095.0]
					set BB [expr [format %f $blue] / 4095.0]
				}
				7 {	scan $BC #%02x%02x%02x red green blue
					set BR [expr [format %f $red] / 4095.0]
					set BG [expr [format %f $green] / 4095.0]
					set BB [expr [format %f $blue] / 4095.0]
				}
				10 {	scan $BC #%03x%03x%03x red green blue
					set BR [expr [format %f $red] / 4095.0]
					set BG [expr [format %f $green] / 4095.0]
					set BB [expr [format %f $blue] / 4095.0]
				}
			}
		}
	}
}