[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: 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. [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. [MHo]: Just downloaded and tested this program. The problems with the overlapped fonts persist (etcl, w2k). [FF]: Where do they overlap? It is in the popup infobox, or in the table itself? Also: do they overlap vertically or horizontally? Or do they exceed in the cell width? If so change: set elW 55 to something bigger. Unfortunately I can't predict that unless I do a time-consuming compare over all displayed elements attributes in the XML tree. Otherwise try to alter '''bw''' and '''bh''' in: set by 30 ; set bw 400 ; set bh 360 ; set bx 70 which are the sizes of the white infobox. [Bryan Oakley] From a usability point of view, I think I'd recommend to switch which block of text gets the bold treatment in the popup window. Your data -- which I presume is what most people would be interested in -- is normal, while the labels (Name, Atomic Weight, etc) are in bold. It seems to me you got that exactly backward. Otherwise, it's a darn nifty program. I see a few words that overlap here and there, but not bad! This seems like it would make a good thing to include with the tk demos that ship with the core. [FF] It was as simple as moving '''-weight bold''' one line below (into ''proc showInfobox'')! ''';-)''' I'll test it on a Windows machine as soon as I can, so I can see how to fix font issues. [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 proc drawElement {an aw os en ar sym conf name bg gr per {test 0}} { 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] 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} { 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" .c bind infobox ".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] set fon2 [font create -family Helvetica -size 10 -weight bold] 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 elW 55 set elW 70 ;# I needed to increase this to see the text 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]] cd [file dirname [info script]] ; # assumes one has downloaded file 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] ]]