Import Geant4 0.0.0 source tree
This commit is contained in:
Gabriele Cosmo
@@ -0,0 +1,382 @@
|
||||
## 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]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user