Hello,
In the spirit of showing how Tcl/Tk beats writing straight X code, I
wrote a program to display a periodic table of elements. I wrote this
as my first "large" Tcl code, so I invite comments of the
cognoscienti.
The X code (called xpt) was recently posted to comp.sources.x and it
required two articles; I estimate its size to be around 100kB of C
code. The Tcl version is slightly over 23 kB, while including the
following features:
- customizability via a ~/.xelemrc file that can be as simple as
set Fe(atomic mass) <some better value than I have>
set Fe(color) steel-blue
or as complicated as a code adding new menu entries to calculate
specific properties of chemical compounds, for instance
- plotting of atomic properties vs the atomic number, complete with
zooming. Note: this feature uses the xygraph widget that can be found on
the archive sites. If this widget is not compiled in, the program will still
run under standard wish executable.
- menu entry for mailing the local maintainer (if for instance
the physical values are screwed up)
Greetings to all
Reactor Division (bldg. 235), E111
National Institute of Standards and Technology
Gaithersburg, MD 20899, USA
(301) 975 6249 tel
(301) 921 9847 fax
------------cut here and don't forget to edit the signature at the end -----------------
#!/usr/local/bin/wishx -f
# Program: periodic table display
# Written by Przemek Klosowski (C) 1993 (released under GNU licence)
# customization section:
# list of fonts, regularized
set Font(LargeRoman) *times-medium-r-normal--*-240-*
# mail with comments will be sent to this person
# show this value in the initial window
set ShowThisValue {atomic number}
proc DoAbout {} {
global XELEMversion
popMessage .about About \
"This is a periodic table display written by Przemek Klosowski\
(version $XELEMversion)"
Quote:
}
# procedure to show window .
proc ShowWindow {args} {# xf ignore me 7
global PeriodicTable Titles ShowThisValue ElementCell maintainer
# Window manager configurations
wm positionfrom . user
wm sizefrom . ""
wm maxsize . 1024 864
wm minsize . 300 250
wm title . {Periodic table of elements}
wm iconname . {Xelem}
frame .titlebar -borderwidth {2} -geometry {300x23} -relief {raised}
frame .mendelejew -borderwidth {2} -geometry {300x30} -relief {raised}
frame .status -borderwidth {2} -geometry {300x23}
pack append . \
.titlebar {top frame center fillx} \
.mendelejew {top frame center padx 30 pady 20} \
.status {top frame center fillx}
set tp .titlebar.file
menubutton $tp -menu $tp.m -text File
menu $tp.m
$tp.m add command -label "About.." -command {DoAbout }
$tp.m add command -label "Mail $maintainer" -command Mail
$tp.m add separator
$tp.m add command -label "Quit" -command {destroy .}
set to .titlebar.opt
menubutton $to -menu $to.m -text Options
menu $to.m
$to.m add command -label Show -command "$to.m.s post 50 50"
menu $to.m.s
foreach a $Titles {
$to.m.s add radiobutton -label $a -variable ShowThisValue \
-command "Relabel; $to.m.s unpost"
}
$to.m add command -label Plot -command "$to.m.p post 50 50"
if {![string compare {} [info command xygraph]]} {
$to.m entryconfigure 2 -command {
popMessage .argh Sorry "Can't plot: xygraph widget not linked in"}
}
menu $to.m.p
foreach a $Titles {
$to.m.p add radiobutton -label $a \
-command "Plot \{$a\}; $to.m.p unpost"
}
pack append .titlebar $tp left $to left
pack append .status [label .status.l] left
for {set i 1} { $i<=9 } { incr i 1} {
pack append .mendelejew [frame .row$i -relief raised] top
for {set j 0} { $j<18 } { incr j 1} {
set elem [string trim [string range $PeriodicTable($i) [expr $j*3] [expr $j*3+1]]]
set ec .row$i.f$j
if {$elem != ""} {
global $elem
set ElementCell($elem) $ec
pack append [frame $ec -relief sunken -borderwidth 1] \
[button $ec.b -text $elem -width 2\
-borderwidth 1 \
-command "ShowElem $elem"] top \
[label $ec.l -width 5 \
-anchor w ] top
pack append .row$i $ec {left fill}
} {
pack append [frame $ec] \
[label $ec.l -width 5] top
pack append .row$i $ec {left fill}
}
}
}
Relabel
.row1.f1.b configure -background grey
.row3.f2.l configure -text 3B
.row3.f3.l configure -text 4B
.row3.f4.l configure -text 5B
.row3.f5.l configure -text 6B
.row3.f6.l configure -text 7B
.row3.f7.l configure -text <-
.row3.f8.l configure -text 8
.row3.f9.l configure -text ->
.row3.f10.l configure -text 1B
.row3.f11.l configure -text 2B
.row1.f12.l configure -text 3A
.row1.f13.l configure -text 4A
.row1.f14.l configure -text 5A
.row1.f15.l configure -text 6A
.row1.f16.l configure -text 7A
Quote:
}
proc Relabel {} {
global ElementCell ShowThisValue
foreach elem [array names ElementCell] {
global $elem
$ElementCell($elem).l configure -text [set ${elem}($ShowThisValue)]
}
.status.l configure -text "Displaying $ShowThisValue"
Quote:
}
proc Plot {what} {
global ElementCell
catch "destroy .p"
toplevel .p
wm title .p "Plot of $what"
wm minsize .p 700 200
pack append .p [xygraph .p.g -title "Plot of $what" \
-xlabel Element\
-ylabel $what ] {top fill} \
[frame .p.f] top
pack append .p.f [button .p.f.cancel -text Cancel \
-command "destroy .p" ] {left fillx}
set xcoord {atomic number}
foreach elem [array names ElementCell] {
global $elem
set x [set ${elem}($xcoord)]
set y [set ${elem}($what)]
set invalidx [catch "expr $x"]
set invalidy [catch "expr $y"]
if {$invalidx || $invalidy} { continue }
lappend xl $x
lappend yl $y
}
.p.g insert line -xdata $xl -ydata $yl -symbol circle
bind .p.g <ButtonPress-1> {
get.anchor %W %x %y ; %W config -cursor {crosshair red black}
}
bind .p.g <ButtonPress-2> {
catch "%W delete outline" msg
%W config -xmin {} -ymin {} -xmax {} -ymax {}
}
Quote:
}
proc get.coords { w sx sy xVar yVar } {
# w widget
# sx screen x position
# sy screen y position
scan [$w locate $sx $sy ] "%s %s" x y
scan [$w limits ] "%s %s %s %s" xmin xmax ymin ymax
if { $x > $xmax } { set x $xmax }
if { $x < $xmin } { set x $xmin }
if { $y > $ymax } { set y $ymax }
if { $y < $ymin } { set y $ymin }
global $xVar $yVar
set $xVar $x
set $yVar $y
Quote:
}
proc get.anchor { w sx sy } {
# w widget
# sx screen x position
# sy screen y position
global x1 y1 x2 y2
set x2 "" ; set y2 ""
get.coords $w $sx $sy x1 y1
bind $w <B1-Motion> { scan.xy %W %x %y }
bind $w <ButtonRelease-1> { zoom.xy %W %x %y }
Quote:
}
proc box { w x1 y1 x2 y2 } {
$w newtag t1 $x1 $y1 \
-text [format "(%.4g, %.4g)" $x1 $y1] \
-fg red -bg grey \
-font *new*century*140*
$w newtag t2 $x2 $y2 \
-text [format "(%.4g, %.4g)" $x2 $y2] \
-fg red -bg grey \
-font *new*century*140*
$w insert outline \
-xydata { $x1 $y1 $x1 $y2 $x1 $y1 $x2 $y1 $x2 $y1 $x2 $y2
$x1 $y2 $x2 $y2 } \
-symbol dotted -color red -label {} -showretrace true
Quote:
}
proc scan.xy { w sx sy } {
# w widget
# sx screen x position
# sy screen y position
global x1 y1 x2 y2
get.coords $w $sx $sy x2 y2
if { $x1 > $x2 } {
box $w $x2 $y2 $x1 $y1
if { $y1 > $y2 } {
$w config -cursor { bottom_left_corner red black }
} else {
$w config -cursor { top_left_corner red black }
}
} else {
box $w $x1 $y1 $x2 $y2
if { $y1 > $y2 } {
$w config -cursor { bottom_right_corner red black }
} else {
$w config -cursor { top_right_corner red black }
}
}
Quote:
}
proc zoom.xy { w sx sy } {
# w widget
# sx screen x position
# sy screen y position
global x1 y1 x2 y2
# Go back to original bindings
bind $w <ButtonPress-1> { get.anchor %W %x %y }
catch "$w untag t1" msg
catch "$w untag t2" msg
bind $w <B1-Motion> {}
if { $x2 == "" } then {
catch "$w delete outline" msg
$w config -xmin {} -ymin {} -xmax {} -ymax {}
return
}
if { $x1 > $x2 } {
$w config -xmin $x2 -xmax $x1
} else {
if { $x1 < $x2 } {
$w config -xmin $x1 -xmax $x2
}
}
if { $y1 > $y2 } {
$w config -ymin $y2 -ymax $y1
} else {
if { $y1 < $y2 } {
$w config -ymin $y1 -ymax $y2
}
}
$w config -cursor crosshair
Quote:
}
proc Mail {} {
toplevel .m
wm title .m {Mail your comments}
pack append .m [text .m.t] top \
[frame .m.f] top
pack append .m.f [button .m.f.send -text Send -command SendMail] left \
[button .m.f.cancel -text Cancel -command "destroy .m" ] left
Quote:
}
proc SendMail {} {
global maintainer
set file [open "|mail -s About_Xelem... $maintainer" w]
puts $file [.m.t get 1.0 end]
close $file
destroy .m
Quote:
}
proc ShowElem {elemName} {
global Titles $elemName Font
set wname .el$elemName
toplevel $wname
wm title $wname $elemName
wm iconname $wname $elemName
foreach item [array names $elemName] {
set element($item) [set ${elemName}($item)]
}
pack append [frame $wname.1] \
[DoField $wname.1 nm {name} ""] {left} \
[DoField $wname.1 z {atomic number} Z] {left padx 20 fill}\
[DoField $wname.1 a {atomic mass} A] {right}
pack append [frame $wname.2] \
[DoField $wname.2 rho {density [g/ccm]}] left\
[DoField $wname.2 av {atomic volume} ] right
pack append [frame $wname.3] \
[DoField $wname.3 ar {atomic radius [A]} ] left \
[DoField $wname.3 cr {covalent radius [A]}] right
pack append [frame $wname.4] \
[DoField $wname.4 ar {melting pt [K]} ] left \
[DoField $wname.4 cr {boiling pt [K]}] right
pack append [frame $wname.5 -relief raised -border 1] \
[DoField $wname.5 s {structure} "" ] left \
[DoField $wname.5 a
...
read more »
xelem: Tcl/Tk script to display the periodic table