source: trunk/addcmds.tcl @ 853

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

# on 2005/12/16 00:36:40, toby did:
make spacegroup search case insensitive on Origin 1/2
comment out debug puts statements

  • Property rcs:author set to toby
  • Property rcs:date set to 2005/12/16 00:36:40
  • Property rcs:lines set to +5 -5
  • Property rcs:rev set to 1.38
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 72.4 KB
RevLine 
[92]1# $Id: addcmds.tcl 853 2009-12-04 23:13:10Z toby $
2
[447]3#----------- Add Phase routines ----------------------------------------
4
[92]5proc MakeAddPhaseBox {} {
[383]6    global expmap expgui
[92]7
[268]8    set expgui(coordList) {}
[92]9    set nextphase ""
10    foreach p {1 2 3 4 5 6 7 8 9} {
11        if {[lsearch $expmap(phaselist) $p] == -1} {
12            set nextphase $p
13            break
14        }
15    }
16
17    # no more room
18    if {$nextphase == ""} {
[383]19        MyMessageBox -parent . -title "Add Phase Error" \
20                -message "There are already 9 phases. You cannot add more." \
21                -icon error
[92]22        return
23    }
24
25    set np .newphase
26    catch {destroy $np}
27    toplevel $np
[321]28    bind $np <Key-F1> "MakeWWWHelp expgui2.html addphase"
[92]29
30    grid [label $np.l1 -text "Adding phase #$nextphase"] \
31            -column 0 -row 0 -sticky w
32    grid [label $np.l2 -text "Phase title:"] -column 0 -row 1 
33    grid [entry $np.t1 -width 68] -column 1 -row 1 -columnspan 8
34    grid [label $np.l3 -text "Space Group:"] -column 0 -row 2 
35    grid [entry $np.t2 -width 12] -column 1 -row 2 
36    grid [frame $np.f -bd 4 -relief groove] -column 3 -row 2 -columnspan 8
37    set col -1
38    foreach i {a b c} {
[268]39        grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
[92]40        grid [entry $np.f.e1$i -width 12] -column [incr col]  -row 1
41    }
42    set col -1
43    foreach i {a b g} {
[413]44        grid [label $np.f.l2$i -text $i] -column [incr col] -row 2
45        set font [$np.f.l2$i cget -font]
46        $np.f.l2$i config -font "Symbol [lrange $font 1 end]"
[92]47        grid [entry $np.f.e2$i -width 12] -column [incr col]  -row 2
48        $np.f.e2$i insert 0 90.
49    }   
50   
[268]51    grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew
52    grid [button $np.bf.b1 -text Add \
[92]53            -command "addphase $np"] -column 2 -row 3
54    bind $np <Return> "addphase $np"
[268]55    grid [button $np.bf.b2 -text Cancel \
[92]56            -command "destroy $np"] -column 3 -row 3
[268]57    grid columnconfig $np.bf 4 -weight 1
[321]58    grid [button $np.bf.help -text Help -bg yellow \
59            -command "MakeWWWHelp expgui2.html addphase"] \
60            -column 4 -row 3
[268]61
62    # get the input formats if not already defined
63    GetImportFormats
64    if {[llength $expgui(importFormatList)] > 0} {
65        grid [frame $np.bf.fr -bd 4 -relief groove] -column 5 -row 3
66        grid [button $np.bf.fr.b3 -text "Import phase from: " \
67                -command "ImportPhase \$expgui(importFormat) $np"] \
68                -column 0 -row 0 -sticky e
[553]69        set menu [eval tk_optionMenu $np.bf.fr.b4 expgui(importFormat) \
70                $expgui(importFormatList)]
71        for {set i 0} {$i <= [$menu index end]} {incr i} {
72            $menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $np"
73        }
[268]74        grid $np.bf.fr.b4 -column 1 -row 0 -sticky w
75        grid rowconfig $np.bf.fr 0 -pad 10
76        grid columnconfig $np.bf.fr 0 -pad 10
77        grid columnconfig $np.bf.fr 1 -pad 10
78    }
[92]79    wm title $np "add new phase"
80
[326]81    # set grab, etc.
[92]82    putontop $np
[268]83   
[92]84    tkwait window $np
[268]85   
[326]86    # fix grab...
[92]87    afterputontop
88}
89
90proc addphase {np} {
[237]91    global expgui expmap
[92]92    # validate the input
93    set err {}
94    set title [$np.t1 get]
95    if {[string trim $title] == ""} {
96        append err "  Title cannot be blank\n"
97    }
98    set spg [$np.t2 get]
99    if {[string trim $spg] == ""} {
100        append err "  Space group cannot be blank\n"
101    }
102    foreach i {a b c} {
103        set cell($i) [$np.f.e1$i get]
104        if {[string trim $cell($i)] == ""} {
105            append err "  $i cannot be blank\n"
106        } elseif {[catch {expr $cell($i)}]} {
107            append err "  $i is not valid\n"
108        }
109    }
110
111    foreach i {a b g} lbl {alpha beta gamma} {
112        set cell($lbl) [$np.f.e2$i get]
113        if {[string trim $cell($lbl)] == ""} {
114            append err "  $lbl cannot be blank\n"
115        } elseif {[catch {expr $cell($lbl)}]} {
116            append err "  $lbl is not valid\n"
117        }
118    }
119
120    if {$err != ""} {
[383]121        MyMessageBox -parent . -title "Add Phase Error" \
122                -message "The following error(s) were found in your input:\n$err" \
123                -icon error
[378]124        set expgui(oldphaselist) -1
[92]125        return
126    }
127
128    # check the space group
129    set fp [open spg.in w]
130    puts $fp "N"
131    puts $fp "N"
132    puts $fp $spg
133    puts $fp "Q"
134    close $fp
135    global tcl_platform
136    catch {
137        if {$tcl_platform(platform) == "windows"} {
138            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
139        } else {
140            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
141        }
142    }
143    set fp [open spg.out r]
144    set out [read $fp]
145    close $fp
146    # attempt to parse out the output (fix up if parse did not work)
147    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
148            $out a b ] != 1} {set b $out}
149    if {[string first Error $b] != -1} {
150        # got an error, show it
151        ShowBigMessage \
152                 $np.error \
153                 "Error processing space group\nReview error message below" \
[447]154                 $b OK "" 1
[378]155        set expgui(oldphaselist) -1
[92]156        return
157    } else {
158        # show the result and confirm
159        set opt [ShowBigMessage \
160                $np.check \
161                "Check the symmetry operators in the output below" \
162                $b \
163                {Continue Redo} ]
[378]164        if {$opt > 1} {
165            set expgui(oldphaselist) -1
166            return
167        }
[92]168    }
169    file delete spg.in spg.out
170   
171    # ok do it!
172    set fp [open exptool.in w]
173    puts $fp "P"
174    puts $fp $title
175    puts $fp $spg
176    puts $fp "$cell(a) $cell(b) $cell(c) $cell(alpha) $cell(beta) $cell(gamma)"
177    puts $fp "/"
178    close $fp
179    global tcl_platform
180    # Save the current exp file
181    savearchiveexp
182    # disable the file changed monitor
183    set expgui(expModifiedLast) 0
184    set expnam [file root [file tail $expgui(expfile)]]
[268]185    # save the previous phase list
186    set expgui(oldphaselist) $expmap(phaselist)
[92]187    catch {
188        if {$tcl_platform(platform) == "windows"} {
189            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
190                    < exptool.in >& exptool.out
191        } else {
192            exec [file join $expgui(gsasexe) exptool] $expnam \
193                    < exptool.in >& exptool.out
194        }
[113]195    } errmsg
[92]196    # load the revised exp file
[447]197    set oldphaselist $expmap(phaselist)
[92]198    loadexp $expgui(expfile)
199    set fp [open exptool.out r]
200    set out [read $fp]
201    close $fp
202    destroy $np
[447]203    set err 0
204    if {[llength $oldphaselist] == [llength $expmap(phaselist)]} {set err 1}
[113]205    if {$errmsg != ""} {
[447]206        set err 1
[113]207        append errmsg "\n" $out
208    } else {
209        set errmsg $out
210    }
[447]211    if {$expgui(showexptool) || $err} {
212        set msg "Please review the result from adding the phase" 
213        if {$err} {append msg "\nIt appears an error occurred!"}
214        ShowBigMessage $np $msg $errmsg OK "" $err
[321]215    }
[92]216    file delete exptool.in exptool.out
[668]217    # set the powpref warning (2 = required)
218    set expgui(needpowpref) 2
219    set msg "A phase was added" 
220    if {[string first $msg $expgui(needpowpref_why)] == -1} {
221        append expgui(needpowpref_why) "\t$msg\n"
222    }
[237]223    # now select the new phase
224    SelectOnePhase [lindex $expmap(phaselist) end]   
[92]225}
226
[447]227#----------- Add Histogram routines --------------------------------------
[668]228proc LabelInstParm {args} {
229    global newhist
230    switch $newhist(insttype) {
231        TOF {
232            set newhist(instfiletext) "Neutron Time of Flight"
233            catch {
234                set b $newhist(setnum)
235                append newhist(instfiletext) ", 2theta = $newhist(inst${b}Angle)"
236            }
237        }
238        ED {set newhist(instfiletext) "X-ray Energy Dispersive"}
239        "CW X" {set newhist(instfiletext) "CW X-ray"}
240        "CW N" {set newhist(instfiletext) "CW Neutron"}
241    }
242}
243trace variable newhist(setnum) w LabelInstParm
[92]244proc MakeAddHistBox {} {
245    global expmap newhist
246
247    # --> should check here if room for another histogram, but only texture
248    # folks will ever need that
249
250    set np .newhist
251    catch {destroy $np}
252    toplevel $np
[321]253    bind $np <Key-F1> "MakeWWWHelp expgui3.html AddHist"
[92]254
[447]255    grid [label $np.l0 -text "Adding a new histogram"] \
[92]256            -column 0 -row 0 -sticky ew -columnspan 7
[447]257    grid [checkbutton $np.d0 -text "Dummy Histogram" -variable newhist(dummy) \
258            -command "PostDummyOpts $np" \
259            ] -column 2 -row 0 -columnspan 99 -sticky e
260    grid [label $np.l1 -text "Data file:"] -column 0 -row 2
[132]261    grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
[447]262            -column 1 -row 2 -columnspan 3 -sticky ew
[92]263    grid [button $np.b1 -text "Select File" \
264            -command "getrawfile $np" \
[447]265            ] -column 4 -row 2
[92]266
[447]267    grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 3 -sticky w
268    grid [frame $np.bank]  -column 2 -row 3 -columnspan 7 -sticky ew
[92]269
[447]270    grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 5
[132]271    grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
[447]272            -column 1 -row 5 -columnspan 3 -sticky ew
[92]273    grid [button $np.b2 -text "Select File" \
274            -command "getinstfile $np" \
[447]275            ] -column 4 -row 5
[694]276    grid [button $np.edit -text "Edit file" \
277            -command {EditInstFile $newhist(instfile)}] \
278            -column 5 -row 5
[92]279
[447]280    grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 6 -sticky w
281    grid [frame $np.set]  -column 2 -row 6 -columnspan 7 -sticky ew
[668]282    grid [label $np.t2a -textvariable newhist(instfiletext) \
283            -justify center -anchor center -fg blue] \
284            -column 0 -row 8 -columnspan 99 -sticky ew
[92]285
[668]286    grid [button $np.f6a -text "Run\nRAWPLOT" -command "RunRawplot $np"] \
287            -column 4 -row 18 -rowspan 2
288    grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 18 -rowspan 3 
[92]289    grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
[668]290            ] -column 1 -row 18 -rowspan 3
[92]291    grid [radiobutton $np.cb3 -text "D-min" -variable newhist(LimitMode) \
[668]292            -value 0] -column 2 -row 18 -sticky w
[447]293    grid [radiobutton $np.cb4 -textvariable newhist(limitLbl)  \
[394]294            -variable newhist(LimitMode) -anchor w -justify l \
[668]295            -value 1] -column 2 -row 20 -sticky w
296    grid [radiobutton $np.cb5 -text "Q-max" -variable newhist(LimitMode) \
297            -value 2] -column 2 -row 19 -sticky w
[447]298    set newhist(limitLbl) "TOF-min\n2-Theta Max"
299    # spacers
300    grid [frame $np.sp0 -bg white] \
301            -columnspan 20 -column 0 -row 1 -sticky nsew -ipady 2
302    grid [frame $np.sp1 -bg white] \
303            -columnspan 20 -column 0 -row 4 -sticky nsew -ipady 2
304    grid [frame $np.sp2 -bg white] \
[668]305            -columnspan 20 -column 0 -row 17 -sticky nsew -ipady 2
[447]306    grid [frame $np.sp3 -bg white] \
307            -columnspan 20 -column 0 -row 98 -sticky nsew -ipady 2
308    grid [frame $np.f6] -column 0 -row 99 -columnspan 5 -sticky ew
[92]309    grid [button $np.f6.b6a -text Add \
310            -command "addhist $np"] -column 0 -row 0
311    bind $np <Return> "addhist $np"
312    grid [button $np.f6.b6b -text Cancel \
313            -command "destroy $np"] -column 1 -row 0
[721]314    grid [button $np.f6.b6c -text "Add multiple banks" \
315            -command "addMultiplehist $np" -state disabled] -column 2 -row 0
[321]316    grid [button $np.f6.help -text Help -bg yellow \
317            -command "MakeWWWHelp expgui3.html AddHist"] \
318            -column 2 -row 0 -sticky e
319    grid columnconfigure $np.f6 2 -weight 1
[447]320    grid columnconfigure $np 3 -weight 1
[167]321
[447]322    # dummy histogram stuff
323    frame $np.d1
[721]324    grid [label $np.d1.l1 -text min] -column 1 -row 1
325    grid [label $np.d1.l2 -text max] -column 2 -row 1
326    grid [label $np.d1.l3 -text step] -column 3 -row 1
327    grid [label $np.d1.lu -text ""] -column 4 -row 1 -rowspan 2
328    grid [entry $np.d1.e1 -width 10 -textvariable newhist(tmin)] -column 1 -row 2
329    grid [entry $np.d1.e2 -width 10 -textvariable newhist(tmax)] -column 2 -row 2
330    grid [entry $np.d1.e3 -width 10 -textvariable newhist(tstep)] -column 3 -row 2
331    grid [label $np.d1.m1 -anchor w] -column 1 -row 3 -sticky ew
332    grid [label $np.d1.m2 -anchor w] -column 2 -row 3 -sticky ew
[447]333    label $np.dl1 -text "Data range:"
334    label $np.dl2 -text "Allowed"
335    label $np.dl3 -text "\n" -justify left -fg blue
[92]336    wm title $np "add new histogram"
337
[447]338    set newhist(banknum) {}
339    set newhist(setnum) {}
[92]340    if {[string trim $newhist(rawfile)] != {}} {
341        validaterawfile $np $newhist(rawfile)
342    }
343    if {[string trim $newhist(instfile)] != {}} {
344        validateinstfile $np $newhist(instfile)
345    }
346
[447]347    PostDummyOpts $np
[326]348    # set grab, etc.
[92]349    putontop $np
350
351    tkwait window $np
352
[326]353    # fix grab...
[92]354    afterputontop
355}
356
357# convert a file to Win-95 direct access
[383]358proc WinCvt {file win} {
[92]359    global expgui
360    if ![file exists $file] {
[383]361        MyMessageBox -parent $win -title "Convert Error" \
362                -message "File $file does not exist" -icon error
[92]363        return
364    }
365
366    set tmpname "[file join [file dirname $file] tempfile.xxx]"
367    set oldname "[file rootname $file].org"
368    if [file exists $oldname] {
[383]369        set ans [MyMessageBox -parent $win -title "OK to overwrite?" \
370                -message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
371                -icon question -type yesno -default yes]
372        if {$ans == "no"} return
[92]373        catch {file delete $oldname}
374    }
375
376    if [catch {
377        set in [open $file r]
378        # needed to test under UNIX
379        set out [open $tmpname w]
380        fconfigure $out -translation crlf
381        set len [gets $in line]
382        if {$len > 160} {
[668]383            # this is an old-style UNIX file. Hope there are no control characters
[92]384            set i 0
385            set j 79
386            while {$j < $len} {
387                puts $out [string range $line $i $j]
388                incr i 80
389                incr j 80
390            }
391        } else {
392            while {$len >= 0} {
393                append line "                                        "
394                append line "                                        "
395                set line [string range $line 0 79]
396                puts $out $line
397                set len [gets $in line]
398            }
399        }
400        close $in
401        close $out
402        file rename $file $oldname
403        file rename $tmpname $file
404    } errmsg] {
[383]405        MyMessageBox -parent $win -title Notify \
406                -message "Error in conversion:\n$errmsg" -icon warning
[92]407    }
408    return $file
409}
410
411proc getrawfile {np} {
412    global newhist tcl_platform
413    if {$tcl_platform(platform) == "windows"} {
414        set inp [
415        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
416            {"Data files" .GSAS} {"Data files" .GSA} 
417            {"Data files" .RAW}  {"All files" *}
418        }
419        ]
420    } else {
421        set inp [
422        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
423            {"Data files" .GSA*} {"Data files" .RAW} 
424            {"Data files" .gsa*} {"Data files" .raw} 
425            {"All files" *}
426        } 
427        ]
428    }
429    validaterawfile $np $inp
430}
431
432proc validaterawfile {np inp} {
[383]433    global expgui newhist
[92]434    if {$inp == ""} return
435    if [catch {set in [open $inp r]}] {
[383]436        MyMessageBox -parent $np -title "Open error" \
437                -message "Unable to open file $inp" -icon error
[92]438        return 
439    }
440    set newhist(banklist) {}
[354]441    foreach child [winfo children $np.bank] {destroy $child}
[92]442    # is this a properly formatted file?
[383]443    # -- are lines the correct length & terminated with a CR-LF?   
444    fconfigure $in -translation lf
445    set i 0
446    while {[set len [gets $in line]] > 0} {
447        incr i
448        if {$len != 81 || [string range $line end end] != "\r"} {
449            set ans [MyMessageBox -parent $np -title "Convert?" \
450                    -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
451                    -icon warning -type {OK Quit} -default OK]
452            if {$ans == "ok"} {
453                # convert and reopen the file
[92]454                close $in
[383]455                WinCvt $inp $np
456                set i 0
[92]457                set in [open $inp r]
[383]458                fconfigure $in -translation lf
[92]459                set line {}
460            } else {
461                return
462            }
463        }
[383]464        # scan for BANK lines
465        if {[string first BANK $line] == 0} {
466            scan $line "BANK%d" num
467            lappend newhist(banklist) $num
468            # compute last point
[394]469            set tmin 0
[383]470            set tmax 0
471            catch {
472                scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step
[394]473                set tmin [expr $start/100.]
[383]474                set tmax [expr ($start + $step*($nchan-1))/100.]
[92]475            }
[394]476            set newhist(tmin$num) $tmin
[383]477            set newhist(tmax$num) $tmax
[92]478        }
[383]479        # check for "Instrument parameter file" line
480        if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
481            validateinstfile $np \
482                    [file join [file dirname $inp] \
483                    [string trim [string range $line 26 end]]]
484        }
[92]485    }
486    # were banks found?
487    if {$newhist(banklist) == ""} {
[383]488        MyMessageBox -parent $np -title "Read error" \
489                -message "File $inp has no BANK lines.\nThis is not a valid GSAS data file." \
490                -icon warning
[92]491        return
492    }
[132]493    # don't use a full path unless needed
494    if {[pwd] == [file dirname $inp]} {
495        set newhist(rawfile) [file tail $inp]
496    } else {
497        set newhist(rawfile) $inp
498    }
[354]499    set row 0
500    set col -1
[92]501    foreach i $newhist(banklist) {
[354]502        if {$col > 8} {
503            set col -1
504            incr row
505        }
506        grid [radiobutton $np.bank.$i -text $i -command SetTmax \
507                -variable newhist(banknum) -value $i] \
508                -column [incr col] -row $row -sticky w
[132]509        # only 1 choice, so set it
[354]510        if {[llength $newhist(banklist)] == 1} {
511            set newhist(banknum) $i
512            SetTmax
513        } else {
514            set newhist(2tLimit) {}
515            set newhist(LimitMode) {}
516        }
[92]517    }
[721]518    SetMultipleAdd $np
[92]519}
520
[354]521proc SetTmax {} {
522    global newhist
523    set num $newhist(banknum)
[394]524    if {$newhist(insttype) == "TOF"} {
[668]525        set newhist(2tLimit) [expr {$newhist(tmin$num) / 10.}]
[394]526        if {[llength $newhist(banklist)] == $newhist(instbanks)} {
527            set newhist(setnum) $newhist(banknum)
528        }
529    } else {
530        set newhist(2tLimit) $newhist(tmax$num)
531    }
[354]532    set newhist(LimitMode) 1
[394]533
[354]534}
535
[92]536proc getinstfile {np} {
537    global newhist tcl_platform
538    if {$tcl_platform(platform) == "windows"} {
539        set inp [
540        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
541            {"Inst files" .INST} {"Inst files" .INS} 
542            {"Inst files" .PRM} {"All files" *}
543        }
544        ]
545    } else {
546        set inp [
547        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
548            {"Inst files" .INS*} {"Inst files" .ins*} 
549            {"Inst files" .PRM}  {"Inst files" .prm} 
550            {"All files" *}
551        }
552        ]
553    }
[447]554    set newhist(setnum) {}
[92]555    validateinstfile $np $inp
556}
557
558proc validateinstfile {np inp} {
[383]559    global expgui newhist
[92]560    if {$inp == ""} return
561    if [catch {set in [open $inp r]}] {
[383]562        MyMessageBox -parent $np -title "Open error" \
563                -message "Unable to open file $inp" -icon error
[92]564        return 
565    }
566    set newhist(instbanks) {}
[354]567    foreach child [winfo children $np.set] {destroy $child}
[92]568    # is this a properly formatted file?
[383]569    # -- are lines the correct length & terminated with a CR-LF?   
570    fconfigure $in -translation lf
571    while {[set len [gets $in line]] > 0} {
572        if {$len != 81 || [string range $line end end] != "\r"} {
573            set ans [MyMessageBox -parent $np -title "Convert?" \
574                    -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
575                    -icon warning -type {OK Quit} -default OK]
576            if {$ans == "ok"} {
577                # convert and reopen the file
[92]578                close $in
[383]579                WinCvt $inp $np
[92]580                set in [open $inp r]
[383]581                fconfigure $in -translation lf
[92]582                set line {}
583            } else {
584                return
585            }
586        }
[383]587        # scan for the INS   BANK line
588        if {[string first "INS   BANK" $line] == 0} {
589            set newhist(instbanks) \
590                    [string trim [string range $line 12 end]]
[92]591        }
[668]592        # scan for the INS   HTYPE line
[394]593        if {[string first "INS   HTYPE" $line] == 0} {
594            if {[string index [lindex $line 2] 2] == "T"} {
595                set newhist(insttype) TOF
596            } elseif {[string index [lindex $line 2] 2] == "E"} {
597                set newhist(insttype) ED
[668]598            } elseif {[string index [lindex $line 2] 1] == "X"} {
599                set newhist(insttype) "CW X"
[394]600            } else {
[668]601                set newhist(insttype) "CW N"
[394]602            }
603        }
[447]604        # scan for the instrument constants
605        if {[regexp {INS ([ 1-9][0-9]) ICONS(.*)} $line a b c]} {
606            set b [string trim $b]
607            set newhist(inst${b}ICONS) [string trim $c]
608        }
609        if {[regexp {INS ([ 1-9][0-9])I ITYP(.*)} $line a b c]} {
610            set b [string trim $b]
611            set newhist(inst${b}ITYP) [string trim $c]
612        }
[668]613        if {[regexp {INS ([ 1-9][0-9])BNKPAR(.*)} $line a b c]} {
614            set b [string trim $b]
615            set newhist(inst${b}Angle) [string trim [lindex $c 1]]
616        }
[92]617    }
618    # were banks found?
619    if {$newhist(instbanks) == ""} {
[383]620        MyMessageBox -parent $np -title "Read error" -message \
621                "File $inp has no \"INS   BANK\" line.\nThis is not a valid GSAS Instrument Parameter file." \
622                -icon warning
[92]623        return
624    }
[132]625    # don't use a full path unless needed
626    if {[pwd] == [file dirname $inp]} {
627        set newhist(instfile) [file tail $inp]
628    } else {
629        set newhist(instfile) $inp
630    }
[354]631    set col -1
632    set row 0
[92]633    for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
[354]634        if {$col > 8} {
635            set col -1
636            incr row
637        }
638        grid [radiobutton $np.set.$i -text $i \
[447]639                -command "PostDummyOpts $np; ValidateDummyHist $np" \
[354]640                -variable newhist(setnum) -value $i] \
641                -column [incr col] -row $row -sticky w
[132]642        if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
[92]643    }
[447]644    if {$newhist(dummy)} {PostDummyOpts $np; ValidateDummyHist $np}
[668]645    LabelInstParm
[721]646    SetMultipleAdd $np
[92]647}
648
649proc addhist {np} {
[447]650    global expgui newhist tcl_platform expmap
651    if {$newhist(dummy)} {
652        AddDummyHist $np
653        return
654    }
[92]655    # validate the input
656    set err {}
657    if {[string trim $newhist(rawfile)] == ""} {
658        append err "  No data file specified\n"
659    }
660    if {[string trim $newhist(instfile)] == ""} {
661        append err "  No instrument parameter file specified\n"
662    }
663    if {[string trim $newhist(banknum)] == ""} {
664            append err "  Bank number must be specified\n"
665    } elseif {[catch {expr $newhist(banknum)}]} {
666            append err "  Bank number is not valid\n"
667    }
668    if {[string trim $newhist(setnum)] == ""} {
669        append err "  Parameter set number must be specified\n"
670    } elseif {[catch {expr $newhist(setnum)}]} {
671        append err "  Parameter set number is not valid\n"
672    }
673    if {[string trim $newhist(2tLimit)] == ""} {
674        append err "  2Theta/d-space limit must be specified\n"
675    } elseif {[catch {expr $newhist(2tLimit)}]} {
676        append err "  The 2Theta/d-space limit is not valid\n"
[668]677    } elseif {$newhist(2tLimit) <= 0} {
678        append err "  The 2Theta/d-space limit is not valid\n"
[92]679    }
680    if {[string trim $newhist(LimitMode)] == ""} {
[668]681        append err "  Please choose between either a 2Theta, Q or d-space limit\n"
[92]682    }
683
684    if {$err != ""} {
[321]685        MyMessageBox -parent $np -title  "Add Histogram Error" \
686                -message "The following error(s) were found in your input:\n$err" \
687                -icon error -type ok -default ok \
688                -helplink "expgui3.html AddHistErr"
[92]689        return
690    }
691
692    # ok do it!
693    set fp [open exptool.in w]
694    puts $fp "H"
[232]695    if {$tcl_platform(platform) == "windows"} {
696        puts $fp [file attributes $newhist(rawfile) -shortname]
697        puts $fp [file attributes $newhist(instfile) -shortname]
698    } else {
699        puts $fp $newhist(rawfile)
700        puts $fp $newhist(instfile)
701    }
[92]702    puts $fp $newhist(banknum)
703    puts $fp $newhist(setnum)
[668]704    if {$newhist(LimitMode) == 1} {
[92]705        puts $fp "T"
[668]706        puts $fp "$newhist(2tLimit)"
707    } elseif {$newhist(LimitMode) == 2} {
708        puts $fp "D"
709        set Q 100
710        catch {set Q [expr {4*acos(0)/$newhist(2tLimit)}]}
711        puts $fp "$Q"
[92]712    } else {
713        puts $fp "D"
[668]714        puts $fp "$newhist(2tLimit)"
[92]715    }
716    puts $fp "/"
717    puts $fp "X"
718    puts $fp "X"
719    close $fp
720    global tcl_platform
721    # Save the current exp file
722    savearchiveexp
723    # disable the file changed monitor
724    set expgui(expModifiedLast) 0
725    set expnam [file root [file tail $expgui(expfile)]]
726    catch {
727        if {$tcl_platform(platform) == "windows"} {
728            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
729                    < exptool.in >& exptool.out
730        } else {
731            exec [file join $expgui(gsasexe) exptool] $expnam \
732                    < exptool.in >& exptool.out
733        }
[113]734    } errmsg
[92]735    # load the revised exp file
[447]736    set oldpowderlist $expmap(powderlist)
[92]737    loadexp $expgui(expfile)
738    set fp [open exptool.out r]
739    set out [read $fp]
740    close $fp
741    destroy $np
[447]742    set err 0
743    if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {set err 1}
[113]744    if {$errmsg != ""} {
745        append errmsg "\n" $out
[447]746        set err 1
[113]747    } else {
748        set errmsg $out
749    }
[447]750    if {$expgui(showexptool) || $err} {
751        set msg "Please review the result from adding the histogram" 
752        if {$err} {append msg "\nIt appears an error occurred!"}
753        ShowBigMessage $np $msg $errmsg OK "" $err
[321]754    }
[92]755    file delete exptool.in exptool.out
[668]756    # set the powpref warning (2 = required)
757    set expgui(needpowpref) 2
758    set msg "A histogram was added" 
759    if {[string first $msg $expgui(needpowpref_why)] == -1} {
760        append expgui(needpowpref_why) "\t$msg\n"
761    }
762    # select the most recently added histogram
763    if {!$err} {
764        set i [llength $expmap(histlistboxcontents)]
765        if {$i > 0} {
766            incr i -1
767            set expgui(curhist) $i
768            sethistlist
769        }
770    }
[92]771}
772
[668]773proc RunRawplot {parent} {
[232]774    global newhist tcl_platform
[668]775    set f1 $newhist(rawfile)
776    set f2 $newhist(instfile)
[232]777    # for Windows put a message on top, in case file names must be shortened
778    if {$tcl_platform(platform) == "windows"} {
779        catch {set f1 [file nativename \
780                    [file attributes $newhist(rawfile) -shortname]]}
781        catch {set f2 [file nativename \
782                [file attributes $newhist(instfile) -shortname]]}
783    }
[668]784    if {$f1 != "" || $f2 != ""} {
785        #set msg "Note: input to RAWPLOT\n"
786        #if {$f1 != ""} {append msg "data file: $f1\n"}
787        #if {$f2 != ""} {append msg "instrument file: $f2"}
788        catch {toplevel $parent.msg}
789        catch {eval destroy [winfo children $parent.msg]}
790        wm title $parent.msg "File names"
791        grid [label $parent.msg.1 \
792                -text "File names to be input to RAWPLOT" \
793                -justify center -anchor center] \
[721]794                -column 0 -row 0 -columnspan 2
[668]795        if {$f1 != ""} {
796            grid [label $parent.msg.2a \
797                    -text "Raw histogram: $f1" \
798                    -justify center -anchor e] \
[721]799                    -column 0 -row 1
[668]800            grid [button $parent.msg.2b \
801                    -command "clipboard clear; clipboard append $f1" \
802                    -text "put name\nin clipboard"] \
[721]803                    -column 1 -row 1
[668]804        }           
805        if {$f2 != ""} {
806            grid [label $parent.msg.3a \
807                    -text "Raw histogram: $f2" \
808                    -justify center -anchor e] \
[721]809                    -column 0 -row 2
[668]810            grid [button $parent.msg.3b \
811                    -command "clipboard clear; clipboard append $f2" \
812                    -text "put name\nin clipboard"] \
[721]813                    -column 1 -row 2
[668]814        }           
815        grid [button $parent.msg.4 \
816                -command "destroy $parent.msg" \
817                -text "Close"] \
[721]818                -column 0 -columnspan 2 -row 9
[668]819    }
[232]820    # start RAWPLOT
[358]821    runGSASprog rawplot 1
[668]822    if {[winfo exists $parent.msg]} {raise $parent.msg}
823    update
[232]824}
[447]825#--- Dummy histogram stuff
826proc PostDummyOpts {np} {
827    global newhist
828    if {$newhist(dummy)} {
829        trace variable newhist(tmin) w "ValidateDummyHist $np"
830        trace variable newhist(tmax) w "ValidateDummyHist $np"
831        trace variable newhist(tstep) w "ValidateDummyHist $np"
832        foreach w {l1 t1 lbank} {
833            $np.$w config -fg grey
834        }
[458]835        $np.d1.m1 config -text {}
836        $np.d1.m2 config -text {}
[447]837        $np.b1 config -state disabled
[668]838        grid forget $np.l3 $np.e3 $np.cb3 $np.cb4 $np.cb5 $np.bank $np.f6a
839        grid $np.dl1 -column 0 -row 18
840        grid $np.d1 -column 1 -row 18 -rowspan 2 -columnspan 4 -sticky e
841        grid $np.dl3 -column 0 -columnspan 99 -row 20 -sticky ew
[447]842        if {$newhist(insttype) == "TOF"} {
843            $np.dl1 config -text "Data range:\n(TOF)"
844            $np.d1.lu config -text millisec
[668]845            grid $np.dl2 -column 0 -row 19
[447]846            catch {
[472]847                set s $newhist(setnum)
848                foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
[447]849                $np.d1.m1 config -text $tmin
850                $np.d1.m2 config -text $tmax
851            }
[668]852        } elseif {[lindex $newhist(insttype) 0] == "CW"} {
[447]853            $np.dl1 config -text "Data range:\n(2Theta)"
854            $np.d1.lu config -text degrees
855            #grid forget $np.dl2
856            $np.d1.m1 config -text >0.
857            $np.d1.m2 config -text <180.
[458]858        } elseif {$newhist(insttype) == "ED"} {
[447]859            $np.dl1 config -text "Data range:\n(Energy)"
860            $np.d1.lu config -text KeV
861            $np.d1.m1 config -text 1.
862            $np.d1.m2 config -text 200.
[668]863            grid $np.dl2 -column 0 -row 19
[458]864        } else {
865            $np.dl1 config -text "No file\nselected"
866            $np.d1.lu config -text {}
[447]867        }
868    } else {
869        foreach var {tmin tmax tstep} {
870            foreach v [ trace vinfo newhist($var)] {
871                eval trace vdelete newhist($var) $v
872            }
873        }
874        grid forget $np.dl1 $np.d1 $np.dl2 $np.dl3
875        foreach w {l1 t1 lbank} {
876            $np.$w config -fg black
877        }
878        $np.b1 config -state normal
879        grid $np.bank -column 2 -row 3 -columnspan 7 -sticky ew
[668]880        grid $np.f6a -column 4 -row 18 -rowspan 3
881        grid $np.l3 -column 0 -row 18 -rowspan 3
882        grid $np.e3 -column 1 -row 18 -rowspan 3 
883        grid $np.cb3 -column 2 -row 18 -sticky w
884        grid $np.cb4 -column 2 -row 20 -sticky w
885        grid $np.cb5 -column 2 -row 19 -sticky w
[447]886     }
887}
[232]888
[447]889proc ValidateDummyHist {np args} {
890    # validate input
891    global newhist
892    set msg {}
893    $np.dl3 config -text "\n"
894    foreach e {e1 e2 e3} v {tmin tmax tstep} {
895        if [catch {expr $newhist($v)}] {
896            $np.d1.$e config -fg red
897            append msg "Value of $newhist($v) is invalid for $v\n"
898        } else {
899            $np.d1.$e config -fg black
900        }
901    }
902    if {[catch {expr $newhist(setnum)}]} {
903        append msg "An instrument file bank number must be selected\n"
904    } elseif {$newhist(setnum) <= 0 || \
905            $newhist(setnum) > $newhist(instbanks)} {
906        append msg "An invalid instrument file bank has been selected\n"
907    }
908
909    if {$msg != ""} {return $msg}
910
911    if {$newhist(tmax) <= $newhist(tmin)} {
912        $np.d1.e1 config -fg red
913        $np.d1.e2 config -fg red
914        return "Tmax <= Tmin\n"
915    }
916
917
918    set dmin -1
919    set dmax -1
920    if {$newhist(insttype) == "TOF"} {
921        catch {
[472]922            set s $newhist(setnum)
923            foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
[447]924            if {$newhist(tmin) <$tmin } {
925                $np.d1.e1 config -fg red
926                append msg "Min value of $newhist(tmin) msec is invalid.\n"
927            }
928            if {$newhist(tmax) >$tmax } {
929                $np.d1.e2 config -fg red
930                append msg "Max value of $newhist(tmax) msec is invalid.\n"
931            }
[472]932            set s $newhist(setnum)
[447]933            set dmin [expr {1000. * $newhist(tmin) / \
[472]934                    [lindex $newhist(inst${s}ICONS) 0]}]
[447]935            set dmax [expr {1000. * $newhist(tmax) / \
[472]936                    [lindex $newhist(inst${s}ICONS) 0]}]
[447]937        }
[668]938    } elseif {[lindex $newhist(insttype) 0] == "CW"} {
[447]939        if {$newhist(tmin) <= 0 } {
940            $np.d1.e1 config -fg red
941            append msg "Min value of $newhist(tmin) degrees is invalid.\n"
942        }
943        if {$newhist(tmax) >=180 } {
944            $np.d1.e2 config -fg red
945            append msg "Max value of $newhist(tmax) degrees is invalid.\n"
946        }
947        catch {
[472]948            set s $newhist(setnum)
949            set dmin [expr {[lindex $newhist(inst${s}ICONS) 0]\
[447]950                    * 0.5 / sin(acos(0.)*$newhist(tmax)/180.)}]
[472]951            set dmax [expr {[lindex $newhist(inst${s}ICONS) 0]\
[447]952                    * 0.5 / sin(acos(0.)*$newhist(tmin)/180.)}]
953        }
954    } else {
955        if {$newhist(tmin) <1 } {
956            $np.d1.e1 config -fg red
957            append msg "Min value of $newhist(tmin) KeV is invalid.\n"
958        }
959        if {$newhist(tmax) >200 } {
960            $np.d1.e2 config -fg red
961            append msg "Max value of $newhist(tmax) KeV is invalid.\n"
962        }
963        catch {
[472]964            set s $newhist(setnum)
965            set ang [lindex $newhist(inst${s}ICONS) 0]
[447]966            set dmin [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
967                    $newhist(tmax))}]
968            set dmax [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
969                    $newhist(tmin))}]
970        }
971    }
972    if {$msg != ""} {return $msg}
973    set pnts -1
974    catch {
975        set pnts [expr {1+int(($newhist(tmax) - $newhist(tmin))/$newhist(tstep))}]
976        set qmin [expr {4.*acos(0)/$dmax}]
977        set qmax [expr {4.*acos(0)/$dmin}]
978    }
979    if {$pnts <= 0} {
980        $np.d1.e3 config -fg red
981        append msg "Step value of $newhist(tstep) is invalid.\n"
982    }
983    if {$pnts >20000} {
984        $np.d1.e3 config -fg red
985        append msg "Step value of $newhist(tstep) is too small (>20000 points).\n"
986    }
987    if {$msg != ""} {return $msg}
988    if {$dmin > 0 && $dmax > 0} {
989        catch {
990            set msg [format \
991                    {  %d points.%s  D-space range: %.2f-%.2f A,  Q: %.2f-%.2f/A} \
992                    $pnts "\n" $dmin $dmax $qmin $qmax]
993            $np.dl3 config -text $msg
994        }
995    }
996    if {$msg != ""} {return ""}
997    $np.dl3 config -text [format {  %d points.%s  Range: ?} $pnts "\n"]
998    return "Invalid data range -- something is wrong!"
999}
1000
1001proc AddDummyHist {np} {
1002    global newhist expgui expmap
1003    global tcl_platform
1004    set msg [ValidateDummyHist $np]
1005    if {$msg != ""} {
1006        MyMessageBox -parent $np -title  "Add Histogram Error" \
1007                -message "The following error(s) were found in your input:\n$msg" \
1008                -icon error -type ok -default ok \
1009                -helplink "expgui3.html AddHistErr"
1010        return
1011    }
1012    set fp [open exptool.in w]
1013    puts $fp "D"
1014    puts $fp $newhist(instfile)
1015    puts $fp $newhist(setnum)
1016    if {$newhist(insttype) == "TOF"} {
1017        puts $fp "C"
1018    }
1019    puts $fp $newhist(tmin)
1020    puts $fp $newhist(tmax)
1021    puts $fp $newhist(tstep)
1022    puts $fp "X"
1023    puts $fp "0"
1024    close $fp
1025    # Save the current exp file
1026    savearchiveexp
1027    # disable the file changed monitor
1028    set expgui(expModifiedLast) 0
1029    set expnam [file root [file tail $expgui(expfile)]]
1030    set err [catch {
1031        if {$tcl_platform(platform) == "windows"} {
1032            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1033                    < exptool.in >& exptool.out
1034        } else {
1035            exec [file join $expgui(gsasexe) exptool] $expnam \
1036                    < exptool.in >& exptool.out
1037        }
1038    } errmsg ]
1039    # load the revised exp file
1040    set oldpowderlist $expmap(powderlist)
1041    loadexp $expgui(expfile)
1042    set fp [open exptool.out r]
1043    set out [read $fp]
1044    close $fp
1045    if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {set err 1}
1046    if {$errmsg != ""} {
1047        append errmsg "\n" $out
1048    } else {
1049        set errmsg $out
1050    }
1051    if {[regexp {\(P,H,A\)} $out]} {
1052        set msg {You must upgrade the EXPTOOL program.}
1053        append msg { This version cannot add dummy histograms.}
1054        MyMessageBox -icon error -title "Old EXPTOOL program" \
1055                -message $msg -parent $np \
1056                -helplink "expguierr.html OldEXPTOOL"
1057        # update the documentation & link
1058        destroy $np
1059    } elseif {$expgui(showexptool) || $err} {
1060        set msg "Please review the result from adding the dummy histogram" 
1061        if {$err} {append msg "\nIt appears an error occurred!"}
1062        ShowBigMessage $np $msg $errmsg OK "" $err
1063    } else {
1064        destroy $np
1065    }
1066    file delete exptool.in exptool.out
[668]1067    # set the powpref warning (2 = required)
1068    set expgui(needpowpref) 2
1069    set msg "A histogram was added" 
1070    if {[string first $msg $expgui(needpowpref_why)] == -1} {
1071        append expgui(needpowpref_why) "\t$msg\n"
1072    }
[447]1073}
1074
[721]1075#--- multiple histogram stuff
1076proc SetMultipleAdd {np} {
1077    global newhist
1078    $np.f6.b6c configure -state disabled
1079    catch {
1080        if {$newhist(instbanks) == [llength $newhist(banklist)] \
1081                && $newhist(instbanks) > 1} {
1082            $np.f6.b6c configure -state normal
1083        }
1084    }
1085}
[447]1086
[721]1087proc addMultiplehist {np} {
1088    global newhist
1089    # should not happen, but just in case
1090    if {$newhist(instbanks) != [llength $newhist(banklist)]} {
1091        $np.f6.b6c configure -state disable
1092        return
1093    }
1094    catch {destroy [set top $np.addMult]}
1095    toplevel $top
1096    grid [canvas $top.canvas \
1097            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1098            -yscrollcommand "$top.scroll set"] \
1099            -column 0 -columnspan 2 -row 1 -sticky nsew
1100    grid columnconfigure $top 0 -weight 1
1101    grid rowconfigure $top 1 -weight 1
1102    scrollbar $top.scroll \
1103            -command "$top.canvas yview"
1104    frame [set cfr $top.canvas.fr]
1105    $top.canvas create window 0 0 -anchor nw -window $cfr
1106    grid [label $top.top -text "Select banks to add" -bg beige] \
1107            -column 0 -columnspan 3 -row 0 -sticky ew
1108    grid [button $top.add -text Add -command "destroy $np"] -column 0 -row 2
1109    grid [button $top.cancel -text Cancel -command "destroy $top"] \
1110            -column 1 -row 2 -columnspan 2
[447]1111
[721]1112    set row 1
1113    grid [label $cfr.t1 -text "Bank\n#"] -column 0 -row 0
1114    switch $newhist(insttype) {
1115        TOF {set txt "T-min\n(ms)"}
1116        ED  {set txt "E-max\n(KeV)"}
1117        default {set txt "2theta\nmax"}
1118    }
1119    grid [label $cfr.t2 -text $txt] -column 1 -row 0
1120    foreach i $newhist(banklist) {
1121        grid [checkbutton $cfr.c$i -text $i \
1122                -variable newhist(usebank$i)] \
1123                -column 0 -row [incr row] -sticky w
1124        set newhist(usebank$i) 1
1125        grid [entry $cfr.e$i -width 8 \
1126                -textvariable newhist(tmin$i)] \
1127                -column 1 -row $row -sticky w
1128    }
1129    # resize the list
1130    update
1131    set sizes [grid bbox $top.canvas.fr]
1132    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1133    # use the scroll for BIG lists
1134    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1135        grid $top.scroll -sticky ns -column 3 -row 1
1136    } else {
1137        grid forget $top.scroll 
1138    }
1139    update
1140    putontop $top
1141    tkwait window $top
[738]1142    afterputontop
1143
[721]1144    if {[winfo exists $np]} return
1145
1146    # validate the input
1147    set err {}
1148    if {[string trim $newhist(rawfile)] == ""} {
1149        append err "  No data file specified\n"
1150    }
1151    if {[string trim $newhist(instfile)] == ""} {
1152        append err "  No instrument parameter file specified\n"
1153    }
1154    foreach i $newhist(banklist) {
1155        if {$newhist(usebank$i)} {
1156            if {[catch {expr $newhist(tmin$i)}]} {
1157                append err "  The Max/Min limit is not valid for bank $i\n"
1158            } elseif {$newhist(tmin$i) <= 0} {
1159                append err "  The Max/Min limit is not valid for bank $i\n"
1160            }
1161        }
1162    }
1163    if {$err != ""} {
1164        MyMessageBox -parent $np -title  "Add Histogram Error" \
1165                -message "The following error(s) were found in your input:\n$err" \
1166                -icon error -type ok -default ok \
1167                -helplink "expgui3.html AddHistErr"
1168        return
1169    }
1170
1171    # ok do it!
1172    global tcl_platform expmap expgui
1173    # Save the current exp file
1174    savearchiveexp
1175    set oldpowderlist $expmap(powderlist)
1176    # disable the file changed monitor
1177    set expgui(expModifiedLast) 0
1178    set expnam [file root [file tail $expgui(expfile)]]
1179    if {$tcl_platform(platform) == "windows"} {
1180        set rfile [file attributes $newhist(rawfile) -shortname]
1181        set ifile [file attributes $newhist(instfile) -shortname]
1182        set exe [file join $expgui(gsasexe) exptool.exe]
1183    } else {
1184        set rfile $newhist(rawfile)
1185        set ifile $newhist(instfile)
1186        set exe [file join $expgui(gsasexe) exptool]
1187    }
1188    set k 0
1189    set added 0
1190    set outlog {}
1191    set err 0
1192    pleasewait "adding histograms" expgui(temp)
1193    foreach i $newhist(banklist) {
1194        incr k
1195        if {$newhist(usebank$i)} {
1196            incr added
1197            set expgui(temp) "adding bank $i"
1198            update
1199            set fp [open exptool.in w]
1200            puts $fp "H"
1201            puts $fp $rfile
1202            puts $fp $ifile
1203            puts $fp $i
1204            puts $fp $k
1205            puts $fp "T"
1206            puts $fp "$newhist(tmin$i)"
1207            puts $fp "/"
1208            puts $fp "X"
1209            puts $fp "X"
1210            close $fp
1211            catch {
1212                exec $exe $expnam < exptool.in >& exptool.out
1213            } errmsg
1214            set fp [open exptool.out r]
1215            set out [read $fp]
1216            close $fp
1217            if {$errmsg != ""} {
1218                append outlog "\n\n\nNOTE ERROR:\n" $errmsg $out
1219                set err 1
1220            } else {
1221                append outlog $out
1222            }
1223        }
1224    }
1225    # load the revised exp file
1226    loadexp $expgui(expfile)
1227    if {[llength $oldpowderlist]+$added != [llength $expmap(powderlist)]} {
1228        set err 1
1229    }
1230    # set the powpref warning (2 = required)
1231    set expgui(needpowpref) 2
1232    set msg "A histogram was added" 
1233    if {[string first $msg $expgui(needpowpref_why)] == -1} {
1234        append expgui(needpowpref_why) "\t$msg\n"
1235    }
1236    file delete exptool.in exptool.out
1237    donewait 
1238    if {$expgui(showexptool) || $err} {
1239        set msg "Please review the result from adding the histogram" 
1240        if {$err} {append msg "\nIt appears an error occurred!"}
1241        ShowBigMessage $np $msg $outlog OK "" $err
1242    }
1243    # select the most recently added histogram
1244    if {!$err} {
1245        set i [llength $expmap(histlistboxcontents)]
1246        if {$i > 0} {
1247            incr i -1
1248            set expgui(curhist) $i
1249            sethistlist
1250        }
1251    }
1252}
1253
[447]1254#----------- Add Atoms routines ----------------------------------------
[268]1255proc MakeAddAtomsBox {phase "atomlist {}"} {
1256    global expmap expgui
[92]1257
[179]1258    # is there room for more atoms? Well, we will check this someday
[92]1259    if {$phase == ""} return
1260    if {[llength $phase] != 1} return
1261
[179]1262    set top .newatoms
1263    catch {destroy $top}
1264    toplevel $top
[321]1265    bind $top <Key-F1> "MakeWWWHelp expgui2.html addatoms"
[92]1266
[179]1267    grid [label $top.l1 -relief groove -bd 4 -anchor center\
1268            -text "Adding atoms to phase #$phase"] \
1269            -column 0 -row 0 \
1270            -sticky we -columnspan 10
1271   
1272    grid [canvas $top.canvas \
1273            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1274            -yscrollcommand "$top.scroll set"] \
1275            -column 0 -row 2 -columnspan 4 -sticky nsew
1276    grid columnconfigure $top 3 -weight 1
1277    grid rowconfigure $top 2 -weight 1
1278    grid rowconfigure $top 1 -pad 5
1279    scrollbar $top.scroll \
1280            -command "$top.canvas yview"
1281    frame $top.canvas.fr
1282    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
1283
1284    set np $top.canvas.fr
1285    set row 0
1286    set col 0
[379]1287    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
1288    foreach i {Atom\ntype Name x y z Occ Uiso} \
1289            var {type name x y z occ uiso} {
1290        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
1291                -command "sortAddAtoms $phase $top $var"] \
1292                -column [incr col] -row $row -sticky nsew
[92]1293    }
[379]1294    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
[92]1295
[179]1296    set expgui(SetAddAtomsScroll) 0
[268]1297    set i [llength $atomlist]
1298    if {$i == 0} {incr i}
1299    for {set j 0} {$j < $i} {incr j} {
1300        MakeAddAtomsRow $top
1301    }
1302    set row 0
1303    foreach item $atomlist {
1304        incr row
1305        foreach val $item w {n x y z t o u} {
1306            if {$val != ""} {
1307                $np.e${row}$w delete 0 end
1308                $np.e${row}$w insert end $val
1309            }
1310        }
1311    }
[179]1312    bind $top <Configure> "SetAddAtomsScroll $top"
[268]1313    grid rowconfigure $top 3 -min 10
[179]1314    grid [button $top.b1 -text "Add Atoms"\
[268]1315            -command "addatom $phase $top"] -column 0 -row 5 -sticky w
[179]1316    bind $top <Return> "addatom $phase $top"
1317    grid [button $top.b2 -text Cancel \
[268]1318            -command "destroy $top"] -column 1 -row 5 -sticky w
[321]1319    grid [button $top.help -text Help -bg yellow \
1320            -command "MakeWWWHelp expgui2.html addatoms"] \
1321            -column 0 -columnspan 2 -row 4
[179]1322
[268]1323    # get the input formats if not already defined
1324    GetImportFormats
1325    if {[llength $expgui(importFormatList)] > 0} {
1326        grid [frame $top.fr -bd 4 -relief groove] \
1327                -column 3 -row 5 -columnspan 2 -sticky e
1328        grid [button $top.fr.b3 -text "Import atoms from: " \
[379]1329                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
[268]1330                -column 0 -row 0 -sticky e
[553]1331        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1332                $expgui(importFormatList)]
1333        for {set i 0} {$i <= [$menu index end]} {incr i} {
1334            $menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
1335        }
[268]1336        grid $top.fr.b4 -column 1 -row 0 -sticky w
1337        grid rowconfig $top.fr 0 -pad 10
1338        grid columnconfig $top.fr 0 -pad 10
1339        grid columnconfig $top.fr 1 -pad 10
1340    }
1341
1342    grid [button $top.b3 -text  "More atom boxes" \
[179]1343            -command "MakeAddAtomsRow $top"] -column 3 \
1344            -columnspan 2 -row 4 -sticky e
1345   
1346    wm title $top "add new atom"
1347
[326]1348    # set grab, etc.
[179]1349    putontop $top
1350
1351    tkwait window $top
1352
[326]1353    # fix grab...
[179]1354    afterputontop
1355}
1356
1357proc MakeAddAtomsRow {top} {
1358    set np $top.canvas.fr
[92]1359    set col -1
[179]1360    set row 1
1361    # find an empty row
1362    while {![catch {grid info $np.e${row}t}]} {incr row}
1363    grid [label $np.e${row}num -text $row] -column [incr col]  -row $row
[92]1364    grid [entry $np.e${row}t -width 5] -column [incr col]  -row $row
1365    grid [entry $np.e${row}n -width 8] -column [incr col]  -row $row
1366    foreach i {x y z o u} {
[179]1367        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
[92]1368    }
[179]1369    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
1370            -column [incr col] -row $row
[92]1371    # default occupancy
1372    $np.e${row}o delete 0 end
1373    $np.e${row}o insert end 1.0
1374    # default Uiso
1375    $np.e${row}u delete 0 end
1376    $np.e${row}u insert end 0.025
[268]1377    # default label
[92]1378    $np.e${row}n delete 0 end
1379    $np.e${row}n insert end (default)
[179]1380    # use by default
1381    $np.e${row}use select
[92]1382
[179]1383    SetAddAtomsScroll $top
[268]1384    return $row
[179]1385}
[92]1386
[179]1387proc SetAddAtomsScroll {top} {
1388    global expgui
1389    if $expgui(SetAddAtomsScroll) return
1390    # prevent reentrance
1391    set expgui(SetAddAtomsScroll) 1
1392    update
1393    set sizes [grid bbox $top.canvas.fr]
1394    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1395    # use the scroll for BIG atom lists
1396    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1397        grid $top.scroll -sticky ns -column 4 -row 2
1398    } else {
1399        grid forget $top.scroll 
1400    }
1401    update
1402    set expgui(SetAddAtomsScroll) 0
[92]1403}
1404
[536]1405# Validate the atoms in the atoms add/phase replace box
1406# returns a null string on error or a list of atoms
[553]1407proc ValidateAtomsBox {top np} {
1408    global expgui
[179]1409    set row 0
1410    # loop over the defined rows
[92]1411    set err {}
[179]1412    set atomlist {}
[378]1413    set validatmtypes {
[493]1414        H H-1 H_1 H_2 D H_3 HE HE_3 HE_4 LI LI+1 LI_6 LI_7 BE BE+2 B B_10
[779]1415        B_11 C CV C_12 C_13 N N_14 N_15 O O-1 O-2 O_16 O_17 O_18 F F-1 F_19 NE
[378]1416        NE_20 NE_21 NE_22 NA NA+1 NA_23 MG MG+2 MG_24 MG_25 MG_26 AL AL+3
1417        AL_27 SI SI+4 SIV SI_28 SI_29 SI_30 P P_31 S S_32 S_33 S_34 CL CL-1
1418        CL_35 CL_37 AR AR_36 AR_40 K K+1 K_39 K_41 CA CA+2 CA_40 CA_44 SC SC+3
1419        SC_45 TI TI+2 TI+3 TI+4 TI_46 TI_47 TI_48 TI_49 TI_50 V V+2 V+3 V+5
1420        V_51 CR CR+2 CR+3 CR_50 CR_52 CR_53 CR_54 MN MN+2 MN+3 MN+4 MN_55 FE
1421        FE+2 FE+3 FE_54 FE_56 FE_57 FE_58 CO CO+2 CO+3 CO_59 NI NI+2 NI+3
1422        NI_58 NI_60 NI_61 NI_62 NI_64 CU CU+1 CU+2 CU_63 CU_65 ZN ZN+2 ZN_64
1423        ZN_66 ZN_67 ZN_68 GA GA+3 GE GE+4 AS AS_75 SE BR BR-1 BR_79 BR_81 KR
1424        RB RB+1 SR SR+2 Y Y+3 Y_89 ZR ZR+4 NB NB+3 NB+5 NB_93 MO MO+3 MO+5
1425        MO+6 TC TC_98 RU RU+3 RU+4 RH RH+3 RH+4 RH_103 PD PD+2 PD+4 AG AG+1
1426        AG+2 CD CD+2 CD_112 CD_113 CD_114 CD_116 IN IN+3 IN_113 IN_115 SN SN+2
1427        SN+4 SB SB+3 SB+5 TE I I-1 I_127 XE CS CS+1 CS_133 BA BA+2 LA LA+3 CE
1428        CE+3 CE+4 PR PR+3 PR+4 PR_141 ND ND+3 PM PM+3 PM_147 SM SM+3 SM_152
1429        SM_154 EU EU+2 EU+3 EU_153 GD GD+3 GD_160 TB TB+3 TB_159 DY DY+3 HO
1430        HO+3 HO_165 ER ER+3 TM TM+3 TM_169 YB YB+2 YB+3 LU LU+3 HF HF+4 TA
1431        TA+5 TA_181 W W+6 RE OS OS+4 IR IR+3 IR+4 PT PT+2 PT+4 AU AU+1 AU+3
1432        AU_197 HG HG+1 HG+2 TL TL+1 TL+3 PB PB+2 PB+4 BI BI+3 BI+5 BI_209 PO
1433        PO_210 AT AT_210 RN RN_222 FR FR_223 RA RA+2 RA_226 AC AC+3 AC_227 TH
1434        TH+4 TH_232 PA PA_231 U U+3 U+4 U+6 U_235 U_238 NP NP+3 NP+4 NP+6
1435        NP_237 PU PU+3 PU+4 PU+6 PU_239 PU_240 PU_242 AM AM_243 CM CM_244 BK
1436        BK_247 CF CF_249
1437    }
[536]1438    # loop over the defined rows
[179]1439    while {![catch {grid info $np.e[incr row]t}]} {
1440        if !{$expgui(UseAtom$row)} continue
1441        # ignore blank entries
1442        set line {}
1443        foreach i {t x y z} {
1444            append line [string trim [$np.e${row}$i get]]
[92]1445        }
[179]1446        if {$line == ""} continue
[536]1447
[179]1448        # validate the input
1449        if {[set type [string trim [$np.e${row}t get]]] == ""} {
1450            append err "  line $row: No atom type specified\n"
1451        }
[378]1452        if {[lsearch $validatmtypes [string toupper $type]] == -1} {
1453            append err "  line $row: Atom type $type is invalid for GSAS\n"
1454        }
[179]1455        set name [string trim [$np.e${row}n get]]
1456        if {$name == "(default)"} {set name "/"}
1457        if {$name == ""} {set name "/"}
1458        foreach i {x y z o u} n {x y z Occ Uiso} {
1459            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
1460                append err "  line $row: No value specified for $n\n"
1461            } elseif {[catch {expr [set $i]}]} {
1462                append err "  line $row: The value for $n is invalid\n"
1463            }
1464        }
1465        lappend atomlist "$type $x $y $z $o $name I $u"
[536]1466    }
[92]1467    if {$err != ""} {
[179]1468        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
[536]1469        return {}
[92]1470    }
[179]1471    if {[llength $atomlist] == 0} {
1472        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
[536]1473        return {}
[179]1474    }
[536]1475    return $atomlist
1476}
1477
1478proc addatom {phase top} {
1479    global expgui env expmap
1480    set np $top.canvas.fr
1481    # validate the atoms info
1482    set atomlist [ValidateAtomsBox $top $np]
[553]1483    if {$atomlist == ""} return
[536]1484
[179]1485    # ok add the atoms!
[92]1486    set fp [open exptool.in w]
1487    puts $fp "A"
1488    puts $fp $phase
[179]1489    # number of atoms
1490    puts $fp [llength $atomlist]
1491    foreach atomline $atomlist {
1492        puts $fp $atomline
1493    }
[92]1494    close $fp
1495    # needed in UNIX
1496    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
[394]1497    set env(gsas) [file nativename $expgui(gsasdir)]
[92]1498    # needed in Windows
1499    set env(GSAS) [file nativename $expgui(gsasdir)]
[179]1500
[92]1501    global tcl_platform
1502    # Save the current exp file
1503    savearchiveexp
1504    # disable the file changed monitor
1505    set expgui(expModifiedLast) 0
1506    set expnam [file root [file tail $expgui(expfile)]]
1507    catch {
1508        if {$tcl_platform(platform) == "windows"} {
1509            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1510                    < exptool.in >& exptool.out
1511        } else {
1512            exec [file join $expgui(gsasexe) exptool] $expnam \
1513                    < exptool.in >& exptool.out
1514        }
[113]1515    } errmsg
[92]1516    # load the revised exp file
[447]1517    set oldatomlist $expmap(atomlist_$phase)
[92]1518    loadexp $expgui(expfile)
1519    set fp [open exptool.out r]
1520    set out [read $fp]
1521    close $fp
[179]1522    destroy $top
[447]1523    set err 0
1524    if {[llength $oldatomlist] == [llength $expmap(atomlist_$phase))]} {
1525        set err 1
1526    }
[113]1527    if {$errmsg != ""} {
1528        append errmsg "\n" $out
[447]1529        set err 1
[113]1530    } else {
1531        set errmsg $out
1532    }
[447]1533    if {$expgui(showexptool) || $err} {
1534        set msg "Please review the result from adding the atom(s)" 
1535        if {$err} {append msg "\nIt appears an error occurred!"}
1536        ShowBigMessage $top $msg $errmsg OK "" $err
[321]1537    }
[92]1538    file delete exptool.in exptool.out
1539}
[254]1540
[447]1541#---------------------------------------------------------------------------
1542# commands to modify a group of selected atoms
1543#---------------------------------------------------------------------------
[254]1544
1545# make the dialog to choose an action
1546proc MakeXformAtomsBox {phase} {
1547    global expgui expmap
1548    set numberList {}
1549    set p $expgui(curPhase)
1550    foreach AtomIndex $expgui(selectedatomlist) {
1551        # get atom number & phase
1552        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1553        lappend numberList [lindex $tuple 0]
1554    }
1555    if {$numberList == ""} return
1556    if {[llength $numberList] > 1} {
1557        set suffix s
1558        set suffixy "ies"
1559    } else {
1560        set suffix ""
1561        set suffixy "y"
1562    }
1563    set w .global
1564    catch {destroy $w}
1565    toplevel $w
1566    wm title $w "Edit Atomic Parameter -- phase #$phase"
[321]1567    bind $w <Key-F1> "MakeWWWHelp expgui2.html xform"
[254]1568    # this needs to track by phase
1569    grid [label $w.0 \
1570            -text "Modifying atom${suffix} [CompressList $numberList] Phase $phase" \
1571            -bg yellow -anchor center] -row 0 -column 0 -columnspan 10 \
1572            -sticky nsew
1573    grid rowconfigure $w 0 -pad 5
1574    grid rowconfigure $w 1 -minsize 2
1575
1576    grid [TitleFrame $w.1 -bd 6 -relief groove -text "Modify coordinates"] \
1577            -row 2 -column 0 -columnspan 10 -sticky news
1578    set w1 [$w.1 getframe]
1579    set row 0
1580    foreach v {x y z} {
1581        incr row
1582        set col -1
1583        grid [label $w1.l$v -text "new $v   =   "] -column [incr col] -row $row
1584        foreach o {x y z} {
1585            grid [entry $w1.e${v}${o} -width 6] -column [incr col] -row $row
1586            $w1.e${v}${o} delete 0 end
1587            if {$v == $o} {
1588                $w1.e${v}${o} insert end "1.0"
1589            } else {
1590                $w1.e${v}${o} insert end "0."
1591            }
1592            grid [label $w1.p${v}${o} -text " $o  +  "] \
1593                    -column [incr col] -row $row
1594        }
1595        grid [entry $w1.e${v} -width 6] -column [incr col] -row $row
1596        $w1.e${v} delete 0 end
1597        $w1.e${v} insert end "0."
1598    }
1599    grid [button $w1.do -text "Transform Coordinates" \
1600            -command "XformAtomsCoord $phase [list $numberList] $w1" \
1601            ] -row [incr row] -column 0 -columnspan 10
1602
[847]1603    set shift [GetOrigin1Shift $phase]
1604    grid [button $w1.d1 -text "Xform Origin 1 to Origin 2" \
1605              -command "XformAtoms2Origin2 $phase [list $numberList] $w1 [list $shift]" \
1606             ] -row [incr row] -column 0 -columnspan 10 -sticky e
1607    if {$shift == ""} {$w1.d1 config -state disabled}
1608
1609
[254]1610    grid rowconfigure $w 3 -minsize 5
1611    grid [TitleFrame $w.4 -bd 6 -relief groove -text "Modify occupanc${suffixy}"] \
1612            -row 4 -column 0 -columnspan 10 -sticky news
1613    set w2 [$w.4 getframe]
1614    grid [label $w2.1 -text "Occupancy: "] -row 1 -column 0
1615    grid [entry $w2.e -width 10] -column 1 -row 1
1616    $w2.e delete 0 end
1617    $w2.e insert end 1.0
1618    grid columnconfigure $w2 2 -weight 1
1619    grid [button $w2.do -text "Set Occupanc${suffixy}" \
1620            -command "XformAtomsOcc $phase [list $numberList] $w2" \
1621            ] -row 2 -column 0 -columnspan 10
1622
1623    grid rowconfigure $w 5 -minsize 5
1624    grid [TitleFrame $w.6 -bd 6 -relief groove \
1625            -text "Modify Displacement Parameter$suffix"] \
1626            -row 6 -column 0 -columnspan 10 -sticky news
1627    set w2 [$w.6 getframe]
1628    grid [entry $w2.e -width 10] -column 1 -row 1
1629    $w2.e delete 0 end
1630    $w2.e insert end 0.025
1631    grid columnconfigure $w2 2 -weight 1
1632    grid [button $w2.do -text "Set U" \
1633            -command "XformAtomsU $phase [list $numberList] $w2" \
1634            ] -row 2 -column 0 -columnspan 10
1635    grid [frame $w2.f] -row 3 -column 0 -columnspan 10
1636
[536]1637    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1638        grid [label $w2.1 -text "Uiso or Uequiv: "] -row 1 -column 0
1639        grid [button $w2.f.iso -text "Set Isotropic" \
1640                -command "XformAtomsU $phase [list $numberList] iso" \
1641                ] -row 0 -column 0
1642        grid [button $w2.f.aniso -text "Set Anisotropic" \
1643                -command "XformAtomsU $phase [list $numberList] aniso" \
1644                ] -row 0 -column 1
1645    } else {
1646        grid [label $w2.1 -text "Uiso: "] -row 1 -column 0
1647    }
1648
[254]1649    grid rowconfigure $w 5 -minsize 5
[536]1650    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1651        grid [TitleFrame $w.8 -bd 6 -relief groove \
1652                -text "Erase Atom$suffix"] \
1653                -row 8 -column 0 -columnspan 10 -sticky news
1654        set w2 [$w.8 getframe]
1655        grid [button $w2.do -text "Erase Atom${suffix}" \
1656                -command "EraseAtoms $phase [list $numberList] $w" \
1657                ] -row 2 -column 0 -columnspan 10
1658    }
[254]1659
1660    grid rowconfigure $w 9 -minsize 5
[321]1661    grid [frame $w.b] -row 10 -column 0 -columnspan 10 -sticky ew
1662    pack [button $w.b.3 -text Close -command "destroy $w"] -side left \
1663            -padx 5 -pady 5
1664    pack [button $w.b.help -text Help -bg yellow \
1665            -command "MakeWWWHelp expgui2.html xform"] -side right \
1666            -padx 5 -pady 5
[254]1667    bind $w <Return> "destroy $w"
1668
1669    # force the window to stay on top
1670    putontop $w
1671    focus $w.b.3
1672    tkwait window $w
1673    afterputontop
1674    # if there are selected atoms, reset their display
1675    if {[llength $expgui(selectedatomlist)] != 0} editRecord
1676}
1677
1678# transform the coordinates
1679proc XformAtomsCoord {phase numberList w1} {
[536]1680    global expgui expmap
1681    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1682        set cmd mmatominfo
1683    } else {
1684        set cmd atominfo
1685    }
[254]1686    # get the matrix
1687    foreach v {x y z} {
1688        foreach o {x y z} {
1689            set matrix(${v}${o}) [$w1.e${v}${o} get]
1690        }
1691        set matrix(${v}) [$w1.e${v} get]
1692    }
1693    foreach atom $numberList {
1694        foreach v {x y z} {
[536]1695            set $v [$cmd $phase $atom $v]
[254]1696        }
1697        foreach v {x y z} {
1698            set new$v $matrix(${v})
1699            foreach o {x y z} {
1700                set new$v [expr [set new$v] + $matrix(${v}${o})*[set $o]]
1701            }
[536]1702            $cmd $phase $atom $v set [set new$v]
[254]1703        }
1704        incr expgui(changed)
1705    }
[536]1706    UpdateAtomLine $numberList $phase
[254]1707}
1708
1709# set the occupancies to a single value
1710proc XformAtomsOcc {phase numberList w2} {
[536]1711    global expgui expmap
1712    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1713        set cmd mmatominfo
1714    } else {
1715        set cmd atominfo
1716    }
[254]1717    # get the value
1718    set val [$w2.e get]
1719    foreach atom $numberList {
[536]1720        $cmd $phase $atom frac set $val
[254]1721        incr expgui(changed)
1722    }
[536]1723    UpdateAtomLine $numberList $phase
[254]1724}
1725
1726# transform Uiso or Uij; if anisotropic set Uequiv to Uij
1727proc XformAtomsU {phase numberList w2} {
1728    global expgui
1729    if {$w2 == "iso"} {
1730        foreach atom $numberList {
1731            if {[atominfo $phase $atom temptype] != "I"} {
1732                atominfo $phase $atom temptype set I
[487]1733                incr expgui(changed)
[254]1734            }
1735        }
1736    } elseif {$w2 == "aniso"} {
1737        foreach atom $numberList {
1738            if {[atominfo $phase $atom temptype] == "I"} {
1739                atominfo $phase $atom temptype set A
[487]1740                incr expgui(changed)
[254]1741            }
1742        }
1743    } else {
1744        # get the value
1745        set val [$w2.e get]
1746        foreach atom $numberList {
[536]1747            global expmap
1748            if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1749                mmatominfo $phase $atom Uiso set $val
1750            } elseif {[atominfo $phase $atom temptype] == "I"} {
[254]1751                atominfo $phase $atom Uiso set $val
1752            } else {
1753                atominfo $phase $atom U11 set $val
1754                atominfo $phase $atom U22 set $val
1755                atominfo $phase $atom U33 set $val
1756                atominfo $phase $atom U12 set 0.0
1757                atominfo $phase $atom U13 set 0.0
1758                atominfo $phase $atom U23 set 0.0
1759            }
1760            incr expgui(changed)
1761        }
1762    }
[536]1763    UpdateAtomLine $numberList $phase
[254]1764}
1765
1766# confirm and erase atoms
1767proc EraseAtoms {phase numberList w2} {
1768    global expgui
1769    if {[llength $numberList] <= 0} return
1770    # make a list of atoms
1771    foreach atom $numberList {
1772        append atomlist "\n\t$atom  [atominfo $phase $atom label]"
1773    }
1774    set msg "OK to remove the following [llength $numberList] atoms from phase $phase:$atomlist"
1775    set val [MyMessageBox -parent $w2 -type okcancel -icon warning \
1776            -default cancel -title "Confirm Erase" -message $msg]
1777    if {$val == "ok"} {
1778        foreach atom $numberList {
1779            EraseAtom $atom $phase
1780            incr expgui(changed)
1781        }
1782        mapexp
[536]1783        DisplayAllAtoms $phase
[254]1784        destroy $w2
1785    }
1786}
1787
[447]1788#----------- more Add Phase routines (import) -------------------------------
[268]1789proc ImportPhase {format np} {
1790    global expgui
1791    foreach item $expgui(extensions_$format) {
1792        lappend typelist [list $format $item]
1793    }
1794    lappend typelist [list "All files" *]
1795    set file [tk_getOpenFile -parent $np -filetypes $typelist]
1796    if {![file exists $file]} return
1797    # read in the file
1798    set input [$expgui(proc_$format) $file]
1799    catch {
1800        $np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList"
1801        bind $np <Return> "addphase $np; AddAtomsList"
1802    }
1803    catch {
1804        $np.t1 delete 0 end
1805        $np.t1 insert end "from $file"
1806    }
1807    $np.t2 delete 0 end
1808    $np.t2 insert end [lindex $input 0]
1809    foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] {
1810        $np.f$i delete 0 end
1811        $np.f$i insert end $val
1812    }
1813    set expgui(coordList) [lindex $input 2]
[284]1814    set msg [lindex $input 3]
1815    if {$msg != ""} {
[378]1816        catch {destroy $np.msg}
1817        grid [label $np.msg -text $msg -fg red -anchor center -bd 4 -relief raised] \
1818                -column 0 -columnspan 99 -row 20 -sticky ew
[284]1819    }
[268]1820}
1821
[379]1822proc ImportAtoms {format top phase} {
[268]1823    global expgui
1824    foreach item $expgui(extensions_$format) {
1825        lappend typelist [list $format $item]
1826    }
1827    lappend typelist [list "All files" *]
1828    set file [tk_getOpenFile -parent $top -filetypes $typelist]
1829    if {![file exists $file]} return
[536]1830    # disable during read
1831    catch {
1832        foreach b "$top.b1 $top.b2 $top.fr.b3" {
1833            $b config -state disabled
1834        }
1835    }
[268]1836    # read in the file
1837    set input [$expgui(proc_$format) $file]
1838    # add atoms to table
1839    foreach item [lindex $input 2] {
1840        set row [MakeAddAtomsRow $top]
1841        set np $top.canvas.fr
1842        foreach val $item w {n x y z t o u} {
1843            if {$val != ""} {
1844                $np.e${row}$w delete 0 end
1845                $np.e${row}$w insert end $val
1846            }
1847        }
1848    }
[379]1849    # sort the atoms by number, so that empty entries are at the bottom
1850    sortAddAtoms $phase $top number
[536]1851    # reenable
1852    catch {
1853        foreach b "$top.b1 $top.b2 $top.fr.b3" {
1854            $b config -state normal
1855        }
1856    }
[268]1857}
1858
1859proc AddAtomsList {} {
1860    global expgui expmap
[378]1861    # skip if we aborted out of addphase
1862    if {$expgui(oldphaselist) == -1} return
[268]1863    # find the new phase
1864    set phase {}
1865    foreach p $expmap(phaselist) {
1866        if {[lsearch $expgui(oldphaselist) $p] == -1} {
1867            set phase $p
1868            break
1869        }
1870    }
1871    if {$phase == ""} return
1872    MakeAddAtomsBox $phase $expgui(coordList)
1873}
1874
1875# get the input formats by sourcing files named import_*.tcl
1876proc GetImportFormats {} {
1877    global expgui tcl_platform
1878    # only needs to be done once
1879    if [catch {set expgui(importFormatList)}] {
1880        set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
1881        foreach file $filelist {
[641]1882            set description ""
[268]1883            source $file
[641]1884            if {$description != ""} {
1885                lappend expgui(importFormatList) $description
1886                if {$tcl_platform(platform) == "unix"} {
1887                    set extensions "[string tolower $extensions] [string toupper $extensions]"
1888                }
1889                set expgui(extensions_$description) $extensions
1890                set expgui(proc_$description) $procname
[268]1891            }
1892        }
1893    }
1894}
1895
1896proc MakeReplacePhaseBox {} {
1897    global expmap expgui tcl_platform
1898
1899    set expgui(coordList) {}
1900    # ignore the command if no phase is selected
1901    foreach p {1 2 3 4 5 6 7 8 9} {
1902        if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} {
1903            return
1904        }
1905    }
1906
1907    set top .newphase
1908    catch {destroy $top}
1909    toplevel $top
[321]1910    bind $top <Key-F1> "MakeWWWHelp expgui2.html replacephase"
[268]1911
1912    grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \
1913            -bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew
1914    grid [label $top.l3a -text "Current Space Group: "] \
1915            -column 0 -row 2 -columnspan 2 -sticky e
1916    grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\
1917            -bd 4 -relief groove] \
1918            -column 2 -row 2  -sticky ew
1919    grid [label $top.l4 -text "New Space Group: "] \
1920            -column 0 -row 3 -columnspan 2 -sticky e
1921    grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w
1922    grid [radiobutton $top.r1 -text "Reenter current atoms"\
1923            -variable expgui(DeleteAllAtoms) -value 0] \
1924            -column 1 -row 4 -columnspan 8 -sticky w
1925    grid [radiobutton $top.r2 -text "Delete current atoms" \
1926            -variable expgui(DeleteAllAtoms) -value 1] \
1927            -column 1 -row 5 -columnspan 8 -sticky w
1928   
1929    grid [frame $top.f -bd 4 -relief groove] \
1930            -column 3 -row 2 -columnspan 3 -rowspan 4
1931    set col -1
1932    foreach i {a b c} {
1933        grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1
1934        grid [entry $top.f.e1$i -width 12] -column [incr col]  -row 1
1935        $top.f.e1$i delete 0 end
1936        $top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i]
1937    }
1938    set col -1
1939    foreach i {a b g} var {alpha beta gamma} {
[413]1940        grid [label $top.f.l2$i -text $i] -column [incr col] -row 2
1941        set font [$top.f.l2$i cget -font]
1942        $top.f.l2$i config -font "Symbol [lrange $font 1 end]"
[268]1943        grid [entry $top.f.e2$i -width 12] -column [incr col]  -row 2
1944        $top.f.e2$i delete 0 end
1945        $top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var]
1946    } 
1947
1948    grid [button $top.b1 -text Continue \
1949            -command "replacephase1 $top $expgui(curPhase)"] \
1950            -column 0 -row 6 -sticky w
1951    bind $top <Return> "replacephase1 $top $expgui(curPhase)"
1952    grid [button $top.b2 -text Cancel \
1953            -command "destroy $top"] -column 1 -row 6 -sticky w
[321]1954    grid [button $top.help -text Help -bg yellow \
1955            -command "MakeWWWHelp expgui2.html replacephase"] \
1956            -column 2 -row 6
[268]1957
1958    # get the input formats if not already defined
1959    GetImportFormats
1960    if {[llength $expgui(importFormatList)] > 0} {
1961        grid [frame $top.fr -bd 4 -relief groove] \
1962                -column 2 -row 6 -columnspan 8 -sticky e
1963        grid [button $top.fr.b3 -text "Import phase from: " \
1964                -command "ImportPhase \$expgui(importFormat) $top"] \
1965                -column 0 -row 0 -sticky e
[553]1966        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1967                $expgui(importFormatList)]
1968        for {set i 0} {$i <= [$menu index end]} {incr i} {
[754]1969            $menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $top"
[553]1970        }
[268]1971        grid $top.fr.b4 -column 1 -row 0 -sticky w
1972        grid rowconfig $top.fr 0 -pad 10
1973        grid columnconfig $top.fr 0 -pad 10
1974        grid columnconfig $top.fr 1 -pad 10
[284]1975#       grid columnconfig $top 4 -weight 1
1976        grid columnconfig $top 2 -weight 1
[268]1977    }
1978   
1979    wm title $top "Replace phase $expgui(curPhase)"
1980
[326]1981    # set grab, etc.
[268]1982    putontop $top
1983
1984    tkwait window $top
1985
[326]1986    # fix grab...
[268]1987    afterputontop
1988}
1989
1990proc replacephase1 {top phase} {
1991    # validate cell & space group & save to pass
1992    global expgui expmap
1993    set expgui(SetAddAtomsScroll) 0
1994    # validate the input
1995    set err {}
1996    set spg [$top.t2 get]
1997    if {[string trim $spg] == ""} {
1998        append err "  Space group cannot be blank\n"
1999    }
2000    set cell {}
2001    foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} {
2002        set $lbl [$top.f.e${n}$i get]
2003        if {[string trim [set $lbl]] == ""} {
2004            append err "  $lbl cannot be blank\n"
2005        } elseif {[catch {expr [set $lbl]}]} {
2006            append err "  [set $lbl] is not valid for $lbl\n"
2007        }
2008        lappend cell [set $lbl]
2009    }
2010
2011    if {$err != ""} {
[383]2012        MyMessageBox -parent $top -title "Replace Phase Error" -icon warning \
2013                -message "The following error(s) were found in your input:\n$err" 
[268]2014        return
2015    }
2016
2017    # check the space group
2018    set fp [open spg.in w]
2019    puts $fp "N"
2020    puts $fp "N"
2021    puts $fp $spg
2022    puts $fp "Q"
2023    close $fp
2024    global tcl_platform
2025    catch {
2026        if {$tcl_platform(platform) == "windows"} {
2027            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
2028        } else {
2029            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
2030        }
2031    }
2032    set fp [open spg.out r]
2033    set out [read $fp]
2034    close $fp
2035    # attempt to parse out the output (fix up if parse did not work)
2036    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
2037            $out a b ] != 1} {set b $out}
2038    if {[string first Error $b] != -1} {
2039        # got an error, show it
2040        ShowBigMessage \
2041                 $top.error \
2042                 "Error processing space group\nReview error message below" \
[447]2043                 $b OK "" 1
[268]2044        return
2045    } else {
2046        # show the result and confirm
2047        set opt [ShowBigMessage \
2048                $top.check \
2049                "Check the symmetry operators in the output below" \
2050                $b \
2051                {Continue Redo} ]
2052        if {$opt > 1} return
2053    }
2054    file delete spg.in spg.out
2055    # draw coordinates box
2056    eval destroy [winfo children $top]
2057    grid [label $top.l1 -relief groove -bd 4 -anchor center\
2058            -text "Atom list for phase #$phase"] \
2059            -column 0 -row 0 \
2060            -sticky we -columnspan 10
2061    grid [canvas $top.canvas \
2062            -scrollregion {0 0 5000 500} -width 0 -height 250 \
2063            -yscrollcommand "$top.scroll set"] \
2064            -column 0 -row 2 -columnspan 4 -sticky nsew
2065    grid columnconfigure $top 3 -weight 1
2066    grid rowconfigure $top 2 -weight 1
2067    grid rowconfigure $top 1 -pad 5
2068    scrollbar $top.scroll \
2069            -command "$top.canvas yview"
2070    frame $top.canvas.fr
2071    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
2072
2073    set np $top.canvas.fr
2074    set row 0
2075    set col 0
[379]2076    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
2077    foreach i {Atom\ntype Name x y z Occ Uiso} \
2078            var {type name x y z occ uiso} {
2079        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
2080                -command "sortAddAtoms $phase $top $var"] \
2081                -column [incr col] -row $row -sticky nsew
[268]2082    }
[379]2083    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
[268]2084
2085    # add the old atoms, if appropriate
2086    if {!$expgui(DeleteAllAtoms)} {
2087        # loop over all atoms
2088        foreach atom $expmap(atomlist_$phase) {
2089            set row [MakeAddAtomsRow $top]
2090            # add all atoms in the current phase to the list
2091            foreach w {n x y z t o} var {label x y z type frac} {
2092                $np.e${row}$w delete 0 end
2093                $np.e${row}$w insert end [atominfo $phase $atom $var]
2094            }
2095            $np.e${row}u delete 0 end
2096            if {[atominfo $phase $atom temptype] == "I"} {
2097                $np.e${row}u insert end [atominfo $phase $atom Uiso]
2098            } else {
2099                $np.e${row}u insert end [expr ( \
2100                        [atominfo $phase $atom U11] + \
2101                        [atominfo $phase $atom U22] + \
2102                        [atominfo $phase $atom U33]) / 3.]
2103            }
2104        }
2105    }
2106
2107    # add coordinates that have been read in, if any
2108    foreach item $expgui(coordList) {
2109        set row [MakeAddAtomsRow $top]
2110        foreach val $item w {n x y z t o u} {
2111            if {$val != ""} {
2112                $np.e${row}$w delete 0 end
2113                $np.e${row}$w insert end $val
2114            }
2115        }
2116    }
2117    # a blank spot in the table
2118    MakeAddAtomsRow $top
2119
2120    bind $top <Configure> "SetAddAtomsScroll $top"
2121    grid rowconfigure $top 3 -min 10
2122    grid [button $top.b1 -text "Continue"\
2123            -command "replacephase2 $phase $top [list $spg] [list $cell]"] \
2124            -column 0 -row 5 -sticky w
2125    bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]"
2126    grid [button $top.b2 -text Cancel \
2127            -command "destroy $top"] -column 1 -row 5 -sticky w
2128    if {[llength $expgui(importFormatList)] > 0} {
2129        grid [frame $top.fr -bd 4 -relief groove] \
2130                -column 3 -row 5 -columnspan 2 -sticky e
2131        grid [button $top.fr.b3 -text "Import atoms from: " \
[379]2132                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
[268]2133                -column 0 -row 0 -sticky e
[553]2134        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
2135                $expgui(importFormatList)]
2136        for {set i 0} {$i <= [$menu index end]} {incr i} {
2137            $menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
2138        }
[268]2139        grid $top.fr.b4 -column 1 -row 0 -sticky w
2140        grid rowconfig $top.fr 0 -pad 10
2141        grid columnconfig $top.fr 0 -pad 10
2142        grid columnconfig $top.fr 1 -pad 10
2143    }
2144
2145    grid [button $top.b3 -text  "More atom boxes" \
2146            -command "MakeAddAtomsRow $top"] -column 3 \
2147            -columnspan 2 -row 4 -sticky e
2148   
2149    wm title $top "Replacing phase: Enter atoms"
2150    SetAddAtomsScroll $top
2151
[326]2152    # fix grab for old window
[268]2153    afterputontop
[326]2154    # set grab, etc.
[268]2155    putontop $top
2156}
2157
2158proc replacephase2 {phase top spg cell} {
2159    global expgui expmap env
2160    # validate coordinates
2161    set np $top.canvas.fr
[536]2162    # validate the atoms info
2163    set atomlist [ValidateAtomsBox $top $np]
[553]2164    if {$atomlist == ""} return
[268]2165
2166    pleasewait "updating phase"
2167    # replace spacegroup and cell
2168    phaseinfo $phase spacegroup set $spg
2169    foreach val $cell var {a b c alpha beta gamma} {
2170        phaseinfo $phase $var set $val
2171    }
[536]2172    incr expgui(changed) 
[268]2173    # delete all atoms
2174    foreach i $expmap(atomlist_$phase) {
2175        EraseAtom $i $phase
[536]2176        incr expgui(changed) 
[268]2177    }
2178    # write new atoms from table as input to exptool
2179    set fp [open exptool.in w]
2180    puts $fp "A"
2181    puts $fp $phase
2182    # number of atoms
2183    puts $fp [llength $atomlist]
2184    foreach atomline $atomlist {
2185        puts $fp $atomline
[536]2186        incr expgui(changed) 
[268]2187    }
2188    close $fp
2189    # needed in UNIX
2190    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
[394]2191    set env(gsas) [file nativename $expgui(gsasdir)]
[268]2192    # needed in Windows
2193    set env(GSAS) [file nativename $expgui(gsasdir)]
2194
2195    global tcl_platform
2196    # Save the current exp file
2197    savearchiveexp
2198    # disable the file changed monitor
2199    set expgui(expModifiedLast) 0
2200    set expnam [file root [file tail $expgui(expfile)]]
2201    catch {
2202        if {$tcl_platform(platform) == "windows"} {
2203            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
2204                    < exptool.in >& exptool.out
2205        } else {
2206            exec [file join $expgui(gsasexe) exptool] $expnam \
2207                    < exptool.in >& exptool.out
2208        }
2209    } errmsg
2210    # load the revised exp file
2211    loadexp $expgui(expfile)
2212    set fp [open exptool.out r]
2213    set out [read $fp]
2214    close $fp
[447]2215    set err 0
[536]2216    if {[llength $atomlist] != [llength $expmap(atomlist_$phase))]} {
[447]2217        set err 1
2218    }
[268]2219    if {$errmsg != ""} {
2220        append errmsg "\n" $out
[447]2221        set err 1
[268]2222    } else {
2223        set errmsg $out
2224    }
2225    donewait 
[447]2226    if {$expgui(showexptool) || $err} {
2227        set msg "Please review the result from adding the atom(s)" 
2228        if {$err} {append msg "\nIt appears an error occurred!"}
2229        ShowBigMessage $top $msg $errmsg OK "" $err
[321]2230    }
[268]2231    file delete exptool.in exptool.out
[668]2232    # set the powpref warning (2 = required)
2233    set expgui(needpowpref) 2
2234    set msg "A phase was replaced"
2235    if {[string first $msg $expgui(needpowpref_why)] == -1} {
2236        append expgui(needpowpref_why) "\t$msg\n"
2237    }
[268]2238    destroy $top
2239}
2240
[379]2241proc sortAddAtoms {phase top sortvar} {
2242    global expgui
2243    set np $top.canvas.fr
2244    set validlist {}
2245    set invalidlist {}
2246    set row 0
2247    while {![catch {grid info $np.e[incr row]t}]} {
2248        set valid 1
2249        set line $row
2250        if !{$expgui(UseAtom$row)} {set valid 0}
2251        lappend line $expgui(UseAtom$row)
2252        if {[set type [string trim [$np.e${row}t get]]] == ""} {set valid 0}
2253        lappend line [string trim [$np.e${row}t get]]
2254        lappend line [string trim [$np.e${row}n get]]
2255        foreach i {x y z o u} {
2256            set tmp [string trim [$np.e${row}$i get]]
2257            lappend line $tmp
2258            if {$tmp == "" || [catch {expr $tmp}]} {set valid 0}
2259        }
2260        if {$valid} {
2261            lappend validlist $line
2262        } else {
2263            lappend invalidlist $line
2264        }
2265    }
2266    switch $sortvar {
2267        type {set sortlist [lsort -index 2 -dictionary $validlist]}
2268        name {set sortlist [lsort -index 3 -dictionary $validlist]}
2269        x {set sortlist [lsort -index 4 -real $validlist]}
2270        y {set sortlist [lsort -index 5 -real $validlist]}
2271        z {set sortlist [lsort -index 6 -real $validlist]}
2272        occ {set sortlist [lsort -index 7 -real $validlist]}
2273        uiso  {set sortlist [lsort -index 8 -real $validlist]}
2274        default {set sortlist $validlist}
2275    }
2276
2277    if {[llength $invalidlist] > 0} {append sortlist " $invalidlist"}
2278    set row 0
2279    foreach line $sortlist {
2280        incr row
2281        set expgui(UseAtom$row) [lindex $line 1]
2282        foreach item [lrange $line 2 end] \
2283                var {t n x y z o u} {
2284            $np.e${row}$var delete 0 end
2285            $np.e${row}$var insert end $item
2286        }
2287    }
2288}
[694]2289
2290proc EditInstFile {"filename {}"} {
2291    global expgui
2292    # on the first call, load the commands
2293    if {[catch {
2294        if {[info procs instMakeWindow] == ""} {
2295            source [file join $expgui(scriptdir) instedit.tcl]
2296        }
2297    } errmsg]} {
2298        MyMessageBox -parent . -title "Load error" \
2299                -message "Unexpected error while sourcing file instedit.tcl: $errmsg" \
2300                -icon error
2301    }
2302    instMakeWindow $filename
2303}
2304
[847]2305# load a list of Origin 1/2 space groups
2306proc GetOrigin12List {} {
2307    # don't need to read the file twice
2308    if {[array names ::Origin1list] != ""} return
2309    set line {}
2310    set fp1 [open [file join $::expgui(scriptdir) spacegrp.ref] r]
2311    while {[lindex $line 1] != 230} {
2312        if {[gets $fp1 line] < 0} break
2313    }
2314    while {[gets $fp1 line] >= 0} {
[853]2315        set key [string tolower [lindex $line 8]]
[847]2316        regsub -all " " $key "" key
2317        regsub -- "-3" $key "3" key
2318        if {$key != ""} {
[853]2319#       puts "$key -- [lindex $line 1] [lindex $line 8] [lindex $line 9]"
[847]2320            set ::Origin1list($key) [lindex $line 9]
2321        }
2322    }
2323    close $fp1
2324}
2325
2326# get the shift to be added to origin 1 coordinates to obtain origin 2 settings
2327proc GetOrigin1Shift {phase} {
2328    GetOrigin12List
[853]2329    set spg [string tolower [phaseinfo $phase spacegroup]]
[847]2330    regsub -all " " $spg "" spg
2331    regsub -- "-3" $spg "3" spg
2332    if {[catch {set shift $::Origin1list($spg)}]} {
2333        return ""
2334    } else {
2335        return $shift
2336    }
2337}
2338
[849]2339proc XformAtoms2Origin2 {phase numberList w1 shift} {
2340    global expgui expmap
2341    set parent [winfo toplevel $w1]
2342    if {[llength $numberList] != [llength $expmap(atomlist_$phase)]} {
2343        # not all atoms were selected in phase -- do a sanity check
2344        set msg {You have selected only some atoms to be shifted. Do you want to shift all atoms or only the selected atoms?}
2345        set val [MyMessageBox -parent $parent -icon warning \
2346                     -type "{Use all} {Use Selection}" -default "use all" \
2347                     -title "Shift all" -message $msg]
[853]2348#       puts "$phase $numberList $w1 $shift"
[849]2349        if {$val == "use all"} {set numberList $expmap(atomlist_$phase)}
2350    }
2351    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2352        set cmd mmatominfo
2353    } else {
2354        set cmd atominfo
2355    }
2356    foreach atom $numberList {
2357        foreach v {x y z} vs $shift {
2358            set c [$cmd $phase $atom $v]
2359            $cmd $phase $atom $v set [expr {$c + $vs}]
2360        }
2361        incr expgui(changed)
2362    }
2363
2364    MyMessageBox -parent $parent -type OK -default ok -title "Shift applied" \
2365        -message "A shift of \"$shift\" has been applied to atoms [CompressList $numberList]"
2366    UpdateAtomLine $numberList $phase
2367    destroy $parent
2368}
[394]2369# default
[458]2370set newhist(insttype) {}
[447]2371set newhist(dummy) 0
[668]2372set newhist(instfiletext) {}
Note: See TracBrowser for help on using the repository browser.