#!/usr/local/bin/wishx -f
# Program: periodic table
# Written by Przemek Klosowski (C) 1993 (released under GNU licence)

regexp {\$Id. .*,v ([^ ]*) ([^ ]*) .*$} \
    {$Id: xelem,v 1.10 1993/08/30 16:26:07 przemek Exp $} \
    dummy  XELEMversion XELEMdate

# customization section:

#   list of fonts, regularized
set Font(LargeTimes)        *times-medium-r-normal--*-240-*
set Font(largeHelveticaObl) *helvetica-bold-o-normal--*-140-*
set Font(Helvetica)         *helvetica-bold-r-normal--*-120-*

option add *Entry.font $Font(largeHelveticaObl)
option add *Text.font  $Font(Helvetica)

#   mail with comments will be sent to this person
set maintainer przemek@rrdstrad.nist.gov

#   show this value in the initial window
set ShowThisValue {atomic number}

set HelpText {

Xelem displays a 'hypertext' periodic table. Each element, when
clicked upon, displays a window with selected data on this
element. The data values can be selected and pasted into other
applications. 

The standard Tk convention of dragging the middle mouse
button allows scrolling material that overflows its display window.

The main periodic table display shows the element symbol and one
additional value (atomic number, by default) that can be selected
via the 'Option/Show' menu.

Xelem's claim to fame comes from its extendability via an ~/.xelemrc
initialization file. The extensions may be as simple as defining new
values for data fields; for instance,

    set Fe(boiling point) 3135.68; 
    set Fe(color) "Bluish steel" 

will change the displayed value of boiling point for iron and define
its color, a new characteristic.  A more complicated example is
included in xelem's distribution: it defines a new menubar button that
opens up a window to calculate properties of compound chemicals.

The initialization file can be reloaded via 'File/Load ~/.xelemrc'
menu button---this helps correcting mistakes in the file.

Another nice feature of xelem is its plotting capability. (Note: the
plotting requires the graph widget available from Tcl archives; it may
be absent from the prevailing version of 'wish'). The menu 'Option/Plot'
selects a quantity that will be plotted as a function of atomic
number; the resulting plot can be zoomed by clicking and dragging
button 1 (unzoom by doubleclicking).

The available data include:
   - atomic name, number and weight
   - mass density
   - atomic volume, and covalent and atomic radia
   - melting and boiling temperatures
   - prevalent crystal structure and lattice dimensions
   - neutron scattering data:
      o coherent and incoherent cross-section
      o absoption coefficient

Menu 'File/mail...' sends mail to the local maintainer---this is handy for
passing on comments/bug reports/accolades.

This help window can be closed by a window manager 'close' command.

Enjoy your exploring of the periodic table!

                      Przemek Klosowski (przemek@rrdstrad.nist.gov)

			Reactor Division (bldg. 235), E111
			National Institute of Standards and Technology
			Gaithersburg, MD 20899,      USA
			(301) 975 6249
}

proc Help {} {
  global HelpText

  catch "destroy .help"
  toplevel .help
  wm positionfrom . user
  wm sizefrom .help ""
  wm maxsize .help 1024 864
  wm minsize .help  300 250
  wm title .help {Help}
  set ht .help.text
  set hs .help.scroll
  pack append .help \
   [scrollbar $hs -relief sunken -command "$ht yview"] {right filly} \
   [text $ht -yscroll "$hs set" ] {expand fill}
  $ht insert current $HelpText
}

proc DoAbout {} {
	global XELEMversion
	popMessage .about About \
	"This is a periodic table display\nwritten by\nPrzemek Klosowski\n \
         przemek@rrdstrad.nist.gov\n(version $XELEMversion)"
}
			 

