Version 0 of Periodic Table of Chemical Elements
Updated 2007-05-19 22:12:06 by FFFF 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 ]
I used tDOM package for parsing XML, using XPath to keep things simple.
#!/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
grid [canvas .c -width 991 -height 601] -row 0 -columnspan 2 -sticky news
proc ' {an aw os en ar sym conf name bg gr per} {
global c
set tags atom_$an
set fon1 [list Helvetica 8 bold] ; set fon2 [list Helvetica 9 bold]
set fon3 [list Helvetica 8] ; set fon4 [list Helvetica 18 bold]
set w 55 ; set w2 [expr $w-2] ; set wh [expr $w/2] ; set h 60
set bgcol [string map {y #f9df4e o #e5883d b #489dc4 g #5dc448} $bg]
.c create rectangle 0 0 $w $h -tags [list $tags hov_$an] -fill $bgcol
.c create text 2 2 -text $an -font $fon2 -anchor nw -tags $tags
.c create text $w2 2 -text $aw -font $fon1 -anchor ne -tags $tags
.c create text $w2 12 -text $os -font $fon3 -anchor ne -tags $tags
if {$en > 0} {
.c create text 2 22 -text $en -font $fon1 -anchor nw -tags $tags
}
if {$ar > 0} {
.c create text 2 32 -text $ar -font $fon1 -anchor nw -tags $tags
}
.c create text $w2 27 -text $sym -font $fon4 -anchor ne -tags $tags
.c create text $wh 58 -text $conf -font $fon1 -anchor s -tags $tags
.c move $tags [expr ($gr-1)*$w+1] [expr ($per-1)*$h+1]
.c bind $tags <ButtonPress-1> "@ $an %x %y"
}
proc @ {an x y} {
global root
.c delete infobox
puts "@ an:$an x:$x y:$y"
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}
puts "root=$root"
set node [$root selectNodes //ATOM\[ATOMIC_NUMBER=$an\]]
puts "node $root selectNodes //ATOM\[ATOMIC_NUMBER=$an\]"
puts "node=$node"
set byt [expr $by+60]
set bxwt [expr $bxw-10]
foreach child [$node childNodes] {
set nn [string map {"_" " "} [$child nodeName]]
set txt [join [split [$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 {Helvetica 8 bold} -anchor nw -tags $tt
.c create text $bxwt $byt -text "$txt" \
-font {Helvetica 10} -anchor ne -tags $tt
incr byt 16
}
}
.c create text $bx $by -text $SYMBOL -font {Helvetica 48 bold} -anchor nw -tags $tt
.c create text $bxwt $by -text $an -font {Helvetica 40 bold} -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)]]
' $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 "] ""]
}
}
' $ATOMIC_NUMBER $ATOMIC_WEIGHT $OXIDATION_STATES $ELECTRONEGATIVITY \
$ATOMIC_RADIUS $SYMBOL $ELECTRON_CONFIGURATION $NAME g $g $p
incr ATOMIC_NUMBER
}
incr ATOMIC_NUMBER 18
}