source: trunk/export_xml.tcl @ 672

Last change on this file since 672 was 672, checked in by toby, 11 years ago

# on 2003/04/10 22:12:41, toby did:
fix missing tag

  • Property rcs:author set to toby
  • Property rcs:date set to 2003/04/10 22:12:41
  • Property rcs:lines set to +2 -1
  • Property rcs:rev set to 1.2
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 4.4 KB
Line 
1# $Id: export_xml.tcl 672 2009-12-04 23:10:05Z toby $
2# set local variables that define the proc to execute and the menu label
3set label "FOX .xml format"
4set action exp2xml
5# write coordinates in an MSI .xtl file
6proc exp2xml {} {
7    global expmap expgui
8    # don't bother if there are no phases to write
9    if {[llength $expmap(phaselist)] == 0} {
10        MyMessageBox -parent . -title "No phases" \
11                -message "Sorry, no phases are present to write" \
12                -icon warning
13        return
14    }
15    #------------------------------------------------------------------
16    if [catch {
17        set filnam [file rootname $expgui(expfile)].xml
18        set fp [open $filnam w]
19        puts $fp "<ObjCryst Date=\"[clock format [clock seconds] -format "%Y-%m-%dT%T"]\">"
20        foreach phase $expmap(phaselist) phasetype $expmap(phasetype) {
21            set name [file rootname $expgui(expfile)]_phase${phase}
22            set spacegroup [phaseinfo $phase spacegroup]
23            # remove final R from rhombohedral space groups
24            if {[string toupper [string range $spacegroup end end]] == "R"} {
25                set spacegroup [string range $spacegroup 0 \
26                        [expr [string length $spacegroup]-2]] 
27            }
28            # remove spaces from space group
29            regsub -all " " $spacegroup "" spacegroup
30            puts $fp "  <Crystal Name=\"${name}\" SpaceGroup=\"${spacegroup}\">"
31            set min 1
32            set max 100
33            foreach var {a b c alpha beta gamma} {
34                if {$var == "alpha"} {
35                    set min 28.6479
36                    set max 171.887
37                }
38                set value [phaseinfo $phase $var]
39                puts $fp "<Par Refined=\"0\" Limited=\"1\" Min=\"${min}\" Max=\"${max}\" Name=\"${var}\">${value}</Par>"
40            }
41            puts $fp {<Option Name="Use Dynamical Occupancy Correction" Choice="1" ChoiceName="Yes"/>}
42           
43            if {$phasetype == 4} {
44                set cmd mmatominfo
45            } else {
46                set cmd atominfo
47            }
48            set scatblock {     
49    <ScatteringPowerAtom Name="${label}" Symbol="${elem}">
50            <Par Refined="0" Limited="1" Min="0.1" Max="5" Name="Biso">${Biso}</Par>
51            <RGBColour>$color</RGBColour>
52            </ScatteringPowerAtom>}
53
54            set i -1
55            foreach atom $expmap(atomlist_$phase) {
56                # cycle through colors for now
57                set color [lindex {"1 1 1" "1 0 0" "0 1 0" "0 0 1" "1 1 0" "0 1 1" "1 0 1"} [expr [incr i] % 7]]
58                set label [$cmd $phase $atom label]
59                set Biso [expr 8 * 3.14159 * 3.14159 * [$cmd $phase $atom Uiso]]
60                set elem [$cmd $phase $atom type]
61                puts $fp [subst $scatblock]
62            }
63            set scatblock {
64      <Atom Name="${label}" ScattPow="${label}">
65            <Par Refined="1" Limited="0" Min="0" Max="1" Name="x">${x}</Par>
66            <Par Refined="1" Limited="0" Min="0" Max="1" Name="y">${y}</Par>
67            <Par Refined="1" Limited="0" Min="0" Max="1" Name="z">${z}</Par>
68            <Par Refined="0" Limited="1" Min="0.01" Max="1" Name="Occup">${frac}</Par>
69            </Atom>}
70
71            foreach atom $expmap(atomlist_$phase) {
72                set label [$cmd $phase $atom label]
73                foreach var {x y z frac} {
74                    set $var  [$cmd $phase $atom $var]
75                }
76                puts $fp [subst $scatblock]
77            }
78            puts $fp {</Crystal>}
79        }
80        puts $fp {</ObjCryst>}
81        close $fp
82    } errmsg] {
83        MyMessageBox -parent . -title "Export error" \
84                -message "Export error: $errmsg" -icon warning
85    } else {
86        MyMessageBox -parent . -title "Done" \
87                -message "File [file tail $filnam] was written"
88    }
89}
90
91# process the spacegroup whenever the phase is changed
92proc MSI_SP_convert {args} {
93    global expgui
94    set phase 0
95    catch {set phase $expgui(export_phase)}
96    if {$phase == 0} return
97    set spacegroup [phaseinfo $phase spacegroup]
98    set expgui(export_rhomb) 0
99    # remove final R from rhombohedral space groups
100    if {[string toupper [string range $spacegroup end end]] == "R"} {
101        set expgui(export_rhomb) 1
102        set spacegroup [string range $spacegroup 0 \
103                [expr [string length $spacegroup]-2]] 
104    }
105    # remove spaces from space group
106    regsub -all " " $spacegroup "" spacegroup
107    set expgui(export_sg) $spacegroup
108    set expgui(export_orig) 0
109    # scan through the Origin 1/2 spacegroups for a match
110    set spacegroup [string toupper $spacegroup]
111    # treat bar 3 as the same as 3 (Fd3m <==> Fd-3m)
112    regsub -- "-3" $spacegroup "3" spacegroup
113    set fp [open [file join $expgui(scriptdir) spacegrp.ref] r]
114    # skip over the first section of file
115    set line 0
116    while {[lindex $line 1] != 230} {
117        if {[gets $fp line] < 0} return
118    }
119    while {[gets $fp line] >= 0} {
120        set testsg [string toupper [lindex $line 8]]
121        regsub -all " " $testsg "" testsg
122        regsub -- "-3" $testsg "3" testsg
123        if {$spacegroup == $testsg} {
124            set expgui(export_orig) 1
125            break
126        }
127    }
128    close $fp
129}
Note: See TracBrowser for help on using the repository browser.