Periodic Table of Chemical Elements
FF 2007-05-20 - Today, while studying chemistry, I needed some distraction (mainly an excuse to leave my chemistry book alone for a while). I searched for a periodic table visualizer on the wiki, but couldn't find one. So I've made it. The basic version was just 120 lines long and it took about an hour... then I made it more complete, adding a popup showing every available detail from periodic.xml [L1 ]
Notes: I followed the layout found on my book - the bold line on the right separates metals (on the left) from non-metals (on the right). Some elements touching the bold line have intermediate properties. The color indicates the orbital (yellow = s block, orange = d block, cyan = p block, green = f block)
I used tDOM package for parsing XML, using XPath to keep things simple.
Update: JOY TO THE WORLD!!! finally I fixed those font issues. Now every line of text is calculated with [font metrics] and [font measure]. Let me know if something doesn't work as expected. (Use xinit -e wish PeriodicTable -- :1 -dpi 120 for testing different dpi on linux). I tested it with Tk 8.5 with xft aka antialiased fonts and looks beauty
Thanks to KPV and MHo for initially reporting the font issue on Windows. Thanks to DKF for the [font metrics] tip. Thanks to Bryan Oakley for suggesting usability tips (and for "This seems like it would make a good thing to include with the tk demos that ship with the core." ;)). Thanks to MG for reporting an error (I was soon [ab]using the new features of Tcl 8.5 hehe) of undefined variable.
LV I wonder whether there is an authority location for the data used by this application? Because, for instance, I've seen web sites listing an element 112, and I notice that some of the elements have little information about them other than the name and number. Not this program author's problem - he just displays the data available. That data appears, from what I can tell, to be about two years old, at the very least.
#!/bin/sh
# This line continues for Tcl, but is a single line for 'sh' \
exec tclsh "$0" ${1+"$@"}
package require Tk 8.4
package require tdom
set family Helvetica
set fon1 [font create -family $family -size 8 -weight bold]
set fon2 [font create -family $family -size 9 -weight bold]
set fon3 [font create -family $family -size 8]
set fon4 [font create -family $family -size 18 -weight bold]
set fon5 [font create -family $family -size 8]
set fon6 [font create -family $family -size 10 -weight bold]
set fon7 [font create -family $family -size 48 -weight bold]
set fon8 [font create -family $family -size 40 -weight bold]
proc drawElement {an aw os en ar sym conf name bg gr per {test 0}} {
# $test is for computing font measure (1=vert, 2=horiz)
set tags atom_$an
if {$test == 2} {return [font measure $::fon1 "999 99.99999"]}
if {!$test} {
set bgcol [string map {y #f9df4e o #e5883d b #489dc4 g #5dc448} $bg]
set w $::elW ; set w2 [expr $w-2] ; set wh [expr $w/2] ; set h $::elH
.c create rectangle 0 0 $w $h -tags [list $tags hov_$an] -fill $bgcol
}
set y 2
if {!$test} {
.c create text 2 $y -text $an -font $::fon2 -anchor nw -tags $tags
.c create text $w2 $y -text $aw -font $::fon1 -anchor ne -tags $tags
}
incr y [font metrics $::fon2 -linespace]
if {!$test} {
.c create text $w2 $y -text $os -font $::fon3 -anchor ne -tags $tags
}
incr y [font metrics $::fon3 -linespace]
set y2 $y
if {!$test && $en > 0} {
.c create text 2 $y2 -text $en -font $::fon1 -anchor nw -tags $tags
}
incr y2 [font metrics $::fon1 -linespace]
if {!$test && $ar > 0} {
.c create text 2 $y2 -text $ar -font $::fon1 -anchor nw -tags $tags
}
if {!$test} {
.c create text $w2 $y -text $sym -font $::fon4 -anchor ne -tags $tags
}
incr y [font metrics $::fon4 -linespace]
if {!$test} {
.c create text $wh $y -text $name -font $::fon1 -anchor n -tags $tags
.c move $tags [expr ($gr-1)*$w+1] [expr ($per-1)*$h+1]
.c bind $tags <ButtonPress-1> "showInfobox $an %x %y"
}
if {$test} {
incr y [font metrics $::fon1 -linespace]
return $y
}
}
proc showInfobox {an x y {test 0}} {
# $test is for computing font measure (1=vert, 2=horiz)
if {!$test} {.c delete infobox}
set bx 1
set by 1
set byt 1
if {!$test} {
set bw [showInfobox $an 0 0 2]
set bh [showInfobox $an 0 0 1]
set totalW [expr $::elW*18]
set totalWh [expr $totalW/2]
set totalWhh [expr $totalW/4]
set totalHh [expr $::elH*5]
set by [expr $totalHh-$bh/2]
if {$y < $totalHh} {
set by1 [expr $by+$bh*0.25] ; set by2 [expr $by+$bh*0.5]
} else {
set by1 [expr $by+$bh*0.5] ; set by2 [expr $by+$bh*0.75]
}
if {$x < $totalWh} {
set bx [expr $x+50]
set DX [expr $bx+$bw] ; set DY $by1
set IX $x ; set IY $y
} else {
set bx [expr $x-$bw-50]
set DX $x ; set DY $y
set IX $bx ; set IY $by1
}
set bxw [expr $bx+$bw]
set byh [expr $by+$bh]
set byt $by
set bxwt [expr $bxw-10]
}
if {!$test} {
.c create polygon $bx $by $bxw $by $bxw $by1 $DX $DY $bxw $by2 \
$bxw $byh $bx $byh $bx $by2 $IX $IY $bx $by1 $bx $by \
-fill black -outline black -tags {infobox infobox_shadow}
.c move infobox_shadow 2 2
.c create polygon $bx $by $bxw $by $bxw $by1 $DX $DY $bxw $by2 \
$bxw $byh $bx $byh $bx $by2 $IX $IY $bx $by1 $bx $by \
-fill white -outline black -tags infobox
.c bind infobox <ButtonPress-1> ".c delete infobox"
}
set tt {infobox infobox_text}
set node [$::root selectNodes //ATOM\[ATOMIC_NUMBER=$an\]]
set largest 0
foreach child [$node childNodes] {
set nn [string map {"_" " "} [$child nodeName]]
set txt [string trim [$child text] "\n\r\t "]
if {[$child hasAttribute UNITS]} {
set txt "$txt [$child getAttribute UNITS]"
}
if {$nn == "SYMBOL"} {
set SYMBOL $txt
} elseif {$nn == "ATOMIC NUMBER"} {
} else {
if {!$test} {
.c create text $bx $byt -text "$nn" \
-font $::fon5 -anchor nw -tags $tt
.c create text $bxwt $byt -text "$txt" \
-font $::fon6 -anchor ne -tags $tt
}
incr byt [font metrics $::fon6 -linespace]
set largest_new [expr \
[font measure $::fon5 "$nn"]+[font measure $::fon6 "$txt"]+45]
if {$largest_new > $largest} {set largest $largest_new}
}
}
if {$test == 1} {return [expr 25+[font metrics $::fon7 -linespace]+$byt]}
if {$test == 2} {return $largest}
if {!$test} {
.c move infobox_text 0 [font metrics $::fon7 -linespace]
.c move infobox_text 0 6
.c create text $bx $by -text $SYMBOL -font $::fon7 -anchor nw -tags $tt
.c create text $bxwt $by -text $an -font $::fon8 -anchor ne -tags $tt
.c move infobox_text 5 5
}
}
set elW [drawElement 0 0 0 0 0 0 0 0 0 0 0 2]
set elH [drawElement 0 0 0 0 0 0 0 0 0 0 0 1]
pack [canvas .c -width [expr $elW*18+1] -height [expr $elH*10+1]]
set fp [open periodic.xml r] ; set xml [read $fp] ; close $fp
set doc [dom parse $xml] ; set ::root [$doc documentElement]
set fields {ATOMIC_WEIGHT OXIDATION_STATES ELECTRONEGATIVITY
ATOMIC_RADIUS SYMBOL ELECTRON_CONFIGURATION NAME}
# draw Basic Table:
set ATOMIC_NUMBER 1
for {set p 1} {$p <= 7} {incr p} {
for {set g 1} {$g <= 18} {incr g} {
if {$ATOMIC_NUMBER > 111 || $p == 1 && $g > 1 && $g < 18 \
|| $p < 4 && $g > 2 && $g < 13} {continue}
foreach v $fields {set $v {}}
set node [$root selectNodes //ATOM\[ATOMIC_NUMBER=$ATOMIC_NUMBER\]]
foreach child [$node childNodes] {
set nn [$child nodeName]
if {[lsearch -exact $fields $nn] >= 0} {
set $nn [join [split [$child text] "\n\r\t "] ""]
}
}
set col [lindex {y o b} [expr ($g<3||$p==1)?0:($g<13?1:2)]]
drawElement \
$ATOMIC_NUMBER $ATOMIC_WEIGHT $OXIDATION_STATES \
$ELECTRONEGATIVITY $ATOMIC_RADIUS $SYMBOL \
$ELECTRON_CONFIGURATION $NAME $col $g $p
if {$ATOMIC_NUMBER == 57 || $ATOMIC_NUMBER == 89} {
incr ATOMIC_NUMBER 15
} else {
incr ATOMIC_NUMBER
}
}
}
# draw Extended Table
set ATOMIC_NUMBER 58
for {set p 9} {$p <= 10} {incr p} {
for {set g 4} {$g <= 17} {incr g} {
foreach v $fields {set $v {}}
set node [$root selectNodes //ATOM\[ATOMIC_NUMBER=$ATOMIC_NUMBER\]]
foreach child [$node childNodes] {
set nn [$child nodeName]
if {[lsearch -exact $fields $nn] >= 0} {
set $nn [join [split [$child text] "\n\r\t "] ""]
}
}
drawElement \
$ATOMIC_NUMBER $ATOMIC_WEIGHT $OXIDATION_STATES \
$ELECTRONEGATIVITY $ATOMIC_RADIUS $SYMBOL \
$ELECTRON_CONFIGURATION $NAME g $g $p
incr ATOMIC_NUMBER
}
incr ATOMIC_NUMBER 18
}
# list math
proc list_XY_ms {l multX multY sumX sumY} {
set r [list]
foreach {x y} $l {
lappend r [expr $x*$multX+$sumX]
lappend r [expr $y*$multY+$sumY]
}
return $r
}
# draw some extra bolder lines
.c create line [list_XY_ms {3 5 3 7 } $elW $elH 0 1] -width 3
.c create line [list_XY_ms {3 8 3 10} $elW $elH 0 1] -width 3
.c create line [list_XY_ms {3 7 3 8 } $elW $elH 0 1] -width 1
.c create line [list_XY_ms {12 1 12 2 13 2 13 3 14 3 14 4 15 \
4 15 5 16 5 16 6} $elW $elH 0 1] -width 3
If you google for periodic table elements webservice, quite a number of hits return. Perhaps someone will some day adapt the program to make use of one of those. It is not clear whether any of these web services have this much, or more, data on the various elements.
In terms of organized information on the web, one might take a look at http://www.webelements.com/ and see how hard it would be to gather additional information from there to add to the xml file mentioned above.
tb - Maybe a little OT, but have you had a look at "The Periodic Table of Videos" at http://www.periodicvideos.com yet?
GS (20091007) Here is another way to visualize the Periodic Table at this page [L2 ]
AMG: More fun visualizations here: [L3 ]
lm The periodic table of the elements is under the control of the IUPAC (International Union of Pure and Applied Chemistry) which regularly updates the table (element 112 has been added). Unfortunatly, it seems they didn't maintain an easily parsable version. But this is the most official and up-to-date table you can find. See http://old.iupac.org/reports/periodic_table/index.html .
LV Seems to me like a good official web service providing access to elemental property data would be useful. Anyone know someone there to suggest it?