[647] | 1 | # $Id: cifselect.tcl 930 2009-12-04 23:14:35Z toby $ |
---|
[640] | 2 | |
---|
[647] | 3 | # implements CIFselect: set publication flags for distances and angles |
---|
| 4 | |
---|
[640] | 5 | # create a label for an atom |
---|
| 6 | proc labelatom {phase atom} { |
---|
| 7 | global labelarr |
---|
| 8 | set a [lindex [split $atom _] 0] |
---|
| 9 | set suffix [lindex [split $atom _] 1] |
---|
| 10 | set label ${a} |
---|
| 11 | catch { |
---|
| 12 | set label $labelarr(${phase}P${a}) |
---|
| 13 | } |
---|
| 14 | if {$suffix != ""} { |
---|
| 15 | append label _$suffix |
---|
| 16 | } |
---|
| 17 | return $label |
---|
| 18 | } |
---|
| 19 | |
---|
| 20 | # create a symmetry code number (a-zz for 1 to 702 [26*27]) |
---|
| 21 | proc codenumber {n} { |
---|
| 22 | set res {} |
---|
| 23 | while {$n > 0} { |
---|
| 24 | set c [format %c [expr {97 + ($n-1) % 26}]] |
---|
| 25 | set res "${c}${res}" |
---|
| 26 | set n [expr {($n - 1) / 26}] |
---|
| 27 | } |
---|
| 28 | return $res |
---|
| 29 | } |
---|
| 30 | |
---|
| 31 | # format numbers & errors in crystallographic notation |
---|
| 32 | proc formatSU {num err} { |
---|
| 33 | # errors less or equal to t are expressed as 2 digits |
---|
| 34 | set T 19 |
---|
| 35 | set lnT [expr { log10($T) }] |
---|
| 36 | # error is zero |
---|
| 37 | if {$err == 0} { |
---|
| 38 | # is this an integer? |
---|
| 39 | if {int($num) == $num} { |
---|
| 40 | return [format %d [expr int($num)]] |
---|
| 41 | } |
---|
| 42 | # allow six sig figs with a zero error (except for 0.0) |
---|
| 43 | set dec [expr int(5.999999-log10( abs($num) ))] |
---|
| 44 | if {$dec < -2 || $dec > 9} { |
---|
| 45 | return [format %.5E $num] |
---|
| 46 | } elseif {$dec <= 0} { |
---|
| 47 | return [format %d [expr int($num)]] |
---|
| 48 | } else { |
---|
| 49 | return [format %.${dec}f $num] |
---|
| 50 | } |
---|
| 51 | } else { |
---|
| 52 | #set sigfigs [expr log10( abs(10) / abs(.012/$T) ) + 1] |
---|
| 53 | # should the number be expressed in scientific notation? |
---|
| 54 | if {$err > $T || abs($num) < 0.0001} { |
---|
| 55 | # get the exponent |
---|
| 56 | set exp [lindex [split [format %E $num] E] end] |
---|
| 57 | # strip leading zeros |
---|
| 58 | regsub {([-\+])0+} $exp {\1} exp |
---|
| 59 | # number of decimals in exponetial notation |
---|
| 60 | set dec [expr int($lnT - log10( abs($err) ) + $exp)] |
---|
| 61 | # should the error be displayed? |
---|
| 62 | if {$err < 0} { |
---|
| 63 | return [format "%.${dec}E" $num] |
---|
| 64 | } else { |
---|
| 65 | # scale the error into a decimal number |
---|
| 66 | set serr [expr int(0.5 + $err * pow(10,$dec-$exp))] |
---|
| 67 | return [format "%.${dec}E(%d)" $num $serr] |
---|
| 68 | } |
---|
| 69 | } else { |
---|
| 70 | # number of digits |
---|
| 71 | set dec [expr int($lnT - log10( abs($err) ))] |
---|
| 72 | # should the error be displayed? |
---|
| 73 | if {$err < 0} { |
---|
| 74 | return [format "%.${dec}f" $num] |
---|
| 75 | } else { |
---|
| 76 | set serr [expr int(0.5 + $err * pow(10,$dec))] |
---|
| 77 | return [format "%.${dec}f(%d)" $num $serr] |
---|
| 78 | } |
---|
| 79 | } |
---|
| 80 | } |
---|
| 81 | } |
---|
| 82 | |
---|
| 83 | |
---|
| 84 | # fill a frame with distances and angles as a trianglar matrix |
---|
| 85 | proc FillDistAngMatrix {phase atom} { |
---|
| 86 | global disarr dislist disflag angarr angflag widget CIFselect |
---|
| 87 | catch {unset widget} |
---|
| 88 | set frame $CIFselect(seldisplay) |
---|
| 89 | eval destroy [winfo children $frame] |
---|
| 90 | set width 0 |
---|
| 91 | |
---|
| 92 | # overall heading |
---|
| 93 | grid [frame $frame.head] \ |
---|
[729] | 94 | -row 0 -column 0 -columnspan 99 -sticky ew |
---|
[640] | 95 | grid [label $frame.head.l -textvariable CIFselect(boxhead)\ |
---|
| 96 | -anchor center] \ |
---|
[729] | 97 | -row 0 -column 0 -sticky ew |
---|
[640] | 98 | set CIFselect(boxhead) "Select an atom for distance and angle display" |
---|
| 99 | grid columnconfigure $frame.head 0 -weight 1 -pad 10 |
---|
| 100 | grid [button $frame.head.help -text Help -bg yellow \ |
---|
| 101 | -command "MakeWWWHelp gsas2cif.html cifselect"] \ |
---|
| 102 | -column 1 -row 0 -sticky e |
---|
| 103 | |
---|
| 104 | if {$phase == "" || $atom == ""} return |
---|
| 105 | |
---|
| 106 | # make a list of atoms involved in angles |
---|
| 107 | set alist {} |
---|
| 108 | foreach a [array names angarr ${phase}P${atom}:*] { |
---|
| 109 | foreach {c i j} [split $a :] {} |
---|
| 110 | if {[lsearch $alist $i] == -1} {lappend alist $i} |
---|
| 111 | if {[lsearch $alist $j] == -1} {lappend alist $j} |
---|
| 112 | } |
---|
| 113 | set alist [lsort $alist] |
---|
| 114 | # make a list of atoms in distances |
---|
| 115 | set dlist $dislist(${phase}P$atom) |
---|
| 116 | |
---|
| 117 | # set overall heading |
---|
| 118 | set CIFselect(boxhead) \ |
---|
| 119 | "Distances and angles around atom [labelatom $phase $atom]" |
---|
| 120 | |
---|
[729] | 121 | grid [frame $frame.a] -row 1 -column 0 -columnspan 99 |
---|
[640] | 122 | foreach {tbox bbox sbox cbox} [MakeScrollTable $frame.a] {} |
---|
| 123 | [winfo parent $bbox] config -width 550 -height 300 |
---|
| 124 | |
---|
| 125 | # column labels |
---|
| 126 | set row 0 |
---|
| 127 | grid [label $tbox.$row-2 -text distance \ |
---|
[729] | 128 | -width $width] -row $row -column 2 |
---|
[640] | 129 | set col 3 |
---|
| 130 | foreach l $alist { |
---|
| 131 | # skip last entry |
---|
| 132 | if {$l == [lindex $alist end]} continue |
---|
| 133 | incr col |
---|
| 134 | grid [label $tbox.$row-$col -text [labelatom $phase $l] \ |
---|
[729] | 135 | -width $width] -row $row -column $col |
---|
[640] | 136 | incr col |
---|
| 137 | } |
---|
| 138 | |
---|
| 139 | # angle/distance entries |
---|
| 140 | set i -1 |
---|
| 141 | set row -1 |
---|
| 142 | foreach l $alist { |
---|
| 143 | incr row |
---|
| 144 | set col 0 |
---|
| 145 | grid [label $sbox.$row-l -text [labelatom $phase $l]] \ |
---|
[729] | 146 | -row $row -column $col |
---|
[640] | 147 | incr col 2 |
---|
| 148 | set dist [eval formatSU $disarr(${phase}P${atom}:$l)] |
---|
| 149 | grid [label $bbox.$row-d -text $dist -width $width] \ |
---|
[729] | 150 | -row $row -column $col -sticky ew |
---|
[640] | 151 | ColorWidget $bbox.$row-d $disflag(${phase}P${atom}:$l) |
---|
| 152 | set widget($bbox.$row-d) ${phase}P${atom}:$l |
---|
| 153 | |
---|
| 154 | foreach a [lrange $alist 0 $i] { |
---|
| 155 | set angle {} |
---|
| 156 | catch { |
---|
| 157 | set angle $angarr(${phase}P${atom}:$l:$a) |
---|
| 158 | set index ${phase}P${atom}:$l:$a |
---|
| 159 | } |
---|
| 160 | catch { |
---|
| 161 | set angle $angarr(${phase}P${atom}:$a:$l) |
---|
| 162 | set index ${phase}P${atom}:$a:$l |
---|
| 163 | } |
---|
| 164 | if {$angle != ""} { |
---|
| 165 | set atxt [eval formatSU $angle] |
---|
| 166 | incr col 2 |
---|
| 167 | grid [label $bbox.$row-$col -text $atxt -width $width] \ |
---|
[729] | 168 | -row $row -column $col -sticky ew |
---|
[640] | 169 | ColorWidget $bbox.$row-$col $angflag($index) |
---|
| 170 | set widget($bbox.$row-$col) $index |
---|
| 171 | } else { |
---|
| 172 | incr col |
---|
| 173 | } |
---|
| 174 | } |
---|
| 175 | incr i |
---|
| 176 | } |
---|
| 177 | foreach l [lsort $dlist] { |
---|
| 178 | if {[lsearch $alist $l] != -1} continue |
---|
| 179 | incr row |
---|
| 180 | set col 0 |
---|
| 181 | grid [label $sbox.$row-l -text [labelatom $phase $l]] \ |
---|
[729] | 182 | -row $row -column $col |
---|
[640] | 183 | set dist [eval formatSU $disarr(${phase}P${atom}:$l)] |
---|
| 184 | incr col 2 |
---|
| 185 | grid [label $bbox.$row-d -text $dist -width $width] \ |
---|
[729] | 186 | -row $row -column $col -sticky ew |
---|
[640] | 187 | ColorWidget $bbox.$row-d $disflag(${phase}P${atom}:$l) |
---|
| 188 | set widget($bbox.$row-d) ${phase}P${atom}:$l |
---|
| 189 | } |
---|
| 190 | foreach n [array names widget] { |
---|
| 191 | bind $n <1> {SetWidgetFlag %W} |
---|
| 192 | } |
---|
| 193 | |
---|
| 194 | #grid columnconfigure $bbox 1 -minsize 5 |
---|
| 195 | #grid columnconfigure $tbox 1 -minsize 5 |
---|
| 196 | set col 3 |
---|
| 197 | foreach l $alist { |
---|
| 198 | # skip last entry |
---|
| 199 | if {$l == [lindex $alist end]} continue |
---|
| 200 | grid columnconfigure $bbox $col -minsize 5 |
---|
| 201 | grid columnconfigure $tbox $col -minsize 5 |
---|
| 202 | incr col 2 |
---|
| 203 | } |
---|
| 204 | update |
---|
| 205 | ResizeScrollTable $frame.a |
---|
| 206 | update |
---|
| 207 | ExpandScrollTable $frame.a |
---|
| 208 | } |
---|
| 209 | |
---|
| 210 | # create a file with all distances and angles as a trianglar matrix |
---|
| 211 | proc ExportDistAngMatrix {} { |
---|
| 212 | global disarr dislist disflag angarr angflag widget CIFselect expmap |
---|
| 213 | set phase $CIFselect(phase) |
---|
| 214 | if {$phase == ""} return |
---|
| 215 | |
---|
| 216 | set file [tk_getSaveFile \ |
---|
| 217 | -filetypes {{spreadsheet .csv}} -defaultextension .csv \ |
---|
| 218 | -parent .] |
---|
| 219 | if {$file == ""} return |
---|
| 220 | set fp [open $file w] |
---|
| 221 | # overall heading |
---|
| 222 | puts $fp "Distances and angles around atoms in phase $phase" |
---|
| 223 | |
---|
| 224 | foreach atom $expmap(atomlist_$phase) { |
---|
| 225 | |
---|
| 226 | # make a list of atoms involved in angles |
---|
| 227 | set alist {} |
---|
| 228 | foreach a [array names angarr ${phase}P${atom}:*] { |
---|
| 229 | foreach {c i j} [split $a :] {} |
---|
| 230 | if {[lsearch $alist $i] == -1} {lappend alist $i} |
---|
| 231 | if {[lsearch $alist $j] == -1} {lappend alist $j} |
---|
| 232 | } |
---|
| 233 | set alist [lsort $alist] |
---|
| 234 | # make a list of atoms in distances |
---|
| 235 | set dlist $dislist(${phase}P$atom) |
---|
| 236 | |
---|
| 237 | # atom heading |
---|
| 238 | puts $fp "\nDistances and angles around atom [labelatom $phase $atom]" |
---|
| 239 | |
---|
| 240 | # column labels |
---|
| 241 | puts -nonewline $fp ",distance" |
---|
| 242 | foreach l $alist { |
---|
| 243 | # skip last entry |
---|
| 244 | if {$l == [lindex $alist end]} continue |
---|
| 245 | puts -nonewline $fp ",[labelatom $phase $l]" |
---|
| 246 | } |
---|
| 247 | puts $fp "" |
---|
| 248 | |
---|
| 249 | # angle/distance entries |
---|
| 250 | set i -1 |
---|
| 251 | foreach l $alist { |
---|
| 252 | set dist [eval formatSU $disarr(${phase}P${atom}:$l)] |
---|
| 253 | puts -nonewline $fp "[labelatom $phase $l],$dist" |
---|
| 254 | foreach a [lrange $alist 0 $i] { |
---|
| 255 | set angle {} |
---|
| 256 | catch { |
---|
| 257 | set angle $angarr(${phase}P${atom}:$l:$a) |
---|
| 258 | } |
---|
| 259 | catch { |
---|
| 260 | set angle $angarr(${phase}P${atom}:$a:$l) |
---|
| 261 | } |
---|
| 262 | if {$angle != ""} { |
---|
| 263 | set atxt [eval formatSU $angle] |
---|
| 264 | puts -nonewline $fp ",$atxt" |
---|
| 265 | } |
---|
| 266 | } |
---|
| 267 | puts $fp "" |
---|
| 268 | incr i |
---|
| 269 | } |
---|
| 270 | } |
---|
| 271 | |
---|
| 272 | foreach l [lsort $dlist] { |
---|
| 273 | if {[lsearch $alist $l] != -1} continue |
---|
| 274 | set dist [eval formatSU $disarr(${phase}P${atom}:$l)] |
---|
| 275 | puts $fp "[labelatom $phase $l],$dist" |
---|
| 276 | } |
---|
| 277 | close $fp |
---|
| 278 | } |
---|
| 279 | |
---|
| 280 | # set the color for a distance/angle entry |
---|
| 281 | proc ColorWidget {widget flag} { |
---|
| 282 | if {$flag} { |
---|
| 283 | $widget config -bg yellow |
---|
| 284 | } else { |
---|
| 285 | $widget config -bg white |
---|
| 286 | } |
---|
| 287 | } |
---|
| 288 | |
---|
| 289 | # respond to a mouse click on a distance or angle label |
---|
| 290 | proc SetWidgetFlag {W} { |
---|
| 291 | global widget CIFselect angflag disflag |
---|
| 292 | set index $widget($W) |
---|
| 293 | # angle or distance? |
---|
| 294 | incr CIFselect(changes) |
---|
| 295 | if {[regexp {[0-9]P[0-9]+:.+:.+} $index]} { |
---|
| 296 | # angle |
---|
| 297 | if {$CIFselect(click) == "set"} { |
---|
| 298 | set angflag($index) 1 |
---|
| 299 | } elseif {$CIFselect(click) == "clear"} { |
---|
| 300 | set angflag($index) 0 |
---|
| 301 | } else { |
---|
| 302 | set angflag($index) [expr ! $angflag($index)] |
---|
| 303 | } |
---|
| 304 | ColorWidget $W $angflag($index) |
---|
| 305 | } else { |
---|
| 306 | # distance |
---|
| 307 | if {$CIFselect(click) == "set"} { |
---|
| 308 | set disflag($index) 1 |
---|
| 309 | } elseif {$CIFselect(click) == "clear"} { |
---|
| 310 | set disflag($index) 0 |
---|
| 311 | } else { |
---|
| 312 | set disflag($index) [expr ! $disflag($index)] |
---|
| 313 | } |
---|
| 314 | ColorWidget $W $disflag($index) |
---|
| 315 | if {$CIFselect(select) == "yes"} { |
---|
| 316 | # get atom |
---|
| 317 | set atom [lindex [split $index :] end] |
---|
| 318 | foreach n [array names widget] { |
---|
| 319 | set aindex $widget($n) |
---|
| 320 | foreach {c i j} [split $aindex :] {} |
---|
| 321 | # reject distances |
---|
| 322 | if {$j == ""} continue |
---|
| 323 | if {$i == $atom || $j == $atom} { |
---|
| 324 | if {$disflag(${c}:$j) && $disflag(${c}:$i)} { |
---|
| 325 | set angflag($aindex) 1 |
---|
| 326 | ColorWidget $n 1 |
---|
| 327 | } else { |
---|
| 328 | set angflag($aindex) 0 |
---|
| 329 | ColorWidget $n 0 |
---|
| 330 | } |
---|
| 331 | } |
---|
| 332 | } |
---|
| 333 | } |
---|
| 334 | } |
---|
| 335 | } |
---|
| 336 | |
---|
| 337 | # respond to a selection of a phase |
---|
| 338 | proc SelectPhase {} { |
---|
| 339 | global CIFselect expmap |
---|
| 340 | $CIFselect(atomlist) delete 0 end |
---|
| 341 | foreach atom $expmap(atomlist_$CIFselect(phase)) { |
---|
| 342 | $CIFselect(atomlist) insert end [atominfo $CIFselect(phase) $atom label] |
---|
| 343 | } |
---|
| 344 | FillDistAngMatrix "" "" |
---|
| 345 | } |
---|
| 346 | |
---|
| 347 | # respond to the selection of an angle |
---|
| 348 | proc SelectAtom {} { |
---|
| 349 | global CIFselect expmap |
---|
| 350 | # get selected atom |
---|
| 351 | set atomnum [lindex $expmap(atomlist_$CIFselect(phase)) \ |
---|
| 352 | [$CIFselect(atomlist) curselection]] |
---|
| 353 | FillDistAngMatrix $CIFselect(phase) $atomnum |
---|
| 354 | } |
---|
| 355 | |
---|
| 356 | # resize the window |
---|
| 357 | proc ConfigureCommand {win frame} { |
---|
| 358 | set cmd [bind $win <Configure>] |
---|
| 359 | if {$cmd == ""} return |
---|
| 360 | bind $win <Configure> {} |
---|
| 361 | update |
---|
| 362 | if {[winfo exists $frame]} {ExpandScrollTable $frame} |
---|
| 363 | update idletasks |
---|
| 364 | after idle "bind $win <Configure> [list $cmd]" |
---|
| 365 | } |
---|
| 366 | |
---|
| 367 | # write the distance & angle flags to a file |
---|
| 368 | proc SaveFlags {expnam} { |
---|
| 369 | global symlist disflag angflag CIFselect |
---|
| 370 | file rename -force ${expnam}.DISAGL ${expnam}.DISold |
---|
| 371 | set fp [open ${expnam}.DISold r] |
---|
| 372 | set out [open ${expnam}.DISAGL w] |
---|
| 373 | gets $fp line |
---|
| 374 | puts $out $line |
---|
| 375 | while {[gets $fp line] >= 0} { |
---|
| 376 | set phase [lindex $line 1] |
---|
| 377 | if {[lindex $line 2] == 0} { |
---|
| 378 | # distance |
---|
| 379 | set center [lindex $line 5] |
---|
| 380 | set a1 [lindex $line 6] |
---|
| 381 | set a1l ${phase}P$a1 |
---|
| 382 | set sym [lindex $line 7]_[lindex $line 8] |
---|
| 383 | set i [lsearch $symlist($a1l) $sym] |
---|
| 384 | incr i |
---|
| 385 | set atom1 ${a1}_[codenumber $i] |
---|
| 386 | catch { |
---|
| 387 | if {$disflag(${phase}P${center}:$atom1)} { |
---|
| 388 | set line [string replace $line 0 0 Y] |
---|
| 389 | } else { |
---|
| 390 | set line [string replace $line 0 0 N] |
---|
| 391 | } |
---|
| 392 | } |
---|
| 393 | } elseif {[lindex $line 2] == 1} { |
---|
| 394 | # angle |
---|
| 395 | set center [lindex $line 6] |
---|
| 396 | set a1 [lindex $line 5] |
---|
| 397 | set a1l ${phase}P$a1 |
---|
| 398 | set a2 [lindex $line 7] |
---|
| 399 | set a2l ${phase}P$a2 |
---|
| 400 | set sym1 [lindex $line 8]_[lindex $line 9] |
---|
| 401 | set sym2 [lindex $line 10]_[lindex $line 11] |
---|
| 402 | set i [lsearch $symlist($a1l) $sym1] |
---|
| 403 | incr i |
---|
| 404 | set atom1 ${a1}_[codenumber $i] |
---|
| 405 | set i [lsearch $symlist($a2l) $sym2] |
---|
| 406 | incr i |
---|
| 407 | set atom2 ${a2}_[codenumber $i] |
---|
| 408 | catch { |
---|
| 409 | if {$angflag(${phase}P${center}:${atom1}:${atom2})} { |
---|
| 410 | set line [string replace $line 0 0 Y] |
---|
| 411 | } else { |
---|
| 412 | set line [string replace $line 0 0 N] |
---|
| 413 | } |
---|
| 414 | } |
---|
| 415 | } |
---|
| 416 | puts $out $line |
---|
| 417 | } |
---|
| 418 | close $fp |
---|
| 419 | close $out |
---|
| 420 | } |
---|
| 421 | |
---|
| 422 | # respond to the Exit button |
---|
| 423 | proc SaveAndExit {expnam} { |
---|
| 424 | global CIFselect |
---|
| 425 | if {$CIFselect(changes) > 0} { |
---|
| 426 | set ans [MyMessageBox -parent . -title "Save?" \ |
---|
| 427 | -message "You have made $CIFselect(changes) changes to publication flags. Do you want to save them and exit; quit without saving; or cancel the exit request?" \ |
---|
| 428 | -icon question -type {Save Quit Cancel} -default Save] |
---|
| 429 | if {[string tolower $ans] == "cancel"} return |
---|
| 430 | if {[string tolower $ans] == "save"} {SaveFlags $expnam} |
---|
| 431 | } |
---|
| 432 | destroy $CIFselect(seltop) |
---|
| 433 | destroy $CIFselect(seldisplay) |
---|
| 434 | wm deiconify . |
---|
| 435 | } |
---|
| 436 | |
---|
| 437 | # start the CIFselect procedure to select distances and angles |
---|
| 438 | proc CIFselect {expfile} { |
---|
| 439 | # check if file exists |
---|
| 440 | set expnam [file root $expfile] |
---|
| 441 | if {![file exists ${expnam}.DISAGL]} { |
---|
| 442 | MyMessageBox -parent . -title "No DISAGL file" \ |
---|
| 443 | -message "No distances/angles to select: file ${expnam}.DISAGL was not found. Have you run DISAGL?" \ |
---|
| 444 | -icon warning -type Quit -default Quit |
---|
| 445 | return |
---|
| 446 | } |
---|
| 447 | |
---|
| 448 | global expmap labelarr symlist disarr dislist angarr disflag angflag CIFselect |
---|
| 449 | catch { |
---|
| 450 | unset labelarr |
---|
| 451 | unset symlist |
---|
| 452 | unset disarr |
---|
| 453 | unset dislist |
---|
| 454 | unset angarr |
---|
| 455 | unset disflag |
---|
| 456 | unset angflag |
---|
| 457 | } |
---|
| 458 | |
---|
| 459 | foreach phase $expmap(phaselist) { |
---|
| 460 | foreach atom $expmap(atomlist_$phase) { |
---|
| 461 | set labelarr(${phase}P${atom}) [atominfo $phase $atom label] |
---|
| 462 | } |
---|
| 463 | } |
---|
| 464 | |
---|
| 465 | # open file & skip 1st line |
---|
| 466 | set fp [open ${expnam}.DISAGL r] |
---|
| 467 | gets $fp line |
---|
| 468 | # process the rest |
---|
| 469 | while {[gets $fp line] >= 0} { |
---|
| 470 | set phase [lindex $line 1] |
---|
| 471 | if {[lindex $line 2] == 0} { |
---|
| 472 | # distance |
---|
| 473 | set center [lindex $line 5] |
---|
| 474 | set a1 [lindex $line 6] |
---|
| 475 | set a1l ${phase}P$a1 |
---|
| 476 | set sym [lindex $line 7]_[lindex $line 8] |
---|
| 477 | if {[catch {set symlist($a1l)}]} {set symlist($a1l) $sym} |
---|
| 478 | if {[lsearch $symlist($a1l) $sym] == -1} { |
---|
| 479 | lappend symlist($a1l) $sym |
---|
| 480 | } |
---|
| 481 | set i [lsearch $symlist($a1l) $sym] |
---|
| 482 | incr i |
---|
| 483 | set atom1 ${a1}_[codenumber $i] |
---|
| 484 | lappend dislist(${phase}P${center}) $atom1 |
---|
| 485 | set disarr(${phase}P${center}:$atom1) [lrange $line 3 4] |
---|
| 486 | if {[string tolower [lindex $line 0]] =="y"} { |
---|
| 487 | set disflag(${phase}P${center}:$atom1) 1 |
---|
| 488 | } else { |
---|
| 489 | set disflag(${phase}P${center}:$atom1) 0 |
---|
| 490 | } |
---|
| 491 | } elseif {[lindex $line 2] == 1} { |
---|
| 492 | # angle |
---|
| 493 | set center [lindex $line 6] |
---|
| 494 | set a1 [lindex $line 5] |
---|
| 495 | set a1l ${phase}P$a1 |
---|
| 496 | set a2 [lindex $line 7] |
---|
| 497 | set a2l ${phase}P$a2 |
---|
| 498 | set sym1 [lindex $line 8]_[lindex $line 9] |
---|
| 499 | set sym2 [lindex $line 10]_[lindex $line 11] |
---|
| 500 | foreach sym [list $sym1 $sym2] { |
---|
| 501 | if {[catch {set symlist($a1l)}]} {set symlist($a1l) $sym} |
---|
| 502 | if {[lsearch $symlist($a1l) $sym] == -1} { |
---|
| 503 | lappend symlist($a1l) $sym |
---|
| 504 | } |
---|
| 505 | } |
---|
| 506 | set i [lsearch $symlist($a1l) $sym1] |
---|
| 507 | incr i |
---|
| 508 | set atom1 ${a1}_[codenumber $i] |
---|
| 509 | set i [lsearch $symlist($a2l) $sym2] |
---|
| 510 | incr i |
---|
| 511 | set atom2 ${a2}_[codenumber $i] |
---|
| 512 | set angarr(${phase}P${center}:${atom1}:${atom2}) [lrange $line 3 4] |
---|
| 513 | if {[string tolower [lindex $line 0]] =="y"} { |
---|
| 514 | set angflag(${phase}P${center}:${atom1}:${atom2}) 1 |
---|
| 515 | } else { |
---|
| 516 | set angflag(${phase}P${center}:${atom1}:${atom2}) 0 |
---|
| 517 | } |
---|
| 518 | } |
---|
| 519 | } |
---|
| 520 | close $fp |
---|
| 521 | # no changes yet |
---|
| 522 | set CIFselect(changes) 0 |
---|
| 523 | |
---|
| 524 | # create the GUI |
---|
| 525 | set top .seldis |
---|
| 526 | set CIFselect(seltop) $top |
---|
| 527 | catch {destroy $top} |
---|
| 528 | toplevel $top |
---|
| 529 | wm title $top "Selection modes" |
---|
| 530 | bind $top <Key-F1> "MakeWWWHelp gsas2cif.html cifselect" |
---|
| 531 | |
---|
[729] | 532 | grid [frame $top.mode -bd 4 -relief groove] -row 1 -column 1 -sticky news |
---|
[640] | 533 | grid [label $top.mode.l -text "Response to Mouse click:"] \ |
---|
[729] | 534 | -row 1 -column 0 -columnspan 99 |
---|
[640] | 535 | set col 1 |
---|
| 536 | foreach val {Toggle Set Clear} { |
---|
| 537 | grid [radiobutton $top.mode.r$col -text $val \ |
---|
| 538 | -variable CIFselect(click) \ |
---|
[729] | 539 | -value [string tolower $val]] -row 2 -column $col |
---|
[640] | 540 | incr col |
---|
| 541 | } |
---|
| 542 | |
---|
[729] | 543 | grid [frame $top.sel -bd 4 -relief groove] -row 2 -column 1 -sticky news |
---|
[640] | 544 | grid [label $top.sel.l -text "Distance selection: select matching angles?"] \ |
---|
[729] | 545 | -row 1 -column 1 -columnspan 3 |
---|
[640] | 546 | set col 1 |
---|
| 547 | foreach val {Yes No} { |
---|
| 548 | grid [radiobutton $top.sel.r$col -text $val \ |
---|
| 549 | -variable CIFselect(select) \ |
---|
[729] | 550 | -value [string tolower $val]] -row 2 -column $col |
---|
[640] | 551 | incr col |
---|
| 552 | } |
---|
| 553 | |
---|
[729] | 554 | grid [frame $top.ph -bd 4 -relief groove] -row 1 -column 0 -sticky news |
---|
| 555 | grid [label $top.ph.h -text "Select phase"] -row 1 -column 0 -columnspan 99 |
---|
[640] | 556 | set col 0 |
---|
| 557 | foreach phase $expmap(phaselist) { |
---|
| 558 | grid [radiobutton $top.ph.r$col -text $phase \ |
---|
| 559 | -variable CIFselect(phase) \ |
---|
| 560 | -command SelectPhase \ |
---|
[729] | 561 | -value $phase] -row 2 -column $col |
---|
[640] | 562 | incr col |
---|
| 563 | } |
---|
| 564 | grid columnconfigure $top 0 -weight 1 |
---|
| 565 | grid rowconfigure $top 3 -weight 1 |
---|
| 566 | |
---|
| 567 | grid [frame $top.atom -bd 4 -relief groove] \ |
---|
[729] | 568 | -row 2 -rowspan 2 -column 0 -sticky news |
---|
| 569 | grid [label $top.atom.h -text "Select atom"] -row 1 -column 0 -columnspan 99 |
---|
[640] | 570 | set CIFselect(atomlist) $top.atom.lbox |
---|
| 571 | grid columnconfigure $top.atom 0 -weight 1 |
---|
| 572 | grid rowconfigure $top.atom 2 -weight 1 |
---|
| 573 | grid [listbox $top.atom.lbox -height 4 -width 10 \ |
---|
| 574 | -exportselection 0 -yscrollcommand " $top.atom.rscr set"\ |
---|
| 575 | ] -row 2 -column 0 -sticky news |
---|
| 576 | grid [scrollbar $top.atom.rscr -command "$top.atom.lbox yview" \ |
---|
| 577 | ] -row 2 -column 1 -sticky ns |
---|
| 578 | bind $top.atom.lbox <<ListboxSelect>> SelectAtom |
---|
| 579 | |
---|
[729] | 580 | grid [frame $top.bt] -row 3 -column 1 -sticky news |
---|
[640] | 581 | button $top.bt.save -command "SaveFlags $expnam" -text Save |
---|
| 582 | button $top.bt.export -command ExportDistAngMatrix -text "Export Tables" |
---|
| 583 | button $top.bt.exit -command "SaveAndExit $expnam" -text Exit |
---|
| 584 | grid $top.bt.save $top.bt.export $top.bt.exit -pad 5 -sticky s |
---|
| 585 | grid columnconfig $top.bt 1 -weight 1 |
---|
| 586 | grid rowconfig $top.bt 0 -weight 1 |
---|
| 587 | |
---|
| 588 | set CIFselect(seldisplay) .selshow |
---|
| 589 | catch {destroy $CIFselect(seldisplay)} |
---|
| 590 | toplevel $CIFselect(seldisplay) |
---|
| 591 | wm title $CIFselect(seldisplay) "Distance & Angle Table" |
---|
| 592 | bind $CIFselect(seldisplay) <Key-F1> "MakeWWWHelp gsas2cif.html cifselect" |
---|
| 593 | FillDistAngMatrix "" "" |
---|
| 594 | |
---|
| 595 | bind $CIFselect(seldisplay) <Configure> { |
---|
| 596 | ConfigureCommand %W $CIFselect(seldisplay).a |
---|
| 597 | } |
---|
| 598 | |
---|
| 599 | wm iconify . |
---|
| 600 | # select the first phase |
---|
| 601 | set CIFselect(phase) [lindex $expmap(phaselist) 0] |
---|
| 602 | SelectPhase |
---|
| 603 | } |
---|
| 604 | |
---|
| 605 | set CIFselect(click) set |
---|
| 606 | set CIFselect(select) yes |
---|
| 607 | |
---|