Gabriele Cosmo
383 lines
10 KiB
PSL
383 lines
10 KiB
PSL
## 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]
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|