[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/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 "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 ".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 ---- [[ [Category Chemistry] | [Category Science] | [Category XML] ]]