# 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}
  if {![catch {file readable /usr/local/lib/bitmaps/xelem.xbm} result ] && $result} {
	wm iconbitmap . @/usr/local/lib/bitmaps/xelem.xbm
  }

  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 command -label "Read ~/.xelemrc " -command ReadRc
  $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"

  }

  set th .titlebar.help
  button $th -text Help -relief flat -command Help

  pack append .titlebar $tp left $to left $th right

  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 [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
}

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"
}

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 {}
  }
}
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
}
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 }
}
proc box { w x1 y1 x2 y2 } {
  $w newtag t1 $x1 $y1 \
        -text [format "(%.4g, %.4g)" $x1 $y1] \
        -fg red -bg grey \
  $w newtag t2 $x2 $y2 \
        -text [format "(%.4g, %.4g)" $x2 $y2] \
        -fg red -bg grey \
  $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
}
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 }
     }
  }
}
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 
}

proc Mail {} {
 toplevel .m
 wm title .m {Mail your comments}
 pack append .m [text .m.t] top \
		[frame .m.f] top
 focus .m.t
 pack append .m.f [button .m.f.send   -text Send   -command SendMail] left \
		  [button .m.f.cancel -text Cancel -command "destroy .m" ] left
}
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
}

proc ShowElem {elemName} {
	global Titles $elemName Font

	set wname .el$elemName
	catch "destroy $wname"
	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}
	$wname.1.nm.e configure -width 10
	$wname.1.z.e configure -width 3

	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 {lattice spacing a [A]} {latt. spacing [A]} ] left \
	  [DoField $wname.5 ca {c/a, alpha, b/a}] {right padx 20}
	$wname.5.s.e configure -width 3

	pack append [frame $wname.6 -relief raised -border 1] \
	  [label $wname.6.label -text {Neutron scattering data}] \
			{top frame center}\
	  [DoField $wname.6 coh {coherent scattering length [1E-12cm]}] top\
	  [DoField $wname.6 inc {incoherent X-section [barn]} ] top \
	  [DoField $wname.6 abs {absorption @1.8A [barn]}] top

	set i 0
	frame $wname.7 -relief raised -border 1
	foreach a [array names element] {
	  pack append $wname.7 [DoField $wname.7 $i $a ] top
	  incr i
	}

	pack append $wname \
	  $wname.1 {top fill pady 20} \
	  [label $wname.name -text $elemName -font $Font(LargeTimes)] \
		   {top pady 10}\
	  $wname.2 {top fill pady 20} \
	  $wname.3 {top fill pady 20} \
	  $wname.4 {top fill pady 20} \
	  $wname.5 {top fill pady 20} \
	  $wname.6 {top fill pady 20} \
	  $wname.7 {top fill pady 20} \
	  [button $wname.ok -text Close \
				  -command "destroy $wname"] {bottom fillx}
}

proc DoField {w wid name {displname "displname"}} {
 upvar element element

 if {$displname=="displname"} { set displname $name}
 set value $element($name)
 set framename $w.$wid

 labent [ frame $framename ] $displname Var$framename $value 
 $framename.e configure -state disabled -width 6 -export true

 unset element($name)
 return $framename
}
 
