Version 40 of Periodic Table of Chemical Elements

Updated 2009-06-12 13:54:01 by LV

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 ]

http://dev.gentoo.org/~mescalinum/tclwiki-img/PeriodicTable2.gif

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.