Version 31 of Periodic Table of Chemical Elements

Updated 2007-05-20 22:11:35 by FF

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://www.freemove.it/images/PeriodicTable.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.


KPV When I ran this on my windows machine, all the text was overlapping and unreadable. I realized that I was using "Large Size (120 DPI)" display settings. Sure enough, when I changed to "Normal Size (96 DPI)" it looked much better. Seems this code could benefit from a font vertical measure type command.

Also, the procedure named ' really confused emacs.

DKF: You can measure fonts vertically by using font metrics to fetch the inter-line space, like this:

 set fontHeight [font metrics $font -linespace]

Multiply this by the number of lines you've got, and you're done.

FF: Ok, hope it is fixed. I used font metrics as vertical increment both for elements and for detailed info. Now they shouldn't overlap. Anyway: how can I test this on linux?


 #!/bin/sh
 # This line continues for Tcl, but is a single line for 'sh' \
 exec tclsh "$0" ${1+"[email protected]"}

 package require Tk 8.4
 package require tdom

 set elW 55
 set elH 60

 pack [canvas .c -width [expr $elW*18+1] -height [expr $elH*10+1]]

 proc drawElement {an aw os en ar sym conf name bg gr per} {
        global c
        set tags atom_$an
        set fon1 [font create -family Helvetica -size 8 -weight bold]
        set fon2 [font create -family Helvetica -size 9 -weight bold]
        set fon3 [font create -family Helvetica -size 8]
        set fon4 [font create -family Helvetica -size 18 -weight bold]
        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
        .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]
        .c create text $w2 $y -text $os -font $fon3 -anchor ne -tags $tags
        incr y [font metrics $fon3 -linespace]
        set y2 $y
        if {$en > 0} {
         .c create text 2 $y2 -text $en -font $fon1 -anchor nw -tags $tags
        }
        incr y2 [font metrics $fon1 -linespace]
        if {$ar > 0} {
         .c create text 2 $y2 -text $ar -font $fon1 -anchor nw -tags $tags
        }
        .c create text $w2 $y -text $sym -font $fon4 -anchor ne -tags $tags
        incr y [font metrics $fon4 -linespace]
        .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"
 }

 proc showInfobox {an x y} {
        global root
        .c delete infobox
        set by 30 ; set bw 400 ; set bh 360 ; set bx 70
        if {$y < 210} {
                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 < 500} {
                if {$x < 200} {set bx 250} {set bx 570}
                set DX [expr $bx+$bw] ; set DY $by1
                set IX $x ; set IY $y
        } else {
                if {$x > 820} {set bx 400}
                set DX $x ; set DY $y
                set IX $bx ; set IY $by1
        }
        set bxw [expr $bx+$bw] ; set byh [expr $by+$bh]
        .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 byt $by
        set bxwt [expr $bxw-10]
        set fon1 [font create -family Helvetica -size 8 -weight bold]
        set fon2 [font create -family Helvetica -size 10]
        set fon3 [font create -family Helvetica -size 48 -weight bold]
        set fon4 [font create -family Helvetica -size 40 -weight bold]
        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 {
                        .c create text $bx $byt -text "$nn" \
                                -font $fon1 -anchor nw -tags $tt
                        .c create text $bxwt $byt -text "$txt" \
                                -font $fon2 -anchor ne -tags $tt
                        incr byt [font metrics $fon2 -linespace]
                }
        }
        .c move infobox_text 0 [font metrics $fon3 -linespace]
        .c move infobox_text 0 6
        .c create text $bx $by -text $SYMBOL -font $fon3 -anchor nw -tags $tt
        .c create text $bxwt $by -text $an -font $fon4 -anchor ne -tags $tt
        .c move infobox_text 5 5
 }

 set fp [open periodic.xml r] ; set xml [read $fp] ; close $fp
 set doc [dom parse $xml] ; set root [$doc documentElement]
 set ATOMIC_NUMBER 1
 set fields {ATOMIC_WEIGHT OXIDATION_STATES ELECTRONEGATIVITY
            ATOMIC_RADIUS SYMBOL ELECTRON_CONFIGURATION NAME}
 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
                }
        }
 }
 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
 }

 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
 }

 .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

[ Category Chemistry | Category Science | Category XML ]