proc SetVars {args} {
 global PeriodicTable Titles

 set PeriodicTable(1) "H  D                                               He"
 set PeriodicTable(2) "Li Be                               B  C  N  O  F  Ne"
 set PeriodicTable(3) "Na Mg                               Al Si P  S  Cl Ar"
 set PeriodicTable(4) "K  Ca Sc Ti V  Cr Mn Fe Co Ni Cu Zn Ga Ge As Se Br Kr"
 set PeriodicTable(5) "Rb Sr Y  Zr Nb Mo Tc Ru Rh Pd Ag Cd In Sn Sb Te I  Xe"
 set PeriodicTable(6) "Cs Ba La Hf Ta W  Re Os Ir Pt Au Hg Tl Pb Bi Po At Rn"
 set PeriodicTable(7) "Fr Ra Ac                                             "
 set PeriodicTable(8) "         Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu   "
 set PeriodicTable(9) "         Th Pa U  Np Pu Am Cm Bk Cf Es Fm Md No Lr   "

 set Titles {{atomic radius [A]} {covalent radius [A]} {atomic number} \
	{atomic mass} {boiling pt [K]} {melting pt [K]} {density [g/ccm]} \
	{atomic volume} {lattice spacing a [A]} {structure} {c/a, alpha, b/a} \
	{coherent scattering length [1E-12cm]} {incoherent X-section [barn]} \
	{absorption @1.8A [barn]} {name} }

#   a.r. c.r.  Z  mass      boil   melt    rho     a.v.    a        c/a       coh(1e12/cm)Incoh(barn) Absrp   name 
#												     (barn)@1.8A
 set initdata {
{H  0.79 0.32  1 1.00794    20.268 14.025  0.0899  14.4   3.75  HEX ---          -0.374    79.9     0.3326   Hydrogen }
{D  0.79 0.32  1 2.014      20.268 14.025  0.0899  14.4   3.75  HEX ---           0.6674    2.04    0.000519 Deuterium}
{He 0.49 0.93  2 4.002602   4.215  0.95    0.1787  0.0    3.57  HEX ---           0.326     0.0     0.00747  Helium   }
{Li 2.05 1.23  3 6.941      1615   453.7   0.53    13.10  3.49  BCC ---          -0.190     0.91   70.5      Lithium  }
{Be 1.40 0.90  4 9.012182   2745   1560.0  1.85    5.0    2.29  HEX 1.567         0.779     0.005   0.0076   Beryllium}
{B  1.17 0.82  5 10.811     4275   2300.0  2.34    4.6    8.73  TET 0.576         0.530     1.7   767.0      Boron    }
{C  0.91 0.77  6 12.011     4470.0 4100.0  2.62    4.58   3.57  DIA  ---          0.6648    0.001   0.0035   Carbon   }
{N  0.75 0.75  7 14.00674   77.35  63.14   1.251   17.3   4.039 HEX 1.051         0.936     0.49    1.90     Nitrogen }
{O  0.65 0.73  8 15.9994    90.18  50.35   1.429   14.0   6.83  CUB ---           0.5805    0.000   0.00019  Oxygen   }
{F  0.57 0.72  9 18.9984032 84.95  53.48   1.696   17.1   ---   MCL ---           0.5654    0.0008  0.0096   Fluorine }
{Ne 0.51 0.71 10 20.1797    27.096 24.553  0.901   16.7   4.43  FCC ---           0.4547    0.008   0.039    Neon     }
{Na 2.23 1.54 11 22.989768  1156   371.0   0.97    23.7   4.23  BCC ---           0.363     1.62    0.530    Sodium   }
{Mg 1.72 1.36 12 24.3050    1363   922     1.74    13.97  3.21  HEX 1.624         0.5375    0.077   0.063    Magnesium}
{Al 1.82 1.18 13 26.981539  2793   933.25  2.70    10.0   4.05  FCC ---           0.3449    0.0085  0.231    Aluminum }
{Si 1.46 1.11 14 28.0855    3540.0 1685    2.33    12.1   5.43  DIA ---           0.4149    0.015   0.171    Silicon  }
{P  1.23 1.06 15 30.97362   550.0  317.30  1.82    17.0   7.17  CUB ---           0.513     0.006   0.172    Phosphorus}
{S  1.09 1.02 16 32.066     717.75 388.36  2.07    15.5   10.47 ORC 2.339/1.229   0.2847    0.007   0.53     Sulfur   }
{Cl 0.97 0.99 17 35.4527    239.1  172.16  3.17    22.7   6.24  ORC 1.324/0.718   0.95792   5.2    33.5      Chlorine }
{Ar 0.88 0.98 18 39.948     87.30  83.81   1.784   28.5   5.26  FCC ---           0.1909    0.22    0.675    Argon    }
{K  2.77 2.03 19 39.0983    1032   336.35  0.86    45.46  5.23  BCC ---           0.371     0.25    2.1      Potassium}
{Ca 2.23 1.91 20 40.078     1757   1112    1.55    29.9   5.58  FCC ---           0.490     0.03    0.43     Calcium  }
{Sc 2.09 1.62 21 44.955910  3104   1812    3.0     15.0   3.31  HEX 1.594         1.229     4.5    27.2      Scandium }
{Ti 2.00 1.45 22 47.88      3562   1943    4.50    10.64  2.95  HEX 1.588        -0.330     2.67    6.09     Titanium }
{V  1.92 1.34 23 50.9415    3682   2175    5.8     8.78   3.02  BCC ---          -0.0382    5.187   5.08     Vanadium }
{Cr 1.85 1.18 24 51.9961    2945   2130.0  7.19    7.23   2.88  BCC ---           0.3635    1.83    3.07     Chromium }
{Mn 1.79 1.17 25 54.93085   2335   1517    7.43    1.39   8.89  FCC ---          -0.373     0.40   13.3      Manganese}
{Fe 1.72 1.17 26 55.847     3135   1809    7.86    7.1    2.87  BCC ---           0.954     0.39    2.56     Iron     }
{Co 1.67 1.16 27 58.93320   3201   1768    8.90    6.7    2.51  HEX 1.622         0.250     4.8    37.18     Cobalt   }
{Ni 1.62 1.15 28 58.69      3187   1726    8.90    6.59   3.52  FCC ---           1.03      5.2     4.49     Nickel   }
{Cu 1.57 1.17 29 63.546     2836   1357.6  8.96    7.1    3.61  FCC ---           0.7718    0.52    3.78     Copper   }
{Zn 1.53 1.25 30 65.39      1180.0 692.73  7.14    9.2    2.66  HEX 1.856         0.5680    0.077   1.11     Zinc     }
{Ga 1.81 1.26 31 69.723     2478   302.90  5.91    11.8   4.51  ORC 1.695/1.001   0.7288    0.0     2.9      Gallium  }
{Ge 1.52 1.22 32 72.61      3107   1210.4  5.32    13.6   5.66  DIA ---           0.81929   0.17    2.3      Germanium}
{As 1.33 1.20 33 74.92159   876    1081    5.72    13.1   4.13  RHL 54"10'        0.658     0.060   4.5      Arsenic  }
{Se 1.22 1.16 34 78.96      958    494     4.80    16.45  4.36  HEX 1.136         0.797     0.33   11.7      Selenium }
{Br 1.12 1.14 35 79.904     332.25 265.90  3.12    23.5   6.67  ORC 1.307/0.672   0.679     0.10    6.9      Bromine  }
{Kr 1.03 1.12 36 83.80      119.80 115.78  3.74    38.9   5.72  FCC ---           0.780     0.03   25.       Krypton  }
{Rb 2.98 2.16 37 85.4678    961    312.64  1.53    55.9   5.59  BCC ---           0.708     0.3     0.38     Rubidium }
{Sr 2.45 1.91 38 87.62      1650.0 1041    2.6     33.7   6.08  FCC ---           0.702     0.04    1.28     Strontium}
{Y  2.27 1.62 39 88.90585   3611   1799    4.5     19.8   3.65  HEX 1.571         0.775     0.15    1.28     Yttrium  }
{Zr 2.16 1.45 40 91.224     4682   2125    6.49    14.1   3.23  HEX 1.593         0.716     0.16    0.185    Zirconium}
{Nb 2.09 1.34 41 92.90638   5017   2740.0  8.55    10.87  3.30  BCC ---           0.7054    0.0024  1.15     Niobium  }
{Mo 2.01 1.30 42 95.94      4912   2890.0  10.2    9.4    3.15  BCC ---           0.695     0.28    2.55     Molybdenum}
{Tc 1.95 1.27 43 98.91      4538   2473    11.5    8.5    2.74  HEX 1.604         0.68      0.0    20.0      Technetium}
{Ru 1.89 1.25 44 101.07     4423   2523    12.2    8.3    2.70  HEX 1.584         0.721     0.07    2.56     Ruthenium}
{Rh 1.83 1.25 45 102.90550  3970.0 2236    12.4    8.3    3.90  FCC ---           0.588     0.0   145.0      Rhodium  }
{Pd 1.79 1.28 46 106.42     3237   1825    12.0    8.9    3.89  FCC ---           0.591     0.093   6.9      Palladium}
{Ag 1.75 1.34 47 107.8682   2436   1234    10.5    10.3   4.09  FCC ---           0.5922    0.58   63.3      Silver   }
{Cd 1.71 1.48 48 112.411    1040.0 594.18  8.65    13.1   2.98  HEX 1.886         0.51      2.4  2520.0      Cadmium  }
{In 2.00 1.44 49 114.82     2346   429.76  7.31    15.7   4.59  TET 1.076         0.4065    0.54  193.8      Indium   }
{Sn 1.72 1.41 50 118.710    2876   505.06  7.30    16.3   5.82  TET 0.546         0.6228    0.022   0.626    Tin      }
{Sb 1.53 1.40 51 121.75     1860.0 904     6.68    18.23  4.51  RHL 58"6'         0.5641    0.3     5.1      Antimony }
{Te 1.42 1.36 52 127.60     1261   722.65  6.24    20.5   4.45  HEX 1.33          0.543     0.02    4.7      Tellurium}
{I  1.32 1.33 53 126.90447  458.4  386.7   4.92    25.74  7.27  ORC 1.347/0.659   0.528     0.0     6.2      Iodine   }
{Xe 1.24 1.31 54 131.29     165.03 161.36  5.89    37.3   6.20  FCC ---           0.485     0.0    23.9      Xenon    }
{Cs 3.34 2.35 55 132.90543  944    301.55  1.87    71.07  6.05  BCC ---           0.542     0.21   29.0      Cesium   }
{Ba 2.78 1.98 56 137.327    2171   1002    3.5     39.24  5.02  BCC ---           0.525     0.01    1.2      Barium   }
{La 2.74 1.69 57 138.9055   3730.0 1193    6.7     20.73  3.75  HEX 1.619         0.824     1.13    8.97     Lanthanum}
{Ce 2.70 1.65 58 140.115    3699   1071    6.78    20.67  5.16  FCC ---           0.484     0.0     0.63     Cerium   }
{Pr 2.67 1.65 59 140.90765  3785   1204    6.77    20.8   3.67  HEX 1.614         0.445     0.016  11.5      Praseodymium}
{Nd 2.64 1.64 60 144.24     3341   1289    7.00    20.6   3.66  HEX 1.614         0.769    11.     50.5      Neodymium}
{Pm 2.62 1.63 61 145        3785   1204    6.475   22.39  ---   --- ---           1.26      1.3   168.4      Promethium}
{Sm 2.59 1.62 62 150.36     2064   1345    7.54    19.95  9.00  RHL 23"13'        0.42     50.   5670.       Samarium }
{Eu 2.56 1.85 63 151.965    1870.0 1090.0  5.26    28.9   4.61  BCC ---           0.668     2.2  4600.       Europium }
{Gd 2.54 1.61 64 157.25     3539   1585    7.89    19.9   3.64  HEX 1.588         0.95    158.0 48890.       Gadolinium}
{Tb 2.51 1.59 65 158.92534  3496   1630.0  8.27    19.2   3.60  HEX 1.581         0.738     0.004  23.4      Terbium  }
{Dy 2.49 1.59 66 162.50     2835   1682    8.54    19.0   3.59  HEX 1.573         1.69     54.5   940.       Dysprosium}
{Ho 2.47 1.58 67 164.93032  2968   1743    8.80    18.7   3.58  HEX 1.570         0.808     0.36   64.7      Holmium  }
{Er 2.45 1.57 68 167.26     3136   1795    9.05    18.4   3.56  HEX 1.570         0.803     1.2   159.2      Erbium   }
{Tm 2.42 1.56 69 168.93421  2220.0 1818    9.33    18.1   3.54  HEX 1.570         0.705     0.41  105.       Thulium  }
{Yb 2.40 1.74 70 173.04     1467   1097    6.98    24.79  5.49  FCC ---           1.24      3.0    35.1      Ytterbium}
{Lu 2.25 1.56 71 174.967    3668   1936    9.84    17.78  3.51  HEX 1.585         0.73      0.1    76.4      Lutetium }
{Hf 2.16 1.44 72 178.49     4876   2500.0  13.1    13.6   3.20  HEX 1.582         0.777     2.6   104.1      Hafnium  }
{Ta 2.09 1.34 73 180.9479   5731   3287    16.6    10.90  3.31  BCC ---           0.691     0.02   20.6      Tantalum }
{W  2.02 1.30 74 183.85     5828   3680.0  19.3    9.53   3.16  BCC ---           0.477     2.00   18.4      Tungsten }
{Re 1.97 1.28 75 186.207    5869   3453    21.0    8.85   2.76  HEX 1.615         0.92      0.9    90.7      Rhenium  }
{Os 1.92 1.26 76 190.2      5285   3300.0  22.4    8.49   2.74  HEX 1.579         1.10      0.4    16.0      Osmium   }
{Ir 1.87 1.27 77 192.22     4701   2716    22.5    8.54   3.84  FCC ---           1.06      0.2   425.3      Iridium  }
{Pt 1.83 1.30 78 195.08     4100.0 2045    21.4    9.10   3.92  FCC ---           0.963     0.13   10.3      Platinum }
{Au 1.79 1.34 79 196.96654  3130.0 1337.58 19.3    10.2   4.08  FCC ---           0.763     0.36   98.65     Gold     }
{Hg 1.76 1.49 80 200.59     630.0  234.28  13.53   14.82  2.99  RHL 70"45'        1.266     6.7   372.3      Mercury  }
{Tl 2.08 1.48 81 204.3833   1746   577     11.85   17.2   3.46  HEX 1.599         0.8785    0.14    3.43     Thallium }
{Pb 1.81 1.47 82 207.2      2023   600.6   11.4    18.17  4.95  FCC ---           0.94003   0.003   0.171    Lead     }
{Bi 1.63 1.46 83 208.98037  1837   544.52  9.8     21.3   4.75  RHL 58"14'        0.85256   0.0072  0.0338   Bismuth  }
{Po 1.53 1.46 84 209        1235   527     9.4     22.23  3.35  SC  ---           ---       ---     ---      Polonium }
{At 1.43 1.45 85 210.0      610.0  575     ---     ---    ---   --- ---           ---       ---     ---      Astatine }
{Rn 1.34 1.43 86 222        211    202     9.91    50.5   ---   --- ---           ---       ---     ---      Radon    }
{Fr 3.50 2.50 87 223        950.0  300.0   ---     ---    ---   --- ---           0.8495    0.0072  0.036    Francium }
{Ra 3.00 2.40 88 226.025    1809   973     5       45.20  ---   --- ---           1.0       0.0    12.8      Radium   }
{Ac 3.20 2.20 89 227.028    3473   1323    10.07   22.54  5.31  FCC ---           ---       ---     ---      Actinium }
{Th 3.16 1.65 90 232.0381   5061   2028    11.7    19.9   5.08  FCC ---           0.984     0.0     7.37     Thorium  }
{Pa 3.14 ---  91 231.03588  ---    ---     15.4    15.0   3.92  TET 0.825         0.91      0.0   200.6      Protactinium}
{U  3.11 1.42 92 238.0289   4407   1405    18.90   12.59  2.85  ORC 2.056/1.736   0.8417    0.004   7.57     Uranium  }
{Np 3.08 ---  93 237.048    ---    910.0   20.4    11.62  4.72  ORC 1.411/1.035   1.055     0.0   175.9      Neptunium}
{Pu 3.05 ---  94 244        3503   913     19.8    12.32  ---   MCL ---           1.41      0.0   558.       Plutonium}
{Am 3.02 ---  95 243        2880.0 1268    13.6    17.86  ---   --- ---           0.83      0.0    75.3      Americium}
{Cm 2.99 ---  96 247        ---    1340.0  13.511  18.28  ---   --- ---           0.7       0.0     0.0      Curium   }
{Bk 2.97 ---  97 247        ---    ---     ---     ---    ---   --- ---           ---       ---     ---      Berkelium}
{Cf 2.95 ---  98 251        ---    900.0   ---     ---    ---   --- ---           ---       ---     ---      Californium}
{Es 2.92 ---  99 254        ---    ---     ---     ---    ---   --- ---           ---       ---     ---      Einsteinium}
{Fm 2.90 --- 100 257        ---    ---     ---     ---    ---   --- ---           ---       ---     ---      Fermium  }
{Md 2.87 --- 101 258(256?)  ---    ---     ---     ---    ---   --- ---           ---       ---     ---      Mendelevium}
{No 2.85 --- 102 259(254?)  ---    ---     ---     ---    ---   --- ---           ---       ---     ---      Nobelium }
{Lr 2.82 --- 103 260(257?)  ---    ---     ---     ---    ---   --- ---           ---       ---     ---      Lawrencium}
 }
 foreach a $initdata {
   set elem [lindex $a 0]
   global $elem
   set i 1 
   foreach name $Titles {
     set ${elem}($name)  [lindex $a $i]
     incr i 1
   }
 }
}
proc popMessage {w title messag } {

	# pjw: 11/2/1992
	# pops up a message box with an ok button for the 
	# users information - typically used to warn users of
	# the occurrence of errors, exceptional conditions

	global Font
	catch "destroy $w"
	toplevel $w
	wm title $w $title
	dpos $w 400 400

	message $w.mess -text $messag -relief raised -font $Font(LargeTimes) -aspect 250
	button $w.ok	-text "OK" -relief raised -padx 10 -pady 5 \
			-command "destroy $w"
	pack append $w $w.mess {top}\
                       $w.ok {top fillx}

}
proc dpos {w {x 300} {y 300}} {
    wm geometry $w +$x+$y
}

proc ReadRc {} {
    if {![catch {file readable ~/.xelemrc} result] && $result} {source ~/.xelemrc}
}

proc labent { w name var {val {}}} {
	pack append $w  [label $w.l -text $name] {left}\
			[entry $w.e -textvariable $var -relief sunken] left
        global $var; set $var $val
	return $w
}

proc GetTotal {qty Compound} {
    set comp [string trim $Compound]
    
    # change every paren except the first one
    regsub -all {(.)\(} $comp {\1+(} comp
    regsub -all {([0-9]+(\.[0-9]*)?)} $comp {*(\1)} comp
    while {[regexp {[A-Z][a-z]?} $comp elem]} {
    global $elem
	if {![info exists $elem]} {
	    popMessage .argh Sorry "Can't find element $elem"
	    return
	}	
	if {[catch {set "${elem}($qty)"} val ] || [catch {expr $val}]} {
	    popMessage .argh Sorry "Don't have value of $qty for element $elem"
	    return
	}
	# Tcl expression +11 is invalid, but -11 and -(-11) are OK. Since I need
	# the sign to synthetize summation, I will use negative values and then
	# negate the result.
	regsub -all $elem $comp -($val) comp
    }
    if {[catch {expr -($comp)} value]} {
	    popMessage .argh Sorry \
    "Compound $Compound: can't calculate total $qty. Try a compound name like Fe2(ClC)3"
	    return
    }
    return $value
}

SetVars
ShowWindow
ReadRc
