[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 [http://www.w3.org/XML/Binary/2005/03/test-data/Over100K/periodic.xml] [http://www.freemove.it/images/PeriodicTable.gif] Notes about implementation: 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. ---- #!/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 $name -font $fon1 -anchor s -tags $tags .c move $tags [expr ($gr-1)*$w+1] [expr ($per-1)*$h+1] .c bind $tags "@ $an %x %y" } proc @ {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 ".c delete infobox" set tt {infobox infobox_text} set node [$root selectNodes //ATOM\[ATOMIC_NUMBER=$an\]] set byt [expr $by+60] set bxwt [expr $bxw-10] 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 {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 } .c create line 165 301 165 422 -width 3 .c create line 165 481 165 602 -width 3 .c create line 165 422 165 481 -width 1 .c create line 660 61 660 121 715 121 715 181 770 181 770 241 825 241 825 301 880 301 880 361 -width 3 ---- [[ [Category Chemistry] | [Category Science] | [Category XML] ]]