1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
| #!/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 <ButtonPress-1> "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 <ButtonPress-1> ".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 |
Comment changer les couleurs
Répondre avec citation
Partager