source: trunk/expgui @ 123

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

# on 1999/11/19 00:03:25, toby did:
fixup Archive code for Windows (as per Pamela Whitfield)
make autoload option UNIX only (until we can run GSAS pgms synchronously)

  • Property rcs:author set to toby
  • Property rcs:date set to 1999/11/19 00:03:25
  • Property rcs:lines set to +15 -27
  • Property rcs:rev set to 1.22
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 109.0 KB
Line 
1#!/usr/local/bin/wish
2# $Id: expgui 123 2009-12-04 23:00:47Z toby $
3set expgui(Revision) {$Revision: 123 $ $Date: 2009-12-04 23:00:47 +0000 (Fri, 04 Dec 2009) $}
4
5# to do:
6#
7# need to change heading and button label depending on where getExpFileName
8# is called from
9#
10# global background editing & profile work differently: should both
11# start out blank with a "load from option"?
12#
13# idea:
14# a scroll list for all histogram refinement flags ; click on takes you to the
15# appropriate menu.
16#
17# idea:
18#   change cell parameters to labels and have a edit cell button
19#   that enforces metric symmetry
20#
21# to allow "global" access on phase page
22#   change buttons from radio to multiple
23#   -- or display all 9 cell flag/damps and all atoms
24#   make editMultipleRecords work with multiple phases, also cell flag/damp
25#   blank cell entries
26#   add phase to atom number in listing
27#   DisplayAllAtoms needs to loop over phases: expgui(curPhase)
28
29if {$tcl_version < 8.0} {
30    tk_dialog .expFileErrorMsg "Version Error" \
31            "The program requires Tcl/Tk version 8.0 or higher" error 0 "Exit"
32    exit
33}
34
35if {$argv != ""} {
36    set expgui(expfile) $argv
37    if {[string toupper [file extension $expgui(expfile)]] != ".EXP"} {
38        append expgui(expfile) ".EXP"
39    }
40    if {[file dirname $expgui(expfile)] == "."} {
41        set expgui(expfile) [string toupper $expgui(expfile)]
42    } else {
43        set expgui(expfile) [file join \
44                [file dirname $expgui(expfile)] \
45                [file tail [string toupper $expgui(expfile)]]
46        ]
47    }
48} else {
49    set expgui(expfile) {}
50}
51
52set expgui(debug) 0
53catch {if $env(DEBUG) {set expgui(debug) 1}}
54#set expgui(debug) 1
55
56set expgui(havetix) 1
57# for debugging non-Tix version set environment variable NOTIX
58catch {if $env(NOTIX) {set expgui(havetix) 0}}
59if $expgui(havetix) {
60    if [catch {package require Tix}] {set expgui(havetix) 0}
61}
62# default for archive mode = on
63set expgui(archive) 1
64# default for autoexec load = off
65set expgui(autoexpload) 0
66# save the name of the wish executable
67set wishshell [info nameofexecutable]
68# misc constants
69set expgui(coordfont) "-*-courier-bold-r-normal--12-*"
70set expgui(histfont) "-*-courier-bold-r-normal--12-*"
71set liveplot(hst) 1
72set liveplot(legend) 1
73set expgui(filesort) 1
74set expgui(initstring) {}
75#=============================================================================
76# Store names of profile terms.
77array set expgui {
78    prof-T-1 {TOF-type1 alp-0 bet-0 sig-0 alp-1 bet-1 sig-1 rstr rsta \
79            sig-2 rsca s1ec s2ec }
80    prof-T-2 {TOF-type2 alp-0 sig-0 gam-0 alp-1 sig-1 gam-1 beta sig-2 \
81            gam-2 switch ptec stec difc difa zero }
82    prof-T-3 {TOF-type3 alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
83            gam-2 gsf g1ec g2ec rstr rsta rsca L11 L22 L33 L12 L13 L23 }
84    prof-T-4 {TOF-type4 alp bet-0 bet-1 sig-1 sig-2 gam-2 g2ec gsf \
85            rstr rsta rsca eta}
86    prof-C-1 {CW-type U V W asym F1 F2 }
87    prof-C-2 {CW-type2 GU GV GW LX LY trns asym shft GP stec ptec sfec \
88            L11 L22 L33 L12 L13 L23 }
89    prof-C-3 {CW-type3 GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
90            L11 L22 L33 L12 L13 L23 }
91    prof-C-4 {CW-type4 GU GV GW GP LX ptec trns shft sfec S/L H/L eta}
92}
93# >>>>>>>>>>>>>>>> End of Profile Terms  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
94#----------------------------------------------------------------
95# where are we?
96set expgui(script) [info script]
97# translate links -- go six levels deep
98foreach i {1 2 3 4 5 6} {
99    if {[file type $expgui(script)] == "link"} {
100        set link [file readlink $expgui(script)]
101        if { [file  pathtype  $link] == "absolute" } {
102            set expgui(script) $link
103        } {
104            set expgui(script) [file dirname $expgui(script)]/$link
105        }
106    } else {
107        break
108    }
109}
110# fixup relative paths
111if {[file pathtype $expgui(script)] == "relative"} {
112    set expgui(script) [file join [pwd] $expgui(script)]
113}
114set expgui(scriptdir) [file dirname $expgui(script) ]
115set expgui(gsasdir) [file dirname $expgui(scriptdir)]
116set expgui(gsasexe) [file join $expgui(gsasdir) exe]
117#----------------------------------------------------------------
118# fetch EXP file processing routines
119source [file join $expgui(scriptdir) readexp.tcl]
120# commands for running GSAS programs
121source [file join $expgui(scriptdir) gsascmds.tcl]
122# contents of GSAS menus
123source [file join $expgui(scriptdir) gsasmenu.tcl]
124# commands for adding phases, histograms & atoms
125source [file join $expgui(scriptdir) addcmds.tcl]
126# get the notebook widget if not using Tix
127if {!$expgui(havetix)} {source $expgui(scriptdir)/notebook.tcl}
128#---------------------------------------------------------------------------
129# override options with locally defined values
130if [file exists [file join $expgui(scriptdir) localconfig]] {
131    source [file join $expgui(scriptdir) localconfig]
132}
133if [file exists [file join ~ .gsas_config]] {
134    source [file join ~ .gsas_config]
135}
136if {$tcl_platform(platform) == "windows"} {
137    set expgui(exptool) [file join $expgui(gsasexe) exptool.exe]
138} else {
139    set expgui(exptool) [file join $expgui(gsasexe) exptool]
140}
141#---------------------------------------------------------------------------
142if {$expgui(expfile) != ""} {
143    if ![file exists $expgui(expfile)] {
144        update
145        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
146                "File [file tail $expgui(expfile)] does not exist in [file dirname $expgui(expfile)]" \
147                error 0 "Create" "Open other"]
148        if $ans {set expgui(expfile) {}}
149    }
150}
151if {$expgui(expfile) == ""} {
152    # center the parent window because the getExpFileName window
153    # will be centered above it.
154    wm withdraw .
155    set x [expr [winfo screenwidth .]/2 - [winfo reqwidth .]/2 ]
156    set y [expr [winfo screenheight .]/2 - [winfo reqheight .]/2]
157    wm geom . +$x+$y
158    wm deiconify .
159    # windows needed this update before when using tk_getOpenFile.
160    # I am not sure it is still needed.
161    update
162    #
163    set expgui(expfile) [getExpFileName old]
164}
165if {$expgui(expfile) == ""} exit
166# you've been warned this .EXP does not exist!
167if ![file exists $expgui(expfile)] {
168    # create an "empty" exp file
169    createexp $expgui(expfile) \
170            [getstring "title for experiment $expgui(expfile)" 60 0]
171}
172catch {cd [string trim [file dirname $expgui(expfile)]]}
173
174#
175# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
176# <<<<<<<<<<    BEGINNING OF MAIN: GLOBAL AREA FOR DATA EXTRACTION >>>>>>>>>>>
177# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
178# load exp file and set up dialogs
179proc loadexp {expfile} {
180    global expgui expmap entryvar entrycmd
181    global exparray
182    catch {
183        unset exparray
184    }
185    set exploadtime [time {expload $expfile}]
186    if $expgui(debug) {puts "expload $exploadtime"}
187    set expgui(changed) 0
188    mapexp
189    set expgui(expModifiedLast) [file mtime $expfile]
190    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
191    # set the window/icon title
192    wm title . $expfile
193    set expgui(titleunchanged) 1
194    wm iconname . [file tail $expfile]
195
196    # set the number of phases on the phase page
197    setphases
198
199    # disable the "global options" that don't make sense based
200    # on the histograms present
201    foreach num {1 2 3 4 5} {
202        set flag($num) 0
203    }
204    foreach h $expmap(powderlist) {
205        if {[string range $expmap(htype_$h) 2 2] == "T"} {set flag(1) 1}
206        if {[string range $expmap(htype_$h) 1 2] == "NC"} {set flag(2) 1}
207        if {[string range $expmap(htype_$h) 1 2] == "XC" && \
208                [histinfo $h lam2] != 0.0} {set flag(3) 1}
209        if {[string range $expmap(htype_$h) 1 2] == "XC" && \
210                [histinfo $h lam2] == 0.0} {set flag(4) 1}
211        if {[string range $expmap(htype_$h) 1 2] == "XE"} {set flag(5) 1}
212    }
213    foreach num {1 2 3 4 5} \
214            lbl {TOF "CW Neutron" "Alpha12 Xray" "Monochromatic Xray" \
215            "Energy Disp Xray"} {
216        if $flag($num) {
217            $expgui(fm).option.menu.editmode entryconfigure $lbl -state normal
218        } else {
219            $expgui(fm).option.menu.editmode entryconfigure $lbl -state disabled
220        }
221    }
222    # disable traces on entryvar until we are ready
223    set entrycmd(trace) 0
224    trace vdelete entryvar w entvartrace
225
226    # propogate changes on the least squares page
227    set entryvar(cycles) [expinfo cycles]
228    set entrycmd(cycles) "expinfo cycles"
229    # set expgui(globalmode) 0
230    set expgui(printopt) "Print Options ([expinfo print])"
231    set entryvar(title) [expinfo title]
232    global printopts
233    foreach num [array names printopts] {
234        set entrycmd(printopt$num) "printsetting $num"
235        set entryvar(printopt$num) [printsetting $num]
236    }
237    # enable traces on entryvar
238    set entrycmd(trace) 1
239    trace variable entryvar w entvartrace
240
241    # set fo extaction on LS page
242    SetupExtractHist
243
244    # update the histogram list & the page, if shown
245    sethistlist
246
247    # update the atoms display
248#    DisplayAllAtoms noreset
249    SelectOnePhase $expgui(curPhase)
250
251    # start checking for external changes
252    afterawhile
253}
254
255# called to reread the .EXP file
256proc rereadexp {expfile} {
257    global expgui
258    if $expgui(changed) {
259        set decision [tk_dialog .instrSaveData {Save .EXP changes} \
260                {You have made changes to the Experiment. Rereading will cause the changes to be lost. Select an option:} \
261                {} 0 "Save and reread" "Reread without Save" "Cancel reread command"]
262        switch $decision {
263            0 { savearchiveexp }
264            1 { }
265            2 { return }
266        }
267    }
268    loadexp $expgui(expfile)
269}
270
271proc SaveAsFile {} {
272    global expgui
273    set newexpfile [getExpFileName new]
274    if {$newexpfile == ""} return
275    expwrite $newexpfile
276    set expgui(expfile) $newexpfile
277    catch {cd [string trim [file dirname $expgui(expfile)]]}
278    set expgui(changed) 0
279    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
280    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
281    # set the window/icon title
282    wm title . $expgui(expfile)
283    set expgui(titleunchanged) 1
284    wm iconname . [file tail $expgui(expfile)]
285}
286
287# called to read a different .EXP file
288proc readnewexp {} {
289    global expgui expmap
290    if $expgui(changed) {
291        set decision [tk_dialog .instrSaveData {Save .EXP changes} \
292                {You have made changes to the Experiment. Reading a different file will cause the changes to be lost. Select an option:} \
293                {} 0 "Save and read" "Read without Save" "Cancel read command"]
294        switch $decision {
295            0 { savearchiveexp }
296            1 {                }
297            2 { return }
298        }
299    }
300    set newexpfile [getExpFileName old]
301    if {$newexpfile == ""} return
302
303    if ![file exists $newexpfile] {
304        # you've been warned this .EXP does not exist!
305        # create an "empty" exp file
306        createexp $newexpfile \
307                [getstring "title for experiment $newexpfile" 60 0]
308    }
309    set expgui(expfile) $newexpfile
310    catch {cd [string trim [file dirname $expgui(expfile)]]}
311    set expgui(globalmode) 0
312    loadexp $expgui(expfile)
313
314    # select the 1st phase
315    SelectOnePhase [lindex $expmap(phaselist) 0]
316    # select the first histogram in the list by default (if there are any)
317    if {[llength $expmap(histlistboxcontents)] > 0} {
318        set expgui(curhist) 0
319    } else {
320        set expgui(curhist) {}
321    }
322    RaisePage lsFrame
323    if {[CountHistory] > 100} {
324        DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
325    }
326}
327
328#------------- set up data read/write layer ----------------------
329# trace routine on entryvar
330proc entvartrace {array elem action} {
331    global expgui entrycmd entryvar
332    if !$entrycmd(trace) return
333   
334    catch {
335        if {$entrycmd($elem) == ""} return
336        incr expgui(changed)
337        if $expgui(debug) {puts "$entrycmd($elem)  set $entryvar($elem) "}
338        if {$entrycmd($elem) == ""} return
339        if [catch {
340            eval $entrycmd($elem) set [list $entryvar($elem)]
341            if {[lindex $entrycmd($elem) 0] == "atominfo"} {
342                after idle {DisplayAllAtoms noreset}
343            }
344        } errmsg] {puts "entvartrace error: $errmsg"}   
345    }
346}
347
348# disable traces on entryvar until we are ready
349set entrycmd(trace) 0
350trace variable entryvar w entvartrace
351
352#
353#
354#
355##############################################################################
356#####                    #####################################################
357##### PROCEDURES SECTION #####################################################
358#####                    #####################################################
359##############################################################################
360# reset routine is used for debugging
361proc reset {} {
362    global expgui script argv
363    set script $expgui(script)
364    set argv $expgui(expfile)
365    # remove traces
366    global entryvar
367    foreach cmd [trace vinfo entryvar] {
368        eval trace vdelete entryvar $cmd
369    }
370    global expgui
371    foreach cmd [trace vinfo expgui(backterms)] {
372        eval trace vdelete entryvar $cmd
373    }
374    foreach cmd [trace vinfo expgui(backtype)] {
375        eval trace vdelete entryvar $cmd
376    }
377    foreach a {
378        exparray expmap expgui entryvar entrycmd 
379        expgui_menulist expgui_cmdlist expgui_helplist
380    } {
381        global $a
382        catch {unset  $a}
383    }
384    foreach w [winfo children .] {
385        destroy $w
386    }
387
388    uplevel #0 {source $script}
389}
390
391# save some of the global options in ~/.gsas_config
392proc SaveOptions {} {
393    global expgui env tcl_platform
394    set fp [open [file join ~ .gsas_config] a]
395    puts $fp "set expgui(archive) $expgui(archive)"
396    puts $fp "set expgui(asorttype) $expgui(asorttype)"
397    puts $fp "set expgui(hsorttype) $expgui(hsorttype)"
398    puts $fp "set expgui(filesort) $expgui(filesort)"
399    if {$tcl_platform(platform) != "windows"} {
400        puts $fp "set env(GSASBACKSPACE) $env(GSASBACKSPACE)"
401        puts $fp "set expgui(autoexpload) $expgui(autoexpload)"
402    }
403    close $fp
404}
405
406proc About { } {
407    global expgui expmap
408    tk_dialog .about {About...} \
409"EXPGUI\n\
410Jonathan Wasserman and Brian Toby\n\
411NIST Center for Neutron Research\n\n\
4121998, Not subject to copyright\n\n\
413Revision [lindex $expgui(Revision) 1] (readexp.tcl [lindex $expmap(Revision) 1])\n\n\
414Generalized Structure Analysis System (GSAS)\n\
415A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
416" \
417        info 0 OK
418}
419
420# wait until idle
421proc afterawhile {} {
422    # cancel any other instances of this loop
423    after cancel afterawhile
424    after cancel whenidle
425    after cancel whenidle
426    after idle whenidle
427}
428
429proc whenidle {} {
430    global expgui
431    if $expgui(titleunchanged) {
432        if {$expgui(changed) != 0} {
433            wm title . "$expgui(expfile) (modified)"
434            set expgui(titleunchanged) 0
435        }
436    }
437    if {[file mtime $expgui(expfile)] != $expgui(expModifiedLast) && \
438        $expgui(expModifiedLast) != 0} {
439        if {$expgui(changed) == 0} {
440            set ans [tk_dialog .expFileErrorMsg "Reload?" \
441                    "File [file tail $expgui(expfile)] has been modified by another program. \
442Do you want to load the newer version or lose the modifications \
443by editing the current version?" \
444                    warning 0 "Load new" "Continue editing"]
445        } else {
446            set ans [tk_dialog .expFileErrorMsg "Reload?" \
447                    "File [file tail $expgui(expfile)] has been modified by another program \
448and you have made $expgui(changed) changes to this version. \
449Do you want to load the newer version or lose the modifications \
450by continuing to edit the current version?" \
451                    warning 0 "Load new" "Continue editing" "Save edited version"]
452        }
453        if {$ans == 0} {
454            loadexp $expgui(expfile)
455        } elseif {$ans == 1} {
456            # reset the time to the next version
457            set expgui(expModifiedLast) [file mtime $expgui(expfile)]
458        } elseif {$ans == 2} {
459            savearchiveexp
460        }
461    }
462    after 2000 afterawhile
463}
464# --------  called to confirm before exiting
465proc catchQuit {} {
466    if {[confirmBeforeSave] == "Continue"} {
467        destroy .
468    }
469}
470# save the .EXP file before exiting?
471proc confirmBeforeSave {} {
472    global expgui
473    if !$expgui(changed) {
474        return "Continue"
475    }
476    set decision [tk_dialog .instrSaveData {Save .EXP changes} \
477            {You have made changes to the Experiment, but the changes are not saved. Select an option:} \
478            {} 0 "Save and Exit" "Exit without Save" "Cancel exit command"]
479    switch $decision {
480        0 { savearchiveexp;  return "Continue" }
481        1 {                  return "Continue" }
482        2 {                  return "Cancel"   }
483    }
484}
485
486proc archiveexp {} {
487    global expgui tcl_platform
488    catch {
489        set expnam [file rootname $expgui(expfile)]
490        if {$tcl_platform(platform) == "windows"} {
491            set version -1
492            catch {source $expnam.version}
493            incr version
494            if ![file executable [file join $expgui(scriptdir) pkzip.exe]] {
495                # archive w/o pkzip
496                set file $expnam![format "%3.3d" $version].EXP
497                file copy -force $expnam.EXP $file
498                set fp [open $expnam.lst a]
499                puts $fp "\n--------------------------------------------------------------"
500                puts $fp "Archiving $expnam.EXP as $file"
501                puts $fp "--------------------------------------------------------------\n"
502                close $fp
503            } else {
504                # archive with PKZIP           
505                # need to limit expnam to 8 characters
506                set sexp [string toupper [string range [file root [file tail $expnam] ] 0 7]]
507                # PKZIP can't handle long dir names either
508                cd [set dir [file dirname $expnam]]
509                set file $sexp.[format "%3.3d" $version]
510                file copy -force $expnam.EXP $file
511                exec [file join $expgui(scriptdir) pkzip.exe] -m $sexp $file > zip.out &
512                set fp [open $expnam.lst a]
513                puts $fp "\n--------------------------------------------------------------"
514                puts $fp "Archiving $expnam.EXP as $file in [file join $dir $sexp.ZIP]"
515                puts $fp "--------------------------------------------------------------\n"
516                close $fp
517            }
518            set fp [open $expnam.version w]
519            puts $fp "set version $version"
520            close $fp
521        } else {
522            set files [glob -nocomplain $expnam.EXP.*]
523            if {$files == ""} {
524                set file $expnam.EXP.000
525            } else {
526                set file [lindex [lsort -decreasing $files] 0]
527                regexp {.*\.EXP.0?0?([0-9]*).*} $file junk number
528                incr number
529                set file $expnam.EXP.[format "%3.3d" $number]
530            }
531            exec cp $expgui(expfile) $file
532            if [catch {exec gzip $file}] {
533                exec echo "\n----------------------------------------------" >> $expnam.LST
534                exec echo "     Archiving $expnam.EXP as $file " >> $expnam.LST
535                exec echo "----------------------------------------------\n" >> $expnam.LST
536            } else {
537                exec echo "\n----------------------------------------------" >> $expnam.LST
538                exec echo "     Archiving $expnam.EXP as $file.gz " >> $expnam.LST
539                exec echo "----------------------------------------------\n" >> $expnam.LST
540            }
541        }
542    } errmsg
543    if {$errmsg != ""} {
544        tk_dialog .warn Confirm "Error in archive: $errmsg" warning 0 OK
545    }
546}
547
548# save and optionally archive the expfile
549proc savearchiveexp {} {
550    global expgui expmap
551    if !$expgui(changed) return
552    if $expgui(archive) archiveexp
553    # add a history record
554    exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds]]"
555    # now save the file
556    expwrite $expgui(expfile)
557    set expgui(changed) 0
558    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
559    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
560    wm title . $expgui(expfile)
561    set expgui(titleunchanged) 1
562}
563
564# set the number of phases on the phase page
565proc setphases {} {
566    global expgui expmap
567    eval destroy [pack slaves $expgui(phaseFrame).top.ps]
568    foreach num $expmap(phaselist) {
569        pack [button $expgui(phaseFrame).top.ps.$num -text $num \
570                -command "SelectOnePhase $num"] -side left
571    }
572}
573
574# Procedure to respond to changes the phase.
575#  This loads the "phases" widgets with data corresponding to the selected phase.
576proc SelectOnePhase {num} {
577    global entryvar entrycmd expmap expgui
578    foreach n $expmap(phaselist) {
579        if {$n == $num} {
580             $expgui(phaseFrame).top.ps.$num config -relief sunken
581        } else {
582            $expgui(phaseFrame).top.ps.$n config -relief raised
583        }
584    }
585    set crsPhase $num
586    # no phase is selected
587    if {$crsPhase == "" || [llength $expmap(phaselist)] == 0} {
588        # disable traces on entryvar
589        set entrycmd(trace) 0
590        set entrycmd(phasename) ""
591        set entryvar(phasename) ""
592        foreach ent {a b c alpha beta gamma cellref celldamp} {
593            set entrycmd($ent) ""
594            set entryvar($ent) ""
595        }
596        set expgui(curPhase) {}
597        # enable traces on entryvar
598        set entrycmd(trace) 1
599        $expgui(EditingAtoms) config -text ""
600        DisplayAtom 0 0
601        DisplayU 0 0
602        DisplayRefFlags 0 0
603        $expgui(atomlistbox) delete 0 end
604        return
605    }
606
607    set expgui(curPhase) $crsPhase
608    # we have a phase
609
610    # disable traces on entryvar for right now
611    set entrycmd(trace) 0
612
613    ##########################################################
614    ######   SECTION: ASSIGNMENT OF DATA VARIABLES  ##########
615    ##########################################################
616    # phase title
617    set entrycmd(phasename) "phaseinfo $crsPhase name"
618    set entryvar(phasename) [phaseinfo $crsPhase name]
619    # cell parameters & flags
620    foreach ent {a b c alpha beta gamma cellref celldamp} {
621        set entrycmd($ent) "phaseinfo $crsPhase $ent"
622        set entryvar($ent) [phaseinfo $crsPhase $ent]
623    }
624
625    #Procedure call: DisplayU -- Display Anisotropic/Isotropic widget or disable
626    # initialize to diasbled
627    DisplayAtom 0 0
628    DisplayU 0 0
629    DisplayRefFlags 0 0
630    $expgui(EditingAtoms) config -text ""
631
632    DisplayAllAtoms
633
634    # enable traces on entryvar now
635    set entrycmd(trace) 1
636}
637
638set expgui(noreenterDisplayAllAtoms) 0
639# Populate expgui(atomlistbox) (ScrolledListBox) with atoms from selected phase.
640proc DisplayAllAtoms {"mode reset"} {
641    global entryvar entrycmd expmap expgui
642    # if it does not show, dont bother
643    if {$expgui(pagenow) != "phaseFrame"} return
644    if {$expgui(curPhase) == ""} return
645    if $expgui(noreenterDisplayAllAtoms) return
646   
647    set expgui(noreenterDisplayAllAtoms) 1
648    if {$mode != "reset"} {
649        # save the scrolled position
650        set pos [lindex [$expgui(atomlistbox) yview] 0]
651    } else {
652        # this is a reset -- clear the selected atoms list
653        set expgui(selectedatomlist) {}
654    }
655    $expgui(atomlistbox) delete 0 end
656    # loop over atoms
657    set maxline I
658    set phase $expgui(curPhase)
659    set atomlist {}
660    if  {$expgui(asorttype) == "type"} {
661        # sort on atom type
662        foreach atom $expmap(atomlist_$phase) {
663            lappend atomlist "$atom [atominfo $phase $atom type] $phase"
664        }
665        set expmap(atomlistboxcontents) [lsort -ascii -index 1 $atomlist]
666    } elseif {$expgui(asorttype) == "number"} {
667        # sort on atom number
668        foreach atom $expmap(atomlist_$phase) {
669            lappend atomlist "$atom $atom $phase"
670        }
671        set expmap(atomlistboxcontents) [lsort -integer -index 1 $atomlist]
672    } elseif {$expgui(asorttype) == "x"} {
673        # sort on x
674        foreach atom $expmap(atomlist_$phase) {
675            lappend atomlist "$atom [atominfo $phase $atom x] $phase"
676        }
677        set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
678    } elseif {$expgui(asorttype) == "y"} {
679        # sort on y
680        foreach atom $expmap(atomlist_$phase) {
681            lappend atomlist "$atom [atominfo $phase $atom y] $phase"
682        }
683        set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
684    } elseif {$expgui(asorttype) == "z"} {
685        # sort on z
686        foreach atom $expmap(atomlist_$phase) {
687            lappend atomlist "$atom [atominfo $phase $atom z] $phase"
688        }
689        set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
690    } else {
691        error "Bad expgui(asorttype = $expgui(asorttype)"
692    }
693
694    foreach tuple $expmap(atomlistboxcontents) {
695        set atom [lindex $tuple 0]
696        set phase [lindex $tuple 2]
697        set refflag {}
698        foreach type {x u f} {
699            if {[atominfo $phase $atom ${type}ref]} {
700                append refflag "[string toupper $type][atominfo $phase $atom ${type}damp] "
701            } else {
702                append refflag " [atominfo $phase $atom ${type}damp] "
703            }   
704        }
705        set line [format "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%9.4f" \
706                $atom \
707                [atominfo $phase $atom label] \
708                [atominfo $phase $atom type] \
709                $refflag \
710                [atominfo $phase $atom x] \
711                [atominfo $phase $atom y] \
712                [atominfo $phase $atom z] \
713                [atominfo $phase $atom frac]
714        ]
715        # add temperature factors (iso/anoiso)
716        if {[atominfo $phase $atom temptype] == "A"} {
717            set maxline A
718            append line [format "  %9.5f%9.5f%9.5f%9.5f%9.5f%9.5f" \
719                    [atominfo $phase $atom U11] \
720                    [atominfo $phase $atom U22] \
721                    [atominfo $phase $atom U33] \
722                    [atominfo $phase $atom U12] \
723                    [atominfo $phase $atom U23] \
724                    [atominfo $phase $atom U13]
725            ]
726        } else {
727            append line [format "  %9.5f" \
728                    [atominfo $phase $atom Uiso]
729            ]
730        }
731        $expgui(atomlistbox) insert end $line
732    }
733    $expgui(atomtitle) delete 0 end
734    if {$maxline == "A"} {
735        $expgui(atomtitle) insert end [format "%10s %6s %8s %30s%9s  %s" \
736                " name  " "type  " "ref/damp  " "fractional coordinates    " \
737                " Occupancy" \
738                "Uiso/Uij                                            "]
739    } else {
740        $expgui(atomtitle) insert end [format "%10s %6s %8s %30s%9s  %s" \
741                " name  " "type  " "ref/damp  " "fractional coordinates    " \
742                " Occupancy" \
743                "Uiso"]
744    }
745    if {$mode != "reset"} {
746        # restore the selected items
747        foreach i $expgui(selectedatomlist) {
748            $expgui(atomlistbox) selection set $i
749        }
750        # restore the last scrolled position
751        $expgui(atomlistbox) yview moveto $pos
752    }
753    set expgui(noreenterDisplayAllAtoms) 0
754}
755
756# Procedure to select all atoms in response to a right-click
757proc SelectAllAtoms {} {
758    global expgui
759    $expgui(atomlistbox) selection set 0 end
760    # call editRecord in case trace was called before the selection was made
761    editRecord
762}
763
764# Procedure to respond to left mouse release in the atoms Pane
765proc editRecord { args } {
766    global entrycmd expgui
767    set expgui(selectedatomlist) [$expgui(atomlistbox) curselection]
768    # disable traces on entryvar for right now
769    set entrycmd(trace) 0
770
771    if {[llength $expgui(selectedatomlist)] == 0} {
772        puts  "How did this happen: [$expgui(atomlistbox) curselection]"
773    } elseif {[llength $expgui(selectedatomlist)] == 1} {
774        editOneRecord $expgui(selectedatomlist)
775    } else {
776        editMultipleRecords $expgui(selectedatomlist)
777    }
778    # reenable traces on entryvar
779    set entrycmd(trace) 1
780    # repaint the atoms box in case anything was changed
781    #    DisplayAllAtoms noreset
782}
783
784proc editOneRecord { AtomIndex } {
785    global expmap expgui
786    # get atom number & phase
787    set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
788    set atomnum [lindex $tuple 0]
789    set p [lindex $tuple 2]
790    DisplayU $atomnum $p
791    DisplayAtom $atomnum $p
792    DisplayRefFlags $atomnum $p
793    $expgui(EditingAtoms) config -text "Editing atom #$atomnum -- [atominfo $p $atomnum label]"
794}
795
796# this will not work for a multi-phase list of atoms (yet)
797proc editMultipleRecords { AtomIndexList } {
798    global expmap expgui
799    set numberList {}
800    # current phase
801    set p $expgui(curPhase)
802    foreach AtomIndex $AtomIndexList {
803        # get atom number & phase
804        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
805        lappend numberList [lindex $tuple 0]
806#       set p [lindex $tuple 2]
807    }
808    # this needs to track by phase
809    $expgui(EditingAtoms) config -text \
810            "Set refinement options: atoms [CompressList $numberList]"
811    DisplayU 0 0
812    DisplayAtom 0 0
813    # this needs to track by phase
814    DisplayRefFlags $numberList $p
815}
816
817# format a string of numbers to save space, e.g. "1 2 3 4 6 7 19 13 14 15"
818# becomes "1-4,6,7,13-15,19"
819proc CompressList {numberList} {
820    # format the number list to save space
821    set lastnum -99
822    set flist {}
823    set count 0
824    foreach num [lsort -integer $numberList] {
825        set next [expr $lastnum+1]
826        if {$num != $next} {
827            if {$count == 0 && $flist != ""} {
828                append flist ",$num"
829            } elseif {$count == 1 && $flist != ""} {
830                append flist ",$lastnum,$num"
831            } elseif {$flist != ""} {
832                append flist "-$lastnum,$num"
833            } else {
834                append flist "$num"
835            }
836            set lastnum $num
837            set count 0
838        } else {
839            incr count
840            incr lastnum
841        }
842    }
843    if {$count == 1 && $flist != ""} {
844        append flist ",$lastnum"
845    } elseif {$flist != "" && $count > 1} {
846        append flist "-$lastnum"
847    }
848    return $flist
849}
850
851# Procedure to display Isotropic or Anisotropic temperature factors
852#  Changes the display to one entry widget for Isotropic motion OR
853#   6 entry widgets for Anisotropic motion in Frame3.
854#   or disables the widet entirly if atom = 0
855proc DisplayU { atomnum p} {
856    global expgui entryvar entrycmd
857    if {$atomnum == 0} {
858        set iOrA disable
859    } else {
860        set iOrA [atominfo $p $atomnum temptype]
861    }
862
863    set firstbox [lindex $expgui(anisolabels) 0]
864    if { $iOrA == "A" } {
865        $firstbox config -text "U11 "
866        foreach item $expgui(anisolabels) {
867            $item config -fg black
868        }
869        foreach item $expgui(anisoentry) var {U11 U22 U33 U12 U13 U23} {
870            set entrycmd($var) "atominfo $p $atomnum $var"
871            set entryvar($var) [eval $entrycmd($var)]
872            $item config -fg black -state normal  -bg white
873        }
874    } elseif { $iOrA == "I" || $iOrA == "disable"} {
875        foreach item $expgui(anisolabels) {
876#           $item config -fg grey
877            $item config -fg beige
878        }
879        foreach item [lrange $expgui(anisoentry) 1 end] \
880                var {U22 U33 U12 U13 U23} {
881            set entrycmd($var) ""
882            set entryvar($var) ""
883            $item config -fg beige -bg beige  -state disabled
884        }
885        if { $iOrA == "disable"} {
886            set entrycmd($var) ""
887            set entryvar($var) ""
888#           [lindex $expgui(anisoentry) 0] config -fg white -state disabled
889            [lindex $expgui(anisoentry) 0] config -fg beige -bg beige -state disabled
890        } else {
891            set entrycmd(U11) "atominfo $p $atomnum Uiso"
892            set entryvar(U11) [eval $entrycmd(U11)]
893            $firstbox config -text Uiso -fg black
894            [lindex $expgui(anisoentry) 0] config -fg black -bg white -state normal
895        }
896    }
897}
898
899# need to think about multiple phases
900
901# Procedure to display refinement flags
902proc DisplayRefFlags { atomnum p} {
903    global expgui entryvar entrycmd
904    if {$atomnum == 0} {
905        foreach label $expgui(atomreflbl) {
906            $label config -fg beige
907        }
908        foreach entry $expgui(atomref) {
909            $entry config -state disabled -fg beige -bg beige
910        }
911        return
912    }
913    foreach label $expgui(atomreflbl) {
914        $label config -fg black
915    }
916    foreach entry $expgui(atomref) {
917        $entry config -state normal -fg black -bg beige
918    }
919    foreach var {xref uref fref xdamp udamp fdamp}  {
920        set entrycmd($var) "atominfo $p [list $atomnum] $var"
921        set entryvar($var) [eval $entrycmd($var)]
922    }
923}
924
925# Procedure to display an atom in the atom edit boxes
926proc DisplayAtom { atomnum p} {
927    global expgui entryvar entrycmd
928    if {$atomnum == 0} {
929        foreach label $expgui(atomlabels) {
930            $label config -fg beige
931        }
932        foreach entry $expgui(atomentry) {
933            $entry config -state disabled -fg beige -bg beige
934        }
935        return
936    }
937    foreach label $expgui(atomlabels) {
938        $label config -fg black
939    }
940    foreach entry $expgui(atomentry) {
941        $entry config -state normal -fg black -bg white
942    }
943    foreach var {x y z label frac } {
944        set entrycmd($var) "atominfo $p $atomnum $var"
945        set entryvar($var) [eval $entrycmd($var)]
946    }
947}
948
949# update the histogram list
950# to do: show histogram ref flags?
951proc sethistlist {} {
952    global expgui expmap
953    foreach lbox $expgui(HistSelectList) {
954        $lbox.title delete 0 end
955        $lbox.lbox delete 0 end
956        if {$expgui(globalmode) != 0} {
957            $lbox.lbox config -selectmode extended
958        } else {
959            $lbox.lbox config -selectmode browse
960        }
961    }
962    # disable the unallowed pages in all mode
963    if {$expgui(globalmode) == 6} {
964        foreach pair $expgui(GlobalModeAllDisable) {
965            if {$expgui(pagenow) == [lindex $pair 0]} {
966                RaisePage lsFrame
967            }
968            eval [lindex $pair 1] -state disabled
969        }
970    } else {
971        foreach pair $expgui(GlobalModeAllDisable) {
972            eval [lindex $pair 1] -state normal
973        }
974    }
975    set histlist {}
976    if  {$expgui(hsorttype) == "type"} {
977        # sort on histogram type
978        foreach h [lsort -integer -increasing $expmap(powderlist)] {
979            lappend histlist "$h [string range $expmap(htype_$h) 1 2]"
980        }
981        set expmap(histlistboxcontents) [lsort -ascii -index 1 $histlist]
982    } elseif {$expgui(hsorttype) == "number"} {
983        # sort on histogram number
984        foreach h [lsort -integer -increasing $expmap(powderlist)] {
985            lappend histlist "$h $h"
986        }
987        set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
988    } elseif {$expgui(hsorttype) == "bank"} {
989        # sort on original bank number
990        foreach h [lsort -integer -increasing $expmap(powderlist)] {
991            lappend histlist "$h [histinfo $h bank]"
992        }
993        set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
994    } elseif {$expgui(hsorttype) == "angle"} {
995        # sort on wavelength (CW) or angle (E disp.)
996        foreach h [lsort -integer -increasing $expmap(powderlist)] {
997            if {[string range $expmap(htype_$h) 2 2] == "T"} {
998                set det [format %8.2f [histinfo $h tofangle]]
999            } elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1000                set det [format %8.5f [histinfo $h lam1]]
1001            } elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1002                set det [format %8.2f [histinfo $h lam1]]
1003            } else {
1004                set det {}
1005            }
1006            lappend histlist "$h $det"
1007        }
1008        set expmap(histlistboxcontents) [lsort -real -index 1 $histlist]
1009    }
1010
1011    # title field needs to match longest title
1012    foreach lbox $expgui(HistSelectList) {
1013        $lbox.title insert end [format "%2s %s %4s %8s  %-67s" \
1014                "h#" \
1015                type \
1016                bank \
1017                "ang/wave" \
1018                "    title" \
1019                ]
1020    }
1021    foreach tuple $expmap(histlistboxcontents) {
1022        set h [lindex $tuple 0]
1023
1024        if {$expgui(globalmode) == 1} {
1025            if {[string range $expmap(htype_$h) 2 2] != "T"} continue
1026        } elseif {$expgui(globalmode) == 2} {
1027            if {[string range $expmap(htype_$h) 1 2] != "NC"} continue
1028        } elseif {$expgui(globalmode) == 3} {
1029            if {[string range $expmap(htype_$h) 1 2] != "XC" || \
1030                    [histinfo $h lam2] == 0.0} continue
1031        } elseif {$expgui(globalmode) == 4} {
1032            if {[string range $expmap(htype_$h) 1 2] != "XC" || \
1033                    [histinfo $h lam2] != 0.0} continue
1034        } elseif {$expgui(globalmode) == 5} {
1035            if {[string range $expmap(htype_$h) 1 2] != "XE"} continue
1036        }
1037
1038        if {[string range $expmap(htype_$h) 2 2] == "T"} {
1039            set det [format %8.2f [histinfo $h tofangle]]
1040        } elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1041            set det [format %8.5f [histinfo $h lam1]]
1042        } elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1043            set det [format %8.2f [histinfo $h lam1]]
1044        } else {
1045            set det {}
1046        }
1047        foreach lbox $expgui(HistSelectList) {
1048            $lbox.lbox insert end [format "%2d  %s  %4d %8s  %-67s" \
1049                    $h \
1050                    [string range $expmap(htype_$h) 1 2] \
1051                    [histinfo $h bank] \
1052                    $det \
1053                    [string range [histinfo $h title] 0 66] \
1054                    ]
1055        }
1056    }
1057    foreach set $expgui(frameactionlist) {
1058        if {$expgui(pagenow) == [lindex $set 0]} [lindex $set 1]
1059    }
1060}
1061
1062#-----------------------------------------------------------------------
1063# ----------- draw Histogram page
1064#-----------------------------------------------------------------------
1065proc DisplayHistogram {} {
1066    global expgui entrycmd entryvar expmap
1067
1068    # trap if more than one histogram is selected unless global mode
1069    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1070        set expgui(curhist) [lindex $expgui(curhist) 0]
1071    }
1072
1073    # display the selected histograms
1074    $expgui(histFrame).hs.lbox selection clear 0 end
1075    foreach h $expgui(curhist) {
1076        $expgui(histFrame).hs.lbox selection set $h
1077    }
1078
1079    # disable traces on entryvar for right now
1080    set entrycmd(trace) 0
1081
1082    # get histogram list
1083    set histlist {}
1084    foreach item $expgui(curhist) {
1085        lappend histlist [lindex $expmap(powderlist) $item]
1086    }
1087    # must have at least one histogram selected here
1088    if {[llength $histlist] == 0} {
1089        set expgui(backtermlbl) ""
1090        set expgui(backtypelbl) ""
1091        foreach var {bref bdamp} {
1092            set entrycmd($var) ""
1093            set entryvar($var) ""
1094        }
1095        $expgui(histFrame).top.txt config -text "No Selected Histograms"
1096        grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew       
1097        set expgui(bkglbl) ""
1098        eval destroy [grid slaves $expgui(diffBox)]
1099        set entrycmd(trace) 1
1100        return
1101    }
1102
1103    if {$expgui(globalmode) != 0} {
1104        set expgui(backtermlbl) ""
1105        set expgui(backtypelbl) ""
1106        foreach var {bref bdamp} {
1107            set entrycmd($var) "histinfo [list $histlist] $var"
1108            set entryvar($var) [histinfo [lindex $histlist 0] $var]
1109        }
1110    } else {
1111        set hist $histlist
1112        set terms [histinfo $hist backterms]
1113        set expgui(backtermlbl) "($terms terms)"
1114        set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
1115        foreach var {bref bdamp} {
1116            set entrycmd($var) "histinfo $hist $var"
1117            set entryvar($var) [eval $entrycmd($var)]
1118        }
1119    }
1120    # Top box
1121    if {$expgui(globalmode) != 0} {
1122        $expgui(histFrame).top.txt config \
1123                -text "Selected Histograms: [CompressList $histlist]"
1124        grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew       
1125        set expgui(bkglbl) "Globally Edit Background"
1126    } else {
1127        grid forget $expgui(histFrame).top
1128        set expgui(bkglbl) "Edit Background"
1129    }
1130
1131    # diffractometer constants
1132    foreach var {lam1 lam2 kratio pola ipola ddamp zero \
1133            wref pref dcref daref ratref ttref zref } {
1134        set entrycmd($var) "histinfo [list $histlist] $var"
1135        set entryvar($var) [histinfo [lindex $histlist 0] $var]
1136    }
1137
1138    eval destroy [grid slaves $expgui(diffBox)]
1139    if {$expgui(globalmode) == 0} {
1140        if {[string range $expmap(htype_$hist) 2 2] == "T"} {
1141        #------
1142        # TOF |
1143        #------
1144            grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1145                    -column 1 -row 1
1146            grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1147                    -column 2 -row 1
1148            grid [ label $expgui(diffBox).lDCdifc -text DIFC ] \
1149                    -column 3 -row 1 -sticky w
1150            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1151                    -width 15 ] -column 4 -row 1
1152            #
1153            grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1154                    -column 1 -row 2
1155            grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1156                    -column 2 -row 2
1157            grid [ label $expgui(diffBox).lDCdifa -text DIFA ] \
1158                    -column 3 -row 2
1159            grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1160                    -width 15 ] -column 4 -row 2
1161            #
1162            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1163                    -column 3 -row 3
1164            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1165                    -width 15 ] -column 4 -row 3
1166            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1167                    -column 1 -row 3 -sticky w
1168            grid [ checkbutton $expgui(diffBox).rfDCzref \
1169                    -variable entryvar(zref) ] -column 2 -row 3
1170        } elseif {[string range $expmap(htype_$hist) 1 2] == "NC"} {
1171        #---------------
1172        # CW - neutron |
1173        #---------------
1174            grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1175                    -column 1 -row 1
1176            grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1177                    -column 2 -row 1
1178            grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1179                    -column 3 -row 1 -sticky w
1180            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1181                    -width 15 ] -column 4 -row 1
1182            #
1183            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1184                    -column 1 -row 3 -sticky w
1185            grid [ checkbutton $expgui(diffBox).rfDCzref \
1186                    -variable entryvar(zref) ] -column 2 -row 3
1187            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1188                    -column 3 -row 3
1189            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1190                    -width 15 ] -column 4 -row 3
1191        } elseif {[string range $expmap(htype_$hist) 1 2] == "XC" && \
1192                [histinfo $hist lam2] == 0.0} {
1193        #--------------------------
1194        # CW - x-ray 1 wavelength |
1195        #--------------------------
1196            grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1197                    -column 1 -row 1
1198            grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1199                    -column 2 -row 1
1200            grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1201                    -column 3 -row 1 -sticky w
1202            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1203                    -width 15 ] -column 4 -row 1
1204            #
1205            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1206                    -column 1 -row 3 -sticky w
1207            grid [ checkbutton $expgui(diffBox).rfDCzref \
1208                    -variable entryvar(zref) ] -column 2 -row 3
1209            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1210                    -column 3 -row 3
1211            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1212                    -width 15 ] -column 4 -row 3
1213            #
1214            grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1215                    -column 1 -row 4 -sticky w
1216            grid [ checkbutton $expgui(diffBox).rfDCpref \
1217                    -variable entryvar(pref) ] -column 2 -row 4
1218            grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1219                    -column 3 -row 4
1220            grid [ entry $expgui(diffBox).eDCpola \
1221                    -textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1222            grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1223                    -column 5 -row 4
1224            grid [ entry $expgui(diffBox).eDCipola -width 2 \
1225                    -textvariable entryvar(ipola)] -column 6 -row 4
1226        } elseif {[string range $expmap(htype_$hist) 1 2] == "XC"} {
1227        #---------------------------
1228        # CW - x-ray 2 wavelengths |
1229        #---------------------------
1230            grid [ label $expgui(diffBox).lDCdifc -text wavelengths ] \
1231                    -column 3 -row 1 -sticky w
1232            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1233                    -width 15 ] -column 4 -row 1
1234            grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1235                    -width 15 ] -column 5 -row 1
1236            #
1237            grid [ label $expgui(diffBox).lDCrref -text "Refine ratio" ] \
1238                    -column 1 -row 2 -sticky w
1239            grid [ checkbutton $expgui(diffBox).rfDCrref \
1240                    -variable entryvar(ratref) ] -column 2 -row 2
1241            grid [ label $expgui(diffBox).lDCratio -text Ratio ] \
1242                    -column 3 -row 2
1243            grid [ entry $expgui(diffBox).eDCkratio \
1244                    -textvariable entryvar(kratio) \
1245                    -width 15 ] -column 4 -row 2
1246            #
1247            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1248                    -column 3 -row 3
1249            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1250                    -width 15 ] -column 4 -row 3
1251            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1252                    -column 1 -row 3 -sticky w
1253            grid [ checkbutton $expgui(diffBox).rfDCzref \
1254                    -variable entryvar(zref) ] -column 2 -row 3
1255            grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1256                    -column 1 -row 4 -sticky w
1257            grid [ checkbutton $expgui(diffBox).rfDCpref \
1258                    -variable entryvar(pref) ] -column 2 -row 4
1259            grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1260                    -column 3 -row 4
1261            grid [ entry $expgui(diffBox).eDCpola \
1262                    -textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1263            grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1264                    -column 5 -row 4
1265            grid [ entry $expgui(diffBox).eDCipola -width 2 \
1266                    -textvariable entryvar(ipola)] -column 6 -row 4
1267        } elseif {[string range $expmap(htype_$hist) 1 2] == "XE"} {
1268        #-------------
1269        # ED - x-ray |
1270        #-------------
1271            grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1272                    -column 1 -row 1
1273            grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1274                    -column 2 -row 1
1275            grid [ label $expgui(diffBox).lDCdifc -text 2Theta ] \
1276                    -column 3 -row 1 -sticky w
1277            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1278                    -width 15 ] -column 4 -row 1
1279            #
1280            grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1281                    -column 1 -row 4 -sticky w
1282            grid [ checkbutton $expgui(diffBox).rfDCpref \
1283                    -variable entryvar(pref) ] -column 2 -row 4
1284            grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1285                    -column 3 -row 4
1286            grid [ entry $expgui(diffBox).eDCpola \
1287                    -textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1288            grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1289                    -column 5 -row 4
1290            grid [ entry $expgui(diffBox).eDCipola -width 2 \
1291                    -textvariable entryvar(ipola)] -column 6 -row 4
1292        }
1293    } elseif {$expgui(globalmode) == 1} {
1294        #-------------
1295        # Global TOF |
1296        #-------------
1297        grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1298                -column 1 -row 1
1299        grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1300                -column 2 -row 1
1301        grid [button $expgui(diffBox).bDCdifc -text "Set DIFC Globally" \
1302                -command "editglobalparm histinfo difc {DIFC}"] -column 3 -row 1
1303        #
1304        grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1305                -column 1 -row 2
1306        grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1307                -column 2 -row 2
1308        grid [ button $expgui(diffBox).bDCdifa -text "Set DIFA Globally" \
1309                -command "editglobalparm histinfo difa {DIFA}"] -column 3 -row 2
1310        #
1311        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1312                -column 1 -row 3 -sticky w
1313        grid [ checkbutton $expgui(diffBox).rfDCzref \
1314                -variable entryvar(zref) ] -column 2 -row 3
1315        grid [ button $expgui(diffBox).bDCzero -text "Set ZERO Globally" \
1316                -command "editglobalparm histinfo zero {Zero}"] -column 3 -row 3
1317    } elseif {$expgui(globalmode) == 2} {
1318        #--------------------
1319        # Global CW neutron |
1320        #--------------------
1321        grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1322                -column 1 -row 1
1323        grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1324                -column 2 -row 1
1325        grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1326                -command "editglobalparm histinfo lam1 Wavelength"] \
1327                -column 3 -row 1
1328        #
1329        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1330                -column 1 -row 3 -sticky w
1331        grid [ checkbutton $expgui(diffBox).rfDCzref \
1332                -variable entryvar(zref) ] -column 2 -row 3
1333        grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1334                -command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1335    } elseif {$expgui(globalmode) == 4} {
1336        #----------------------
1337        # Global CW mono xray |
1338        #----------------------
1339        grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1340                -column 1 -row 1
1341        grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1342                -column 2 -row 1
1343        grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1344                -command "editglobalparm histinfo lam1 Wavelength"] \
1345                -column 3 -row 1
1346        #
1347        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1348                -column 1 -row 3 -sticky w
1349        grid [ checkbutton $expgui(diffBox).rfDCzref \
1350                -variable entryvar(zref) ] -column 2 -row 3
1351        grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1352                -command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1353        #
1354        grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1355                -column 1 -row 4 -sticky w
1356        grid [ checkbutton $expgui(diffBox).rfDCpref \
1357                -variable entryvar(pref) ] -column 2 -row 4
1358        grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1359                -command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1360        grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1361                -command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1362    } elseif {$expgui(globalmode) == 3} {
1363        #------------------------
1364        # Global alpha 1,2 xray |
1365        #------------------------
1366        grid [button $expgui(diffBox).bDCl1 -text "Set Wave1 Globally" \
1367                -command "editglobalparm histinfo lam1 {Wavelength 1}"] \
1368                -column 3 -row 1
1369        grid [button $expgui(diffBox).bDCl2 -text "Set Wave2 Globally" \
1370                -command "editglobalparm histinfo lam2 {Wavelength 2}"] \
1371                -column 4 -row 1
1372        #
1373        grid [ label $expgui(diffBox).lDCratref -text "Refine Ratio" ] \
1374                -column 1 -row 3 -sticky w
1375        grid [ checkbutton $expgui(diffBox).rfDCratref \
1376                -variable entryvar(ratref) ] -column 2 -row 3
1377        grid [button $expgui(diffBox).bDCrrat -text "Set Ratio Globally" \
1378                -command "editglobalparm histinfo ratio {Wavelength Ratio}"] \
1379                -column 3 -row 3
1380        #
1381        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1382                -column 1 -row 3 -sticky w
1383        grid [ checkbutton $expgui(diffBox).rfDCzref \
1384                -variable entryvar(zref) ] -column 2 -row 3
1385        grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1386                -command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1387        #
1388        grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1389                -column 1 -row 4 -sticky w
1390        grid [ checkbutton $expgui(diffBox).rfDCpref \
1391                -variable entryvar(pref) ] -column 2 -row 4
1392        grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1393                -command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1394        grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1395                -command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1396    } elseif {$expgui(globalmode) == 5} {
1397        #-----------------
1398        # Global ED xray |
1399        #-----------------
1400        grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1401                -column 1 -row 1
1402        grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1403                -column 2 -row 1
1404        grid [button $expgui(diffBox).bDCdifc -text "Set 2Theta Globally" \
1405                -command "editglobalparm histinfo ratio {Fixed 2Theta}"] \
1406                -column 3 -row 1
1407        #
1408        grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1409                -column 1 -row 4 -sticky w
1410        grid [ checkbutton $expgui(diffBox).rfDCpref \
1411                -variable entryvar(pref) ] -column 2 -row 4
1412        grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1413                -command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1414        grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1415                -command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1416    }
1417    if {$expgui(globalmode) == 0} {
1418        grid [frame $expgui(diffBox).d] -column 5 -row 5 \
1419                -columnspan 2 -sticky e
1420    } else {
1421        grid [frame $expgui(diffBox).d] -column 4 -row 5 \
1422                -columnspan 2 -sticky e
1423    }
1424    grid [label $expgui(diffBox).d.lDamp -text "Damping  "] \
1425            -column 1 -row 1
1426    tk_optionMenu $expgui(diffBox).d.om entryvar(ddamp) 0 1 2 3 4 5 6 7 8 9
1427    grid $expgui(diffBox).d.om -column 2 -row 1
1428    grid columnconfigure $expgui(diffBox) 9  -weight 1
1429    grid columnconfigure $expgui(diffBox) 0  -weight 1
1430    update idletasks
1431    # enable traces on entryvar now
1432    set entrycmd(trace) 1
1433}
1434
1435#-----------------------------------------------------------------------
1436# populate the Scaling page
1437#-----------------------------------------------------------------------
1438proc DisplayFrac {} {
1439    global expgui entrycmd entryvar expmap
1440
1441    # trap if more than one histogram is selected unless global mode
1442    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1443        set expgui(curhist) [lindex $expgui(curhist) 0]
1444    }
1445
1446    # display the selected histograms
1447    $expgui(fracFrame).hs.lbox selection clear 0 end
1448    foreach h $expgui(curhist) {
1449        $expgui(fracFrame).hs.lbox selection set $h
1450    }
1451
1452    # disable traces on entryvar
1453    set entrycmd(trace) 0
1454
1455    # get histogram list
1456    set histlist {}
1457    foreach item $expgui(curhist) {
1458        lappend histlist [lindex $expmap(powderlist) $item]
1459    }
1460
1461    # must have at least one histogram selected here
1462    if {[llength $histlist] == 0} {
1463        foreach var {scale sref sdamp} {
1464            set entrycmd($var) ""
1465            set entryvar($var) ""
1466        }
1467        set parm [grid info $expgui(scaleBox).but1]
1468        if {$parm != ""} {
1469            grid forget  $expgui(scaleBox).but1
1470            eval grid $expgui(scaleBox).ent1 $parm
1471        }
1472        # destroy the contents of the frame
1473        set phaseFractf1 $expgui(FracBox).f
1474        eval destroy [grid slaves $phaseFractf1]
1475        # reenable traces on entryvar
1476        set entrycmd(trace) 1
1477        return
1478    }
1479
1480    #--------------
1481    # Scale factor
1482    #--------------
1483    if {$expgui(globalmode) != 0} {
1484        foreach var {scale sref sdamp} {
1485            set entrycmd($var) "histinfo [list $histlist] $var"
1486            set entryvar($var) [histinfo [lindex $histlist 0] $var]
1487        }
1488        set parm [grid info $expgui(scaleBox).ent1]
1489        if {$parm != ""} {
1490            grid forget  $expgui(scaleBox).ent1
1491            eval grid $expgui(scaleBox).but1 $parm
1492        }
1493    } else {
1494        set hist $histlist
1495        foreach var {scale sref sdamp} {
1496            set entrycmd($var) "histinfo $hist $var"
1497            set entryvar($var) [eval $entrycmd($var)]
1498        }
1499        set parm [grid info $expgui(scaleBox).but1]
1500        if {$parm != ""} {
1501            grid forget  $expgui(scaleBox).but1
1502            eval grid $expgui(scaleBox).ent1 $parm
1503        }
1504    }
1505
1506    #----------------
1507    # Phase Fractions
1508    #----------------
1509    set phaseFractf1 $expgui(FracBox).f
1510    # destroy the contents of the frame
1511    eval destroy [grid slaves $phaseFractf1]
1512    if {$expgui(globalmode) != 0} {
1513        grid [label $phaseFractf1.txt -anchor center \
1514                -text "Phase Fractions for Histograms: [CompressList $histlist]"] \
1515                -column 0 -row 0 -sticky news
1516    } else {
1517        grid [label $phaseFractf1.txt -anchor center \
1518                -text "Phase Fractions"] -column 0 -row 0 -sticky news
1519    }
1520    # Create the frame inside the canvas, One frame for each Phase.
1521    foreach i {1 2 3 4 5 6 7 8 9} {set phasehistlist($i) ""}
1522    foreach hist $histlist {
1523        foreach i $expmap(phaselist_$hist) {
1524            lappend phasehistlist($i) $hist
1525        }
1526    }
1527    foreach i {1 2 3 4 5 6 7 8 9} {
1528        if {[llength $phasehistlist($i)] == 0} continue
1529        set framePF [frame $phaseFractf1.pF$i -relief groove  -bd 4]
1530        grid $framePF -column 0 -row $i -sticky ew
1531        # Label Heading for each phase.
1532        if {$expgui(globalmode) != 0} {
1533            grid [label $framePF.l1 \
1534                    -text "Phase $i Hist: [CompressList $phasehistlist($i)] Fraction"] \
1535                    -column 0 -row 0 -sticky nws
1536            grid [button $framePF.but1 -text "Set Globally" \
1537                    -command "editglobalparm hapinfo frac \"Phase $i Fraction\" \
1538                    [list $phasehistlist($i)] $i" \
1539                    ] -column 1 -row 0
1540        } else {
1541            grid [label $framePF.l1  -text "Phase $i fraction"] \
1542                    -column 0 -row 0 -sticky nws
1543            grid [entry $framePF.ent -textvariable entryvar(frac$i) -width 15]\
1544                    -column 1 -row 0
1545        }
1546        set entrycmd(frac$i) "hapinfo $hist $i frac"
1547        set entryvar(frac$i) [hapinfo $hist $i frac]
1548        grid [label $framePF.l2  -text "  Refine"] \
1549                -column 2 -row 0 -sticky nws
1550        grid [checkbutton $framePF.cb -variable entryvar(frref$i)] \
1551                -column 3 -row 0 -sticky nws
1552        set entrycmd(frref$i) "hapinfo $hist $i frref"
1553        set entryvar(frref$i) [hapinfo $hist $i frref]
1554        grid [label $framePF.l3  -text "  Damping"] \
1555                -column 4 -row 0 -sticky nws
1556        tk_optionMenu $framePF.tkOptDamp entryvar(frdamp$i) \
1557                0 1 2 3 4 5 6 7 8 9     
1558        set entrycmd(frdamp$i) "hapinfo $hist $i frdamp"
1559        set entryvar(frdamp$i) [hapinfo $hist $i frdamp]
1560        grid $framePF.tkOptDamp -row 0 -sticky nsw -column 5
1561    }
1562    # resize the scroll window to match the actual
1563    update idletasks
1564    $expgui(FracBox) config -scrollregion [grid bbox $expgui(FracBox).f]
1565    $expgui(FracBox) config -width [lindex [grid bbox $expgui(FracBox).f] 2]
1566    update idletasks
1567    # enable traces on entryvar now
1568    set entrycmd(trace) 1
1569}
1570
1571#-----------------------------------------------------------------------
1572# display the profile page
1573#-----------------------------------------------------------------------
1574proc DisplayProfile {} {
1575    global expgui entrycmd entryvar expmap
1576
1577    # trap if more than one histogram is selected unless global mode
1578    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1579        set expgui(curhist) [lindex $expgui(curhist) 0]
1580    }
1581    # display the selected histograms
1582    $expgui(profFrame).hs.lbox selection clear 0 end
1583    foreach h $expgui(curhist) {
1584        $expgui(profFrame).hs.lbox selection set $h
1585    }
1586
1587    # destroy the contents of the frame
1588    eval destroy [grid slaves  $expgui(ProfileBox).f]
1589
1590    if {$expgui(globalmode) == 0} {
1591        # must have at least one histogram selected here
1592        if {[llength $expgui(curhist)] == 0} return
1593        # disable traces on entryvar for right now
1594        set entrycmd(trace) 0
1595        set hist [lindex $expmap(powderlist) $expgui(curhist)]
1596        # no defined histograms?
1597        if {$hist == ""} return
1598        # Create one frame for each Phase.
1599        set ind -1
1600        set htype [string range $expmap(htype_$hist) 2 2]
1601        foreach i $expmap(phaselist_$hist) {
1602            incr ind
1603            grid [frame $expgui(ProfileBox).f.$i -relief groove -bd 4] \
1604                    -column 0 -row $ind -sticky ew
1605            grid [frame $expgui(ProfileBox).f.$i.1] \
1606                    -column 0 -row 0 -columnspan 10 -sticky ew
1607            # Label Heading for each phase.
1608            set ptype [string trim [hapinfo $hist $i proftype]]
1609            pack [label $expgui(ProfileBox).f.$i.1.l  \
1610                    -text "Phase $i -- type $ptype    Damping"]\
1611                    -side left
1612            tk_optionMenu $expgui(ProfileBox).f.$i.1.tkOptDamp entryvar(pdamp_$i) \
1613                    0 1 2 3 4 5 6 7 8 9
1614            set entrycmd(pdamp_$i) "hapinfo $hist $i pdamp"
1615            set entryvar(pdamp_$i) [hapinfo $hist $i pdamp]
1616            pack $expgui(ProfileBox).f.$i.1.tkOptDamp -side left
1617            pack [label $expgui(ProfileBox).f.$i.1.l1 \
1618                    -text "  Peak cutoff"]\
1619                    -side left
1620            pack [entry $expgui(ProfileBox).f.$i.1.e1  \
1621                    -width 10 -textvariable entryvar(pcut_$i)]\
1622                    -side left
1623            set entrycmd(pcut_$i) "hapinfo $hist $i pcut"
1624            set entryvar(pcut_$i) [hapinfo $hist $i pcut]
1625           
1626            set col -1
1627            set row 1
1628            set nterms [hapinfo $hist $i profterms]
1629            set lbls {}
1630            catch {set lbls $expgui(prof-$htype-$ptype)}
1631            # for type 4, add extra terms depending on the cell type
1632            if {$ptype == 4} {set lbls [type4lbls $lbls $nterms $i]}
1633            for { set num 1 } { $num <= $nterms } { incr num } {
1634                set term {}
1635                catch {set term [lindex $lbls $num]}
1636                if {$term == ""} {set term $num}
1637                incr col
1638                grid [label $expgui(ProfileBox).f.$i.l${num}_${i} -text "$term"] \
1639                        -row $row -column $col
1640                incr col
1641                grid [checkbutton $expgui(ProfileBox).f.$i.ref${num}_${i} \
1642                        -variable entryvar(pref${num}_$i)] -row $row -column $col
1643                set entrycmd(pref${num}_$i) "hapinfo $hist $i pref$num"
1644                set entryvar(pref${num}_$i) [hapinfo $hist $i pref$num]
1645                incr col
1646                grid [entry $expgui(ProfileBox).f.$i.ent${num}_${i} \
1647                        -textvariable entryvar(pterm${num}_$i)\
1648                        -width 12] -row $row -column $col
1649                set entrycmd(pterm${num}_$i) "hapinfo $hist $i pterm$num"
1650                set entryvar(pterm${num}_$i) [hapinfo $hist $i pterm$num]
1651                if {$col > 6} {set col -1; incr row}
1652            }
1653        }
1654        grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
1655    } else {
1656        # get histogram list
1657        set histlist {}
1658        foreach item $expgui(curhist) {
1659            lappend histlist [lindex $expmap(powderlist) $item]
1660        }
1661        # must have at least one histogram selected here
1662        if {[llength $histlist] == 0} return
1663        # disable traces on entryvar for right now
1664        set entrycmd(trace) 0
1665        # loop through histograms & phases, set up an array by phase & profile type
1666        catch {unset prtyparray histarray phasearray}
1667        foreach hist $histlist {
1668            foreach phase $expmap(phaselist_$hist) {
1669                set prtyp [string trim [hapinfo $hist $phase proftype]]
1670                set key ${prtyp}_$phase
1671                lappend prtyparray($key) $hist
1672                lappend histarray($key) $hist
1673                lappend phasearray($key) $phase
1674            }
1675        }
1676       
1677        set ptype ""
1678        set i -1
1679        # loop over all combined phases and profile types, sorted 1st by profile number
1680        foreach key [lsort [array names prtyparray]] {
1681            # split key
1682            scan $key %d_%d prftyp p
1683
1684            if {$ptype != $prftyp || !$expgui(globalphasemode)} {
1685                set ptype $prftyp
1686                set curhistlist $histarray($key)
1687                set curphaslist $phasearray($key)
1688               
1689                set hist1 [lindex $curhistlist 0]
1690                set phase1 [lindex $curphaslist 0]
1691                set nterms [hapinfo $hist1 $phase1 profterms]
1692                set htype [string range $expmap(htype_$hist1) 2 2]
1693                set lbls $expgui(prof-$htype-$ptype)
1694                # for type 4, add extra terms depending on the cell type
1695                if {$ptype == 4} {set lbls [type4lbls $lbls $nterms $phase1]}
1696                # Create a frame for this type
1697                incr i
1698                set boxtitle "Phase $p, hist [CompressList $histarray($key)]"
1699                grid [frame $expgui(ProfileBox).f.$i -relief groove -bd 4] \
1700                        -column 0 -row $i -sticky ew
1701                grid [frame $expgui(ProfileBox).f.$i.0] \
1702                        -column 0 -row 0 -columnspan 20 -sticky ew
1703                grid [label $expgui(ProfileBox).f.$i.0.0  \
1704                        -text "Profile Type $ptype   "] -row 0 -column 0
1705                grid [label $expgui(ProfileBox).f.$i.0.1  \
1706                        -anchor w] -row 0 -column 1
1707                grid [frame $expgui(ProfileBox).f.$i.1] \
1708                        -column 0 -row 1 -columnspan 20 -sticky ew
1709                grid [label $expgui(ProfileBox).f.$i.1.2  \
1710                        -text "Damping"] -row 0 -column 2
1711                tk_optionMenu $expgui(ProfileBox).f.$i.1.tkOptDamp \
1712                        entryvar(pdamp_$i) 0 1 2 3 4 5 6 7 8 9
1713                grid $expgui(ProfileBox).f.$i.1.tkOptDamp -row 0 -column 3
1714                grid [button $expgui(ProfileBox).f.$i.1.edit \
1715                        -text "Global Edit"] -row 0 -column 4 -sticky w
1716                set entryvar(pdamp_$i) [hapinfo $hist $phase pdamp]
1717                set col -1
1718                set row 2
1719                for { set num 1 } { $num <= $nterms } { incr num } {
1720                    set term {}
1721                    catch {set term [lindex $lbls $num]}
1722                    if {$term == ""} {set term $num}
1723                    incr col
1724                    grid [label $expgui(ProfileBox).f.$i.l${num}_${i} \
1725                            -text "$term"] -row $row -column $col
1726                    incr col
1727                    grid [checkbutton $expgui(ProfileBox).f.$i.ref${num}_${i} \
1728                            -variable entryvar(pref${num}_$i)] \
1729                            -row $row -column $col
1730                    set entryvar(pref${num}_$i) [hapinfo $hist $phase pref$num]
1731                    if {$col > 10} {set col -1; incr row}
1732                }
1733                grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
1734            } else {
1735                # add to the current entry
1736                eval lappend curhistlist $histarray($key)
1737                eval lappend curphaslist $phasearray($key)
1738                append boxtitle "\nPhase $p, hist [CompressList $histarray($key)]"
1739            }
1740            $expgui(ProfileBox).f.$i.0.1 config -text $boxtitle
1741            $expgui(ProfileBox).f.$i.1.edit config -command "\
1742                    EditProfile \"\n$boxtitle\" \
1743                    [list $curhistlist] \
1744                    [list $curphaslist]"
1745            set entrycmd(pdamp_$i) "hapinfo \
1746                    [list $curhistlist] \
1747                    [list $curphaslist] pdamp"
1748            for { set num 1 } { $num <= $nterms } { incr num } {
1749                set entrycmd(pref${num}_$i) "hapinfo \
1750                        [list $curhistlist] \
1751                        [list $curphaslist] pref$num"
1752            }
1753        }
1754    }
1755   
1756    # resize the scroll window to match the actual
1757    update idletasks
1758    $expgui(ProfileBox) config -scrollregion [grid bbox $expgui(ProfileBox).f]
1759    $expgui(ProfileBox) config -width [lindex [grid bbox $expgui(ProfileBox).f] 2]
1760    update idletasks
1761    # enable traces on entryvar now
1762    set entrycmd(trace) 1
1763}
1764
1765# profile labels for type 4 profile
1766proc type4lbls {lbls nterms phase} {
1767    if {$nterms == 14} {
1768        # cubic
1769        lappend lbls S400 S220
1770    } elseif {$nterms == 15} {
1771        # hexagonal
1772        lappend lbls S400 S004 S202
1773    } elseif {$nterms == 16} {
1774        # tetragonal or rhombohedral
1775        if {[phaseinfo $phase a] == [phaseinfo $phase c]} {
1776            # rhombohedral
1777            lappend lbls S400 S220 S310 S211
1778        } else {
1779            lappend lbls S400 S004 S220 S202
1780        }
1781    } elseif {$nterms == 18} {
1782        # orthorhombic
1783        lappend lbls S400 S040 S004 S220 S202 S022 
1784    } elseif {$nterms == 21} {
1785        # monoclinic 
1786        lappend lbls S400 S040 S004 S220 S202 S022 S301 S103 S121
1787    } elseif {$nterms == 25} {
1788        # triclinic
1789        lappend lbls S400 S040 S004 S220 S202 S022 S310 S103 S031 \
1790                S130 S301 S013 S211 S121 S112
1791    }
1792    return $lbls
1793}
1794
1795# process the bit settings in the print options
1796#   bitnum -- the number of the bit to be tested/set starting at 0 for the LSBit
1797proc printsetting {bitnum "action get" "value {}"} {
1798    global entryvar expgui
1799    if {$action == "get"} {
1800        return [expr ([expinfo print] & int(pow(2,$bitnum))) != 0]
1801    } elseif $value {
1802        set newval [expr ([expinfo print] | int(pow(2,$bitnum)))]
1803    } else {
1804        set newval [expr ([expinfo print] & ~int(pow(2,$bitnum)))]
1805    }
1806    expinfo print set $newval
1807    set expgui(printopt) "Print Options ([expinfo print])"
1808}
1809
1810# need to respond to mouse presses -- control variable associated with extract Fobs
1811# and set the LeBail extraction flags
1812proc SetupExtractHist {} {
1813    global expgui entrycmd entryvar expmap
1814
1815    # display the selected histograms
1816    $expgui(lsFrame).hs.lbox selection clear 0 end
1817    foreach h $expgui(curhist) {
1818        $expgui(lsFrame).hs.lbox selection set $h
1819    }
1820
1821    # get histogram list
1822    set histlist {}
1823    foreach item $expgui(curhist) {
1824        set hist [lindex $expmap(powderlist) $item]
1825        if {$hist != ""} {lappend histlist $hist}
1826    }
1827    set entrycmd(fobsextract) "histinfo [list $histlist] foextract"
1828    if {[llength $histlist] == 0 || [string trim $histlist] == ""} {
1829        foreach phase {1 2 3 4 5 6 7 8 9} {
1830            $expgui(lsFrame).f1.a.l$phase config -fg grey
1831            set expgui(Fextract$phase) {}
1832            foreach item $expgui(ExtractSettingsRadiobuttons) {
1833                ${item}$phase config -state disabled -bd 1
1834            }
1835        }
1836    } elseif {[llength $histlist] == 1} {
1837        # disable traces on entryvar
1838        set entrycmd(trace) 0
1839        set entryvar(fobsextract) [histinfo $histlist foextract]
1840        foreach phase {1 2 3 4 5 6 7 8 9} {
1841            # is the phase present?
1842            if {[lsearch -exact $expmap(phaselist_$histlist) $phase] == -1} {
1843                $expgui(lsFrame).f1.a.l$phase config -fg grey
1844                set expgui(Fextract$phase) {}
1845                foreach item $expgui(ExtractSettingsRadiobuttons) {
1846                    ${item}$phase config -state disabled -bd 1
1847                }
1848            } else {
1849                $expgui(lsFrame).f1.a.l$phase config -fg black
1850                foreach item $expgui(ExtractSettingsRadiobuttons) {
1851                    ${item}$phase config -state normal -bd 2
1852                }
1853                set expgui(Fextract$phase) [hapinfo $histlist $phase extmeth]
1854            }
1855        }
1856    } elseif {[llength $histlist] > 1} {
1857        # disable traces on entryvar
1858        set entrycmd(trace) 0
1859        # multiple histograms need phases in any histogram
1860        foreach phase {1 2 3 4 5 6 7 8 9} {
1861            set gotphase($phase) 0
1862        }           
1863        foreach hist $histlist {
1864            foreach phase $expmap(phaselist_$hist) {
1865                set gotphase($phase) 1
1866            }
1867        }
1868        foreach phase {1 2 3 4 5 6 7 8 9} {
1869            set expgui(Fextract$phase) {}
1870            if $gotphase($phase) {
1871                $expgui(lsFrame).f1.a.l$phase config -fg black
1872                foreach item $expgui(ExtractSettingsRadiobuttons) {
1873                    ${item}$phase config -state normal -bd 2
1874                }
1875            } else {
1876                $expgui(lsFrame).f1.a.l$phase config -fg grey
1877                foreach item $expgui(ExtractSettingsRadiobuttons) {
1878                    ${item}$phase config -state disabled -bd 1
1879                }
1880            }
1881        }
1882    }
1883    # reenable traces
1884    set entrycmd(trace) 1
1885}
1886# respond to a change in the fobs extraction method for a phase
1887# force the main extraction flag on, if fobs extraction is selected for any phase
1888proc HistExtractSet {phase} {
1889    global expgui entryvar expmap
1890    foreach item $expgui(curhist) {
1891        lappend histlist [lindex $expmap(powderlist) $item]
1892    }
1893    hapinfo $histlist $phase extmeth set $expgui(Fextract$phase)
1894    incr expgui(changed)
1895    if {$expgui(Fextract$phase) != 0} {set entryvar(fobsextract) 1}
1896}
1897#---------------------------- Global Edit Functions ------------------------
1898proc editbackground {} {
1899    global expgui expmap entrycmd
1900    set histlist {}
1901    foreach n $expgui(curhist) {
1902        lappend histlist [lindex $expmap(powderlist) $n]
1903    }
1904    if {[llength $histlist] == 0} return
1905
1906    set w .back
1907    catch {destroy $w}
1908    toplevel $w -bg beige
1909    if {$expgui(globalmode) != 0} {
1910        wm title $w "Edit Background"
1911    } else {
1912        wm title $w "Global Edit Background"
1913    }
1914   
1915    pack [frame $w.0 -bd 6 -relief groove  -bg beige \
1916            ] -side top -expand yes -fill both
1917    if {[llength $histlist] > 1} {
1918        grid [label $w.0.a \
1919            -text "Setting background terms for histograms [CompressList $histlist]" \
1920            -bg beige] -row 0 -column 0 -columnspan 10
1921    } else {
1922        grid [label $w.0.a \
1923            -text "Setting background terms for histogram $histlist" \
1924            -bg beige] -row 0 -column 0 -columnspan 10
1925    }
1926    set hist [lindex $histlist 0]
1927    grid [label $w.0.b -text "Function type"  -bg beige]  -row 1 -column 0
1928
1929    # disable traces on  expgui(backtype) & expgui(backterms) now
1930    set entrycmd(trace) 0
1931
1932    # number of terms
1933    set expgui(backtype) [histinfo $hist backtype]
1934    set expgui(orig_backtype) $expgui(backtype)
1935    set expgui(prev_backtype) $expgui(backtype)
1936    eval tk_optionMenu $w.0.type expgui(backtype) {1 2 3 4 5 6}
1937    grid $w.0.type   -row 1 -column 1
1938    grid [label $w.0.c -text "  Number of terms"  -bg beige] -row 1 -column 2
1939
1940    # function type
1941    set expgui(backterms) [histinfo $hist backterms]
1942    set expgui(orig_backterms) $expgui(backterms)
1943    set list {}; for {set i 1} {$i <= 36} {incr i} {lappend list $i}
1944    eval tk_optionMenu $w.0.terms expgui(backterms) $list
1945    grid $w.0.terms   -row 1 -column 3
1946    # enable traces on  expgui(backtype) & expgui(backterms) now
1947    set entrycmd(trace) 1
1948
1949    #set background terms
1950    for {set num 1 } { $num <= 36 } { incr num } {
1951        set var "bterm$num"
1952        set expgui($var) {}
1953        set expgui(orig_$var) {}
1954    }
1955    if {[llength $histlist] == 1} {
1956        for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
1957            set var "bterm$num"
1958            set expgui($var) [histinfo $histlist $var]
1959            set expgui(orig_$var) $expgui($var)
1960        }
1961    }
1962
1963    pack [frame $w.1 -bd 6 -relief groove  -bg beige] -side top \
1964            -expand yes -fill both
1965    ShowBackTerms $w.1
1966
1967    set expgui(temp) {}
1968    pack [frame $w.b] -side top
1969    pack [button $w.b.2 -text Set -command "destroy $w"] -side left
1970    pack [button $w.b.3 -text Quit \
1971            -command "QuitEditBackground $w"] -side left
1972    bind $w <Return> "destroy $w"
1973
1974    # force the window to stay on top
1975    putontop $w
1976
1977    focus $w.b.2
1978    tkwait window $w
1979    afterputontop
1980
1981    if {$expgui(temp) != ""} return
1982
1983    if {$expgui(orig_backtype) != $expgui(backtype)} {
1984        histinfo $histlist backtype set $expgui(backtype)
1985        incr expgui(changed)
1986    }
1987    if {$expgui(orig_backterms) != $expgui(backterms)} {
1988        histinfo $histlist backterms set $expgui(backterms)
1989        incr expgui(changed)
1990    }
1991    for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
1992        set var "bterm$num"
1993        if {$expgui(orig_$var) != $expgui($var)} {
1994            histinfo $histlist $var set $expgui($var)
1995            incr expgui(changed)
1996        }
1997    }
1998
1999    if {$expgui(globalmode) == 0} {
2000        set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
2001        set expgui(backtermlbl) "([histinfo $hist backterms] terms)"
2002    }
2003}
2004
2005trace variable expgui(backterms) w ChangeBackTerms
2006proc ChangeBackTerms {a b c} {
2007    global entrycmd expgui
2008    if !$entrycmd(trace) return
2009    ShowBackTerms .back.1
2010}
2011
2012trace variable expgui(backtype) w ChangeBackType
2013# reset the terms to 1, 0, 0... when the number of terms increase
2014proc ChangeBackType {a b c} {
2015    global entrycmd expgui
2016    if !$entrycmd(trace) return
2017    if {$expgui(prev_backtype) == $expgui(backtype)} return
2018    set expgui(prev_backtype) $expgui(backtype)
2019    for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2020        set var "bterm$num"
2021        if {$num == 1} {
2022            set expgui($var) 1.0
2023        } else {
2024            set expgui($var) 0.0
2025        }
2026    }
2027}
2028
2029proc ShowBackTerms {w } {
2030    global expgui expmap
2031    # destroy the contents of the frame
2032    eval destroy [grid slaves  $w]
2033    set histlist {}
2034    foreach n $expgui(curhist) {
2035        lappend histlist [lindex $expmap(powderlist) $n]
2036    }
2037    set widgetsPerRow 4
2038    for {set rows 2; set num 1 } { $num <= $expgui(backterms) } { incr rows } {
2039        for {set cols 0} { (2*$widgetsPerRow > $cols) && ($num <= $expgui(backterms)) }  { incr num }  {
2040            set var "bterm$num"
2041            grid [label $w.l$num -text $num -bg beige]  \
2042                    -row $rows -column $cols -sticky nes
2043            incr cols
2044            grid [entry $w.e$num -width 15 -textvariable expgui($var) \
2045                    ] -row $rows  -column $cols  -sticky news
2046            incr cols
2047        }
2048    }
2049}
2050
2051proc QuitEditBackground {w} {
2052    global expgui
2053    # lets find out if anything changed
2054    set changed 0
2055    if {$expgui(orig_backtype) != $expgui(backtype)} {
2056        set changed 1
2057    }
2058    if {$expgui(orig_backterms) != $expgui(backterms)} {
2059        set changed 1
2060    }
2061    for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2062        set var "bterm$num"
2063        if {$expgui(orig_$var) != $expgui($var)} {
2064            set changed 1
2065            break
2066        }
2067    }
2068    if $changed {
2069        set decision [tk_dialog .changes "Abandon Changes" \
2070                "You have made changes to the background. Ok to abandon changes?" \
2071                warning 0 Abandon Keep]
2072        if !$decision {
2073            set expgui(temp) "Quit"
2074            destroy $w
2075        }
2076    } else {
2077        set expgui(temp) "Quit"
2078        destroy $w
2079    }
2080}
2081
2082# this probably needs work
2083proc editglobalparm {cmd variable title "histlist {}" "phase {}"} {
2084    global expgui expmap
2085    set w .global
2086    catch {destroy $w}
2087    toplevel $w -bg beige
2088    wm title $w "Edit Global Parameter"
2089    set expgui(temp) {}
2090    if {[llength $histlist] == 0} {
2091        set hist {}
2092        foreach n $expgui(curhist) {
2093            lappend hist [lindex $expmap(powderlist) $n]
2094        }
2095    } else {
2096        set hist $histlist
2097    }
2098    pack [frame $w.0 -bd 6 -relief groove -bg beige] \
2099            -side top -expand yes -fill both
2100    grid [label $w.0.a -text "Setting $title for histograms [CompressList $hist]"\
2101            -bg beige] \
2102            -row 0 -column 0 -columnspan 10
2103    grid [entry $w.0.b -textvariable expgui(temp)] \
2104            -row 1 -column 0
2105
2106
2107    pack [frame $w.b] -side top
2108    pack [button $w.b.2 -text Set -command "destroy $w"] -side left
2109    pack [button $w.b.3 -text Quit -command "set expgui(temp) {}; destroy $w"] -side left
2110    bind $w <Return> "destroy $w"
2111
2112    # force the window to stay on top
2113    putontop $w
2114    focus $w.b.2
2115    tkwait window $w
2116    afterputontop
2117
2118    if {$expgui(temp) != ""} {
2119        foreach h $hist {
2120            if {$cmd == "histinfo"} {
2121                histinfo $h $variable set $expgui(temp)
2122                incr expgui(changed)
2123                if $expgui(debug) {
2124                    puts "histinfo $h $variable set $expgui(temp)"
2125                }
2126            } elseif {$cmd == "hapinfo"} {
2127                hapinfo $h $phase $variable set $expgui(temp)
2128                incr expgui(changed)
2129                if $expgui(debug) {
2130                    puts "hapinfo $phase $h $variable set $expgui(temp)"
2131                }
2132            } else {
2133                error "$cmd unimplemented"
2134            }
2135        }
2136    }
2137}
2138
2139proc EditProfile {title histlist phaselist} {
2140    global expgui expmap entrycmd
2141    set w .back
2142    catch {destroy $w}
2143    toplevel $w -bg beige
2144    wm title $w "Global Edit Profile"
2145    set hist [lindex $histlist 0]
2146    set phase [lindex $phaselist 0]
2147    set ptype [string trim [hapinfo $hist $phase proftype]]
2148    set htype [string range $expmap(htype_$hist) 2 2]
2149    set nterms [hapinfo $hist $phase profterms]
2150   
2151    pack [frame $w.0 -bd 6 -relief groove  -bg beige \
2152            ] -side top -expand yes -fill both
2153    grid [label $w.0.a \
2154            -text "Setting profile terms: $title" \
2155            -bg beige] -row 0 -column 0 -columnspan 10
2156    grid [label $w.0.b -text "Function type $ptype"  -bg beige]  -row 1 -column 0
2157
2158    # number of terms
2159    #    set expgui(backtype) [histinfo $hist backtype]
2160    #    set expgui(orig_backtype) $expgui(backtype)
2161    #    set expgui(prev_backtype) $expgui(backtype)
2162    #    eval tk_optionMenu $w.0.type expgui(backtype) {1 2 3 4 5 6}
2163    #    grid $w.0.type   -row 1 -column 1
2164
2165    grid [label $w.0.c -text "  Peak cutoff" -bg beige] -row 1 -column 3
2166    grid [entry $w.0.d -width 10 ]  -row 1 -column 4
2167    set entrylist {}
2168    lappend entrylist "pcut $w.0.d"
2169
2170    set col -1
2171    set row 1
2172    set lbls $expgui(prof-$htype-$ptype)
2173    # for type 4, add extra terms depending on the cell type
2174    if {$ptype == 4} {set lbls [type4lbls $lbls $nterms $i]}
2175    pack [frame $w.1 -bd 6 -relief groove  -bg beige \
2176            ] -side top -expand yes -fill both
2177    for { set num 1 } { $num <= $nterms } { incr num } {
2178        set term {}
2179        catch {set term [lindex $lbls $num]}
2180        if {$term == ""} {set term $num}
2181        incr col
2182        grid [label $w.1.l${num} -text "$term" -bg beige] \
2183                -row $row -column $col
2184        incr col
2185        grid [entry $w.1.ent${num} \
2186                -width 14] -row $row -column $col
2187        lappend entrylist "pterm$num $w.1.ent${num}"   
2188        if {$col > 6} {set col -1; incr row}
2189    }
2190    pack [frame $w.b] -side top
2191    pack [button $w.b.2 -text Set \
2192            -command "SetEditProfile [list $entrylist] [list $phaselist] \
2193            [list $histlist] $w"] -side left
2194    pack [button $w.b.3 -text Quit \
2195            -command "QuitEditProfile $w [list $entrylist]"] -side left
2196    bind $w <Return> "destroy $w"
2197
2198    # force the window to stay on top
2199    putontop $w
2200    focus $w.b.2
2201    tkwait window $w
2202    afterputontop
2203}
2204
2205proc SetEditProfile {entrylist phaselist histlist w} {
2206    global expgui
2207    foreach item $entrylist {
2208        set value [ [lindex $item 1] get ]
2209        if {$value != ""} {
2210            hapinfo $histlist $phaselist [lindex $item 0] set $value
2211            incr expgui(changed)
2212            if $expgui(debug) {
2213                puts "hapinfo [list $phaselist] [list $histlist] [lindex $item 0] set $value"
2214            }
2215        }
2216    }
2217    destroy $w
2218}
2219
2220proc QuitEditProfile {w entrylist} {
2221    global expgui
2222    # lets find out if anything changed
2223    set changed 0
2224    foreach item $entrylist {
2225        if {[ [lindex $item 1] get ] != ""} {set changed 1; break}
2226    }
2227    if $changed {
2228        set decision [tk_dialog .changes "Abandon Changes" \
2229                "You have made changes to the Profile. Ok to abandon changes?" \
2230                warning 0 Abandon Keep]
2231        if !$decision {destroy $w}
2232    } else {
2233        destroy $w
2234    }
2235}
2236
2237##############################################################################
2238##                               #############################################
2239## END OF THE PROCEDURES SECTION #############################################
2240##                               #############################################
2241##############################################################################
2242
2243# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
2244# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          <<<<<<<<<<<<<<<<<<<
2245# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<   BEGIN:  GUI SECTION    >>>>>>>>>>>>>>>>>>>
2246# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>                          >>>>>>>>>>>>>>>>>>>
2247# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
2248# A frame for menu items at top of display
2249set expgui(fm) [frame .fm -relief raised -borderwidth 2 -width 150 -height 40]
2250# Pack the menu frame.
2251pack $expgui(fm) -fill x -side top -anchor n
2252
2253# create a button bar
2254pack [frame .bar -relief raised -bd 2 -bg beige] -fill x -side top -anchor n
2255
2256# Creating the notebook with 5 panes: Phase, Histogram, Scaling, Profile
2257# & LS controls
2258if $expgui(havetix) {
2259    pack [tixNoteBook .n] -expand yes -fill both
2260    .n add lsFrame -label "LS Controls"
2261    .n pageconfigure lsFrame -raisecmd \
2262                "set expgui(pagenow) lsFrame; SetupExtractHist"
2263    lappend expgui(frameactionlist) "lsFrame SetupExtractHist"
2264    .n add phasePane -label "Phase"
2265    .n pageconfigure phasePane -raisecmd \
2266                "set expgui(pagenow) phaseFrame; DisplayAllAtoms noreset"
2267#    lappend expgui(frameactionlist) "phaseFrame {DisplayAllAtoms noreset}"
2268    .n add histPane -label "Histogram"
2269    .n pageconfigure histPane -raisecmd \
2270                "set expgui(pagenow) histFrame; DisplayHistogram"
2271    lappend expgui(frameactionlist) "histFrame DisplayHistogram"
2272    lappend expgui(GlobalModeAllDisable) "histFrame {.n pageconfigure histPane}"
2273    .n add fracPane -label "Scaling"
2274    .n pageconfigure fracPane -raisecmd \
2275                "set expgui(pagenow) fracFrame; DisplayFrac"
2276    lappend expgui(frameactionlist) "fracFrame DisplayFrac"
2277    .n add profPane -label Profile
2278    .n pageconfigure profPane -raisecmd \
2279                "set expgui(pagenow) profFrame; DisplayProfile"
2280    lappend expgui(frameactionlist) "profFrame DisplayProfile"
2281    lappend expgui(GlobalModeAllDisable) "profFrame {.n pageconfigure profPane}"
2282    # Finding the pathname to the subwidget frames.
2283    set expgui(phaseFrame) [.n subwidget phasePane]
2284    set expgui(histFrame) [.n subwidget histPane]
2285    set expgui(fracFrame) [.n subwidget fracPane]
2286    set expgui(profFrame) [.n subwidget profPane]
2287    set expgui(lsFrame) [.n subwidget lsFrame]
2288} else {
2289    Notebook:create .n -pages {lsFrame phaseFrame histFrame fracFrame profFrame}
2290    pack .n -anchor w -fill both -expand yes
2291    foreach item {lsFrame phaseFrame histFrame fracFrame profFrame} \
2292            page {"LS Controls" Phase Histogram Scaling Profile } {
2293        set expgui($item) [Notebook:frame .n $item]
2294        Notebook:pageconfig .n $item -command "InitPage $item" -title $page
2295    }
2296    lappend expgui(frameactionlist) "lsFrame SetupExtractHist"
2297    lappend expgui(frameactionlist) "phaseFrame {DisplayAllAtoms noreset}"
2298    lappend expgui(frameactionlist) "histFrame DisplayHistogram"
2299    lappend expgui(frameactionlist) "fracFrame DisplayFrac"
2300    lappend expgui(frameactionlist) "profFrame DisplayProfile"
2301    set expgui(GlobalModeAllDisable) {}
2302    lappend expgui(GlobalModeAllDisable) "histFrame {Notebook:pageconfig .n histFrame}"
2303    lappend expgui(GlobalModeAllDisable) "profFrame {Notebook:pageconfig .n profFrame}"
2304}
2305
2306# this is used to bring up the selected frame
2307proc RaisePage {nextpage} {
2308    global expgui
2309    if $expgui(havetix) {
2310        .n raise $nextpage
2311        set expgui(pagenow) $nextpage
2312    } else {
2313        Notebook:raise .n $nextpage
2314        InitPage $nextpage
2315    }
2316}
2317# this is only called when Tix is not present
2318proc InitPage {nextpage} {
2319    global expgui
2320    set expgui(pagenow) $nextpage
2321    foreach set $expgui(frameactionlist) {
2322        if {$expgui(pagenow) == [lindex $set 0]} [lindex $set 1]
2323    }
2324}
2325
2326#----------------------------------------------------------------------------
2327#\/ \/ \/ \/ \/ \/ \/ BEGINNING OF PHASE PANE CODE \/ \/ \/ \/ \/ \/ \/ \/ \/
2328#  Setup major frames here
2329frame $expgui(phaseFrame).top
2330set frameLatt [frame $expgui(phaseFrame).frameLatt]
2331#  This is a big frame in the Phase notebook pane to hold a list of CRS data.
2332set fbig [frame $expgui(phaseFrame).fbig -width 180 -relief raised -borderwidth 4 -bg beige]
2333#  This is a frame just below the big frame: fbig to allow edit of CRS data, One record at a time.
2334set frame3 [frame $expgui(phaseFrame).frame3 -width 100 -relief raised -borderwidth 4 -bg beige]
2335
2336grid $expgui(phaseFrame).top -sticky news -row 0 -column 0
2337grid $frameLatt -sticky news -row 2 -column 0
2338grid $fbig -sticky news -row 3 -column 0
2339# give extra space to the atoms box
2340grid columnconfigure $expgui(phaseFrame) 0 -weight 1
2341grid rowconfigure $expgui(phaseFrame) 3 -weight 1
2342grid $frame3 -sticky news -row 4 -column 0
2343grid columnconfigure $expgui(phaseFrame) 0 -weight 1
2344grid rowconfigure $expgui(phaseFrame) 3 -weight 1
2345grid [frame  $expgui(phaseFrame).top.ps] -column 0 -row 0 -sticky w
2346# this is where the buttons will go
2347pack [label $expgui(phaseFrame).top.ps.0 -text "Phases: "] -side left
2348
2349grid [label $expgui(phaseFrame).top.lA -text "  Phase name:" \
2350        -fg blue ] -column 1 -row 0 -sticky e
2351grid [entry $expgui(phaseFrame).top.lB -textvariable entryvar(phasename) \
2352        -fg blue -width 45] -column 2 -row 0 -sticky e
2353grid columnconfigure $expgui(phaseFrame).top 1 -weight 1
2354# ------------- Lattice Parameter Box ------------------
2355set e1 [entry $frameLatt.e1 -textvariable entryvar(a) -width 10]
2356set e2 [entry $frameLatt.e2 -textvariable entryvar(b) -width 10]
2357set e3 [entry $frameLatt.e3 -textvariable entryvar(c) -width 10]
2358set e4 [entry $frameLatt.e4 -textvariable entryvar(alpha) -width 10]
2359set e5 [entry $frameLatt.e5 -textvariable entryvar(beta) -width 10]
2360set e6 [entry $frameLatt.e6 -textvariable entryvar(gamma) -width 10]
2361set l1 [label $frameLatt.l1 -text "a"]
2362set l2 [label $frameLatt.l2 -text "b"]
2363set l3 [label $frameLatt.l3 -text "c"]
2364set l4 [label $frameLatt.l4 -text a -font symbol]
2365set l5 [label $frameLatt.l5 -text b -font symbol]
2366set l6 [label $frameLatt.l6 -text g -font symbol]
2367grid $e1 -column 1 -row 0 -padx 5
2368grid $e2 -column 3 -row 0 -padx 5
2369grid $e3 -column 5 -row 0 -padx 5
2370grid $e4 -column 1 -row 1 -padx 5
2371grid $e5 -column 3 -row 1 -padx 5
2372grid $e6 -column 5 -row 1 -padx 5
2373grid $l1 -column 0 -row 0 -padx 5 -sticky e
2374grid $l2 -column 2 -row 0 -padx 5 -sticky e
2375grid $l3 -column 4 -row 0 -padx 5 -sticky e
2376grid $l4 -column 0 -row 1 -padx 5 -sticky e
2377grid $l5 -column 2 -row 1 -padx 5 -sticky e
2378grid $l6 -column 4 -row 1 -padx 5 -sticky e
2379
2380grid [label $frameLatt.lr -text "Refine Cell"] -column 6 -row 0 -padx 5 -sticky e
2381grid [label $frameLatt.ld -text "Cell damping"] -column 6 -row 1 -padx 5 -sticky e
2382set cFlag [checkbutton $frameLatt.c -text "" -variable entryvar(cellref)]
2383grid $cFlag -column 7 -row 0 -padx 5 -sticky e
2384tk_optionMenu $frameLatt.om entryvar(celldamp) 0 1 2 3 4 5 6 7 8 9
2385grid $frameLatt.om -column 7 -row 1 -padx 5 -sticky e
2386if [file executable $expgui(exptool)] {
2387    button $frameLatt.newp -text Add\nPhase -command MakeAddPhaseBox
2388    grid $frameLatt.newp -column 0 -row 0 -rowspan 2 -sticky w
2389    grid columnconfig $frameLatt  0 -weight 1
2390}
2391#-------------- Begin Atom Coordinates Box  ---------------------------------
2392grid [listbox   $fbig.title -height 1 -relief flat] \
2393        -row 0 -column 0 -sticky ew
2394set expgui(atomtitle) $fbig.title
2395$expgui(atomtitle) configure -font $expgui(coordfont) -selectmode extended
2396grid [listbox   $fbig.lbox -height 10 \
2397        -xscrollcommand " $fbig.bscr set"\
2398        -yscrollcommand " $fbig.rscr set"\
2399        ] -row 1 -column 0 -sticky news
2400set expgui(atomlistbox) $fbig.lbox
2401$expgui(atomlistbox) configure -font $expgui(coordfont) -selectmode extended
2402grid [scrollbar $fbig.bscr -orient horizontal \
2403        -command "move2boxes \" $fbig.title $fbig.lbox \" " \
2404        ] -row 2 -column 0 -sticky ew
2405grid [scrollbar $fbig.rscr  -command "$fbig.lbox yview" \
2406        ] -row 1 -column 1 -sticky ns
2407# give extra space to the atoms box
2408grid columnconfigure $fbig 0 -weight 1
2409grid rowconfigure $fbig 1 -weight 1
2410
2411proc move2boxes {boxlist args} {
2412    foreach listbox $boxlist {
2413        eval $listbox xview $args
2414    }
2415}
2416#   BIND mouse in editbox
2417bind $expgui(atomlistbox) <ButtonRelease-1>   editRecord
2418bind $expgui(atomlistbox) <Button-3>   SelectAllAtoms
2419
2420#-------------- End Atoms Section  ---------------------------------
2421
2422# --------------------------- Begin Edit Box -------------------------------
2423grid [set expgui(EditingAtoms) [label $frame3.top -bg beige -fg blue]] \
2424        -column 0 -row 0 -padx 2 -pady 3 -columnspan 10 -sticky w
2425if [file executable $expgui(exptool)] {
2426    button $frame3.newa -text "Add New Atom" \
2427            -command {MakeAddAtomsBox $expgui(curPhase)}
2428    grid $frame3.newa -column 11 -row 0
2429}
2430
2431set f3l1 [label $frame3.l1 -text "Refinement Flags " -bg beige]
2432grid $f3l1 -column 0 -row 1 -padx 2 -sticky nsw -pady 3
2433
2434set f3cFlag1 [checkbutton $frame3.cf1 -text "X" -variable entryvar(xref) -bg beige]
2435set f3cFlag2 [checkbutton $frame3.cf2 -text "U" -variable entryvar(uref) -bg beige]
2436set f3cFlag3 [checkbutton $frame3.cf3 -text "F" -variable entryvar(fref) -bg beige]
2437grid $f3cFlag1 -column 1 -row 1 -padx 2 -pady 3 -sticky w
2438grid $f3cFlag2 -column 2 -row 1 -padx 2 -pady 3 -sticky w
2439grid $f3cFlag3 -column 3 -row 1 -padx 2 -pady 3 -sticky w
2440
2441set f3l4 [label $frame3.l4 -text "Damping Factors " -bg beige]
2442grid $f3l4 -column 4 -row 1 -padx 2 -sticky nsw -pady 3
2443
2444tk_optionMenu $frame3.om2 entryvar(xdamp) 0 1 2 3 4 5 6 7 8 9
2445tk_optionMenu $frame3.om3 entryvar(udamp) 0 1 2 3 4 5 6 7 8 9
2446tk_optionMenu $frame3.om4 entryvar(fdamp) 0 1 2 3 4 5 6 7 8 9
2447grid [label $frame3.lom2 -text X -bg beige] -column 5 -row 1 -padx 2 -pady 3 -sticky w
2448grid $frame3.om2 -column 6 -row 1 -padx 2 -pady 3 -sticky w
2449grid [label $frame3.lom3 -text U -bg beige] -column 7 -row 1 -padx 2 -pady 3 -sticky w
2450grid $frame3.om3 -column 8 -row 1 -padx 2 -pady 3 -sticky w
2451grid [label $frame3.lom4 -text F -bg beige] -column 9 -row 1 -padx 2 -pady 3 -sticky w
2452grid $frame3.om4 -column 10 -row 1 -padx 2 -pady 3 -sticky w
2453
2454set expgui(atomreflbl) "$frame3.l1 $frame3.l4 $frame3.lom2 $frame3.lom3 $frame3.lom4 "
2455set expgui(atomref) "$frame3.cf1 $frame3.cf2 $frame3.cf3 $frame3.om2 $frame3.om3 $frame3.om4"
2456
2457set coords [frame $frame3.coords  -width 100 -borderwidth 0  -bg beige]
2458grid $coords -column 0 -row 6 -columnspan 12 -sticky nsew
2459
2460set f3l1 [label $frame3.coords.l1 -text "Label" -bg beige]
2461set f3e1  [entry  $frame3.coords.e1 -textvariable entryvar(label) -width 6]
2462set f3l8 [label $frame3.coords.l8 -text "Coordinates" -bg beige]
2463set f3e8  [entry  $frame3.coords.e8 -textvariable entryvar(x) -width 10]
2464set f3e9  [entry  $frame3.coords.e9 -textvariable entryvar(y) -width 10]
2465set f3e10 [entry $frame3.coords.e10 -textvariable entryvar(z) -width 10]
2466set f3l11 [label $frame3.coords.l11 -text "Occupancy" -bg beige]
2467set f3e11 [entry $frame3.coords.e11 -textvariable entryvar(frac) -width 10]
2468set expgui(atomlabels) "$frame3.coords.l1 $frame3.coords.l8 $frame3.coords.l11"
2469set expgui(atomentry)  "$frame3.coords.e1 $frame3.coords.e8 $frame3.coords.e9 $frame3.coords.e10 $frame3.coords.e11"
2470
2471grid $f3l1 -column 0 -row 4 -padx 2 -sticky nsw -pady 3
2472grid $f3e1 -column 1 -row 4 -padx 2 -sticky nsw -pady 3
2473grid $f3l8 -column 2 -row 4 -padx 2 -sticky nsw -pady 3
2474grid $f3e8 -column 3 -row 4 -padx 2 -sticky nsw -pady 3
2475grid $f3e9 -column 4 -row 4 -padx 2 -sticky nsw -pady 3
2476grid $f3e10 -column 5 -row 4 -padx 2 -sticky nsw -pady 3
2477grid $f3l11 -column 6 -row 4 -padx 2 -sticky nsw -pady 3
2478grid $f3e11 -column 7 -row 4 -padx 2 -sticky nsw -pady 3
2479
2480
2481set f3f31 [frame $frame3.f3f31  -width 100 -borderwidth 0 -bg beige]
2482grid $f3f31 -column 0 -row 7 -columnspan 12
2483set expgui(anisolabels) {}
2484lappend expgui(anisolabels)  [label $f3f31.l13 -text "Uiso" -bg beige]
2485lappend expgui(anisolabels)  [label $f3f31.l14 -text "U22" -bg beige]
2486lappend expgui(anisolabels)  [label $f3f31.l15 -text "U33" -bg beige]
2487lappend expgui(anisolabels)  [label $f3f31.l16 -text "U12" -bg beige]
2488lappend expgui(anisolabels)  [label $f3f31.l17 -text "U13" -bg beige]
2489lappend expgui(anisolabels)  [label $f3f31.l18 -text "U23" -bg beige]
2490
2491set expgui(anisoentry) {}
2492lappend expgui(anisoentry) [entry $f3f31.e13 -textvariable entryvar(U11) -width 10]
2493lappend expgui(anisoentry) [entry $f3f31.e14 -textvariable entryvar(U22) -width 10]
2494lappend expgui(anisoentry) [entry $f3f31.e15 -textvariable entryvar(U33) -width 10]
2495lappend expgui(anisoentry) [entry $f3f31.e16 -textvariable entryvar(U12) -width 10]
2496lappend expgui(anisoentry) [entry $f3f31.e17 -textvariable entryvar(U13) -width 10]
2497lappend expgui(anisoentry) [entry $f3f31.e18 -textvariable entryvar(U23) -width 10]
2498
2499set col 0
2500foreach item1 $expgui(anisolabels) item2 $expgui(anisoentry) {
2501    grid $item1 -column $col -row 0 -sticky nsw -pady 3
2502    incr col
2503    grid $item2 -column $col -row 0 -sticky nsw -pady 3
2504    incr col
2505}
2506# --------------------------- End Edit Box --------------------------------
2507
2508#/\ /\ /\ /\ /\ /\ /\ END OF PHASE PANE CODE /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\
2509#-----------------------------------------------------------------------------
2510#v v v v v v v v v v  BEGINNING OF HISTOGRAM PANE CODE v v v v v v v v v v v v
2511grid [frame $expgui(histFrame).hs] \
2512        -column 0 -row 0 -rowspan 10 -sticky nsew
2513grid columnconfigure $expgui(histFrame) 0 -weight 1
2514grid rowconfigure $expgui(histFrame) 1 -weight 1
2515grid rowconfigure $expgui(histFrame) 2 -weight 1
2516grid rowconfigure $expgui(histFrame) 3 -weight 1
2517grid [listbox $expgui(histFrame).hs.title -height 1 -relief flat \
2518        -font $expgui(histfont) ] -row 0 -column 0 -sticky ew
2519grid [listbox $expgui(histFrame).hs.lbox -height 10 -width 25 \
2520        -font $expgui(histfont) \
2521        -xscrollcommand "$expgui(histFrame).hs.x set" \
2522        -yscrollcommand "$expgui(histFrame).hs.y set" \
2523        ] -row 1 -column 0 -sticky news
2524lappend expgui(HistSelectList) $expgui(histFrame).hs
2525grid [scrollbar $expgui(histFrame).hs.x -orient horizontal \
2526        -command "move2boxes \" $expgui(histFrame).hs.title $expgui(histFrame).hs.lbox \" "
2527        ] -row 2 -column 0 -sticky ew
2528grid [scrollbar $expgui(histFrame).hs.y \
2529        -command "$expgui(histFrame).hs.lbox yview"] \
2530        -row 1 -column 1 -sticky ns
2531grid columnconfigure $expgui(histFrame).hs 0 -weight 1
2532grid rowconfigure $expgui(histFrame).hs 1 -weight 1
2533bind $expgui(histFrame).hs.lbox <ButtonRelease-1>  {
2534    set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
2535    DisplayHistogram
2536}
2537bind $expgui(histFrame).hs.lbox <Button-3>  {
2538    if $expgui(globalmode) {
2539        $expgui(histFrame).hs.lbox selection set 0 end
2540        set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
2541        DisplayHistogram
2542    }
2543}
2544
2545
2546frame $expgui(histFrame).top -borderwidth 4 -relief groove
2547grid [label $expgui(histFrame).top.txt] -row 0 -column 0
2548if $expgui(havetix) {
2549    foreach item {backBox diffBox} num {2 3} \
2550            title {Background "Diffractometer Constants"} {
2551        tixLabelFrame $expgui(histFrame).$item  \
2552                -borderwidth 4 -width 600 -height 100 -label $title
2553        grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
2554        set expgui($item)  [$expgui(histFrame).$item subwidget frame]
2555    }
2556} else {
2557    foreach item {backBox diffBox} num {1 2} \
2558            title {Background "Diffractometer Constants"} {
2559        frame $expgui(histFrame).$item  -borderwidth 4 -relief groove
2560        grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
2561        set expgui($item)  $expgui(histFrame).$item
2562        grid [label $expgui(histFrame).$item.title -text $title] \
2563                -row 0 -column 0 -columnspan 10 -sticky nw
2564    }
2565}
2566if [file executable $expgui(exptool)] {
2567    button $expgui(histFrame).newh -text "Add New Histogram" -command MakeAddHistBox
2568    grid $expgui(histFrame).newh -column 1 -row 6
2569}
2570
2571# BACKGROUND information.
2572# <<<<<<<<<<<<<<<<<<<<<<<<< BACKGROUND  <<<<<<<<<<<<<<<<<<<<<
2573grid [ frame $expgui(backBox).f ] -row 0 -column 0  -columnspan 11
2574grid [ label $expgui(backBox).f.lBGType -textvariable expgui(backtypelbl)] \
2575        -row 1 -column 0 -sticky nws  -padx 2 -pady 3
2576grid [ label $expgui(backBox).f.lBGTerms -textvariable expgui(backtermlbl)] \
2577        -row 1 -column 1 -sticky nws  -padx 2 -pady 3
2578grid [ button $expgui(backBox).f.edit -textvariable expgui(bkglbl) \
2579        -command editbackground] \
2580        -row 1 -column 2 -columnspan 3 -sticky w    -padx 2 -pady 3
2581grid [ frame $expgui(backBox).f1 ] -row 1 -column 0  -columnspan 11 -sticky e
2582grid [ label $expgui(backBox).f1.lfBG -text "  Refine background" ] \
2583        -row 2 -column 1 -sticky news -padx 4 -pady 3
2584grid [ checkbutton $expgui(backBox).f1.rfBG -text "" \
2585        -variable  entryvar(bref) ] \
2586        -row 2 -column 2 -sticky news -padx 4 -pady 3
2587grid [ label $expgui(backBox).f1.lBGDamp -text Damping ] \
2588        -row 2 -column 3 -sticky w    -padx 2 -pady 3
2589tk_optionMenu $expgui(backBox).f1.om  entryvar(bdamp) 0 1 2 3 4 5 6 7 8 9
2590grid $expgui(backBox).f1.om \
2591        -row 2 -column 4 -sticky news -padx 4 -pady 3 -sticky e
2592
2593# DIFFRACTOMETER CONSTANTS SECTION
2594
2595#^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^END OF HISTOGRAM PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2596###############################################################################
2597#v v v v v v v v v v  BEGINNING OF SCALING PANE CODE v v v v v v v v v v
2598
2599pack [frame $expgui(fracFrame).hs] -side left -expand y -fill both
2600grid [listbox $expgui(fracFrame).hs.title -height 1 -relief flat \
2601        -font $expgui(histfont) ] -row 0 -column 0 -sticky ew
2602grid [listbox $expgui(fracFrame).hs.lbox -height 10 -width 25 \
2603        -font $expgui(histfont) \
2604        -xscrollcommand "$expgui(fracFrame).hs.x set" \
2605        -yscrollcommand "$expgui(fracFrame).hs.y set" \
2606        ] -row 1 -column 0 -sticky news
2607lappend expgui(HistSelectList) $expgui(fracFrame).hs
2608grid [scrollbar $expgui(fracFrame).hs.x -orient horizontal \
2609        -command "move2boxes \" $expgui(fracFrame).hs.title $expgui(fracFrame).hs.lbox \" "
2610        ] -row 2 -column 0 -sticky ew
2611grid [scrollbar $expgui(fracFrame).hs.y \
2612        -command "$expgui(fracFrame).hs.lbox yview"] \
2613        -row 1 -column 1 -sticky ns
2614grid columnconfigure $expgui(fracFrame).hs 0 -weight 1
2615grid rowconfigure $expgui(fracFrame).hs 1 -weight 1
2616bind $expgui(fracFrame).hs.lbox <ButtonRelease-1> {
2617    set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
2618    DisplayFrac
2619}
2620bind $expgui(fracFrame).hs.lbox <Button-3>  {
2621    if $expgui(globalmode) {
2622        $expgui(fracFrame).hs.lbox selection set 0 end
2623        set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
2624        DisplayFrac
2625    }
2626}
2627pack [frame $expgui(fracFrame).f1] -fill both -expand true
2628# Create a large canvas area containing a frame for each phase in the data set.
2629# The canvas and vertical scrollbar are inside a frame called f1
2630if $expgui(havetix) {
2631    tixLabelFrame $expgui(fracFrame).f1.scaleBox \
2632            -borderwidth 4 -width 600 -height 100 -label "Scale Factor"
2633    grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
2634    set expgui(scaleBox)  [$expgui(fracFrame).f1.scaleBox subwidget frame]
2635} else {
2636    frame $expgui(fracFrame).f1.scaleBox  -borderwidth 4 -relief groove
2637        grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
2638        set expgui(scaleBox)  $expgui(fracFrame).f1.scaleBox
2639}
2640grid [label $expgui(scaleBox).histSFLabel -text "Scale Factor"] \
2641        -row 1 -column 0 -sticky nws  -padx 2 -pady 3
2642grid [entry $expgui(scaleBox).ent1 -textvariable entryvar(scale) -width 15] \
2643        -row 1 -column 1 -sticky ew -padx 4 -pady 3
2644button $expgui(scaleBox).but1 -text "Set Globally" \
2645        -command "editglobalparm histinfo scale {Scale Factor}"
2646
2647grid [label $expgui(scaleBox).histSFRLabel -text " Refine"] \
2648        -row 1 -column 2 -sticky nws  -padx 2 -pady 3
2649grid [checkbutton $expgui(scaleBox).rf -variable entryvar(sref)] \
2650        -row 1 -column 3 -sticky news -padx 4 -pady 3
2651grid [label $expgui(scaleBox).lD1 -text "Damping"] \
2652        -row 1 -column 4 -sticky w    -padx 2 -pady 3
2653tk_optionMenu $expgui(scaleBox).om entryvar(sdamp) 0 1 2 3 4 5 6 7 8 9
2654grid $expgui(scaleBox).om \
2655        -row 1 -column 5 -sticky news -padx 4 -pady 3
2656grid columnconfigure $expgui(scaleBox) 6  -weight 1
2657
2658grid [set expgui(FracBox) [canvas $expgui(fracFrame).f1.fracBox \
2659        -scrollregion {0 0 5000 500} -width 500 -height 350 -bg lightgrey]] \
2660        -sticky  news -row 1 -column 0
2661grid [scrollbar $expgui(fracFrame).f1.yscroll -orient vertical] \
2662        -sticky ns -row 1 -column 1
2663
2664$expgui(FracBox) config -yscrollcommand "$expgui(fracFrame).f1.yscroll set"
2665$expgui(fracFrame).f1.yscroll config -command { $expgui(FracBox) yview }
2666
2667grid columnconfigure $expgui(fracFrame).f1 0 -weight 1
2668grid rowconfigure $expgui(fracFrame).f1 0 -weight 1
2669frame $expgui(FracBox).f -bd 0
2670$expgui(FracBox) create window 0 0 -anchor nw  -window $expgui(FracBox).f
2671
2672# the rest of the page is created in DisplayFrac
2673# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF SCALING PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2674###############################################################################
2675# v v v v v v v v v v BEGINNING OF PROFILE PANE CODE v v v v v v v v v v v v v
2676pack [frame $expgui(profFrame).hs] -side left -expand y -fill both
2677grid [listbox $expgui(profFrame).hs.title -height 1 -relief flat \
2678        -font $expgui(histfont) ] -row 0 -column 0 -sticky ew
2679grid [listbox $expgui(profFrame).hs.lbox -height 10 -width 25 \
2680        -font $expgui(histfont) \
2681        -xscrollcommand "$expgui(profFrame).hs.x set" \
2682        -yscrollcommand "$expgui(profFrame).hs.y set" \
2683        ] -row 1 -column 0 -sticky news
2684lappend expgui(HistSelectList) $expgui(profFrame).hs
2685grid [scrollbar $expgui(profFrame).hs.x -orient horizontal \
2686        -command "move2boxes \" $expgui(profFrame).hs.title $expgui(profFrame).hs.lbox \" "
2687        ] -row 2 -column 0 -sticky ew
2688grid [scrollbar $expgui(profFrame).hs.y \
2689        -command "$expgui(profFrame).hs.lbox yview"] \
2690        -row 1 -column 1 -sticky ns
2691grid columnconfigure $expgui(profFrame).hs 0 -weight 1
2692grid rowconfigure $expgui(profFrame).hs 1 -weight 1
2693bind $expgui(profFrame).hs.lbox <ButtonRelease-1> {
2694    set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
2695    DisplayProfile
2696}
2697bind $expgui(profFrame).hs.lbox <Button-3>  {
2698    if $expgui(globalmode) {
2699        $expgui(profFrame).hs.lbox selection set 0 end
2700        set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
2701        DisplayProfile
2702    }
2703}
2704
2705# Create a large canvas area containing a frame for each phase in the data set.
2706# The canvas and vertical scrollbar are inside a frame called f1
2707pack [frame $expgui(profFrame).f1] -fill both -expand true
2708grid [set expgui(ProfileBox) [canvas $expgui(profFrame).f1.profileBox \
2709        -scrollregion {0 0 5000 500} -width 500 -height 350 -bg lightgrey]] \
2710        -sticky  news -row 0 -column 0
2711grid [scrollbar $expgui(profFrame).f1.yscroll -orient vertical] \
2712        -sticky ns -row 0 -column 1
2713
2714$expgui(ProfileBox) config -yscrollcommand "$expgui(profFrame).f1.yscroll set"
2715$expgui(profFrame).f1.yscroll config -command { $expgui(ProfileBox) yview }
2716
2717grid columnconfigure $expgui(profFrame).f1 1 -weight 1
2718grid rowconfigure $expgui(profFrame).f1 0 -weight 1
2719frame $expgui(ProfileBox).f -bd 0
2720$expgui(ProfileBox) create window 0 0 -anchor nw  -window $expgui(ProfileBox).f
2721
2722# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF PROFILE PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2723##############################################################################
2724# v v v v v v v v v v BEGINNING OF LS PANE CODE v v v v v v v v v v v v v
2725array set printopts {
2726    0 "Print the reciprocal metric tensor changes"
2727    1 "Print the correlation matrix"
2728    2 "Print the Least-Squares matrices and vectors"
2729    4 "Print the linear constraint matrices"
2730    5 "Print the applied  shifts and shift factors"
2731    6 "Print the reciprocal metric tensor Var-Covar terms"
2732    7 "Print all parameters for each cycle"
2733    8 "Print summary shift/esd data after last cycle"
2734    9 "Print zero/unit pole figure constraint terms"
2735}
2736pack [frame $expgui(lsFrame).hs] -side left -expand y -fill both
2737grid [listbox $expgui(lsFrame).hs.title -height 1 -relief flat \
2738        -font $expgui(histfont) ] -row 0 -column 0 -sticky ew
2739grid [listbox $expgui(lsFrame).hs.lbox -height 10 -width 25 \
2740        -font $expgui(histfont) \
2741        -xscrollcommand "$expgui(lsFrame).hs.x set" \
2742        -yscrollcommand "$expgui(lsFrame).hs.y set" \
2743        ] -row 1 -column 0 -sticky news
2744lappend expgui(HistSelectList) $expgui(lsFrame).hs
2745grid [scrollbar $expgui(lsFrame).hs.x -orient horizontal \
2746        -command "move2boxes \" $expgui(lsFrame).hs.title $expgui(lsFrame).hs.lbox \" "
2747        ] -row 2 -column 0 -sticky ew
2748grid [scrollbar $expgui(lsFrame).hs.y \
2749        -command "$expgui(lsFrame).hs.lbox yview"] \
2750        -row 1 -column 1 -sticky ns
2751grid columnconfigure $expgui(lsFrame).hs 0 -weight 1
2752grid rowconfigure $expgui(lsFrame).hs 1 -weight 1
2753bind $expgui(lsFrame).hs.lbox <ButtonRelease-1> {
2754    set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
2755    SetupExtractHist
2756}
2757bind $expgui(lsFrame).hs.lbox <Button-3>  {
2758    if $expgui(globalmode) {
2759        $expgui(lsFrame).hs.lbox selection set 0 end
2760        set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
2761        SetupExtractHist
2762    }
2763}
2764
2765pack [frame $expgui(lsFrame).f1] -fill both -expand true
2766grid rowconfigure $expgui(lsFrame).f1  4 -weight 1
2767set row 0
2768grid [label $expgui(lsFrame).f1.his1 -pady 6 -text "Last History:"] -row $row -column 0
2769grid [label $expgui(lsFrame).f1.his2 -relief sunken -bd 2 -pady 6 \
2770        -textvariable expgui(last_History)] \
2771        -row $row -column 1 -columnspan 5 -sticky w
2772incr row
2773grid [label $expgui(lsFrame).f1.tit1 -pady 6 -text "Title:"] -row $row -column 0
2774grid [entry $expgui(lsFrame).f1.tit2 \
2775        -textvariable entryvar(title) -width 48] \
2776        -row $row -column 1 -columnspan 5 -sticky w
2777set entrycmd(title) "expinfo title"
2778
2779incr row
2780grid [frame $expgui(lsFrame).f1.b -bd 4 -relief groove] \
2781        -row $row -column 0 -columnspan 2 -pady 3
2782grid [label $expgui(lsFrame).f1.b.lcyc -text "Number of Cycles"] -row 0 -column 0
2783grid [entry $expgui(lsFrame).f1.b.ecyc -width 3 \
2784        -textvariable entryvar(cycles)] -row 0 -column 1
2785grid [menubutton $expgui(lsFrame).f1.lprint -textvariable expgui(printopt) \
2786        -menu $expgui(lsFrame).f1.lprint.menu -bd 4 -relief raised \
2787        ] -row $row -column 2
2788menu $expgui(lsFrame).f1.lprint.menu
2789foreach num [lsort [array names printopts]] {
2790    $expgui(lsFrame).f1.lprint.menu add checkbutton \
2791            -label "$printopts($num) ([expr int(pow(2,$num))])"\
2792        -variable entryvar(printopt$num)
2793}
2794grid [frame $expgui(lsFrame).f1.c -bd 4 -relief groove] -row $row -column 3
2795grid [label $expgui(lsFrame).f1.c.fol -text "Extract Fobs"] -row 0 -column 2
2796grid [checkbutton $expgui(lsFrame).f1.c.foc -variable entryvar(fobsextract)] -row 0 -column 3
2797incr row
2798grid [frame $expgui(lsFrame).f1.a -bd 4 -relief groove] -row $row -column 0 -columnspan 6
2799foreach num {1 2 3 4 5 6 7 8 9} {
2800    grid [label $expgui(lsFrame).f1.a.l$num -text $num] -row 1 -column $num
2801    grid [radiobutton $expgui(lsFrame).f1.a.cc$num \
2802            -command "HistExtractSet $num" \
2803            -variable expgui(Fextract$num) -value 0] \
2804            -row 2 -column $num
2805    grid [radiobutton $expgui(lsFrame).f1.a.ca$num \
2806            -command "HistExtractSet $num" \
2807            -variable expgui(Fextract$num) -value 1] \
2808            -row 3 -column $num
2809#    grid [radiobutton $expgui(lsFrame).f1.a.cb$num \
2810#           -command "HistExtractSet $num" \
2811#           -variable expgui(Fextract$num) -value 2] \
2812#           -row 4 -column $num
2813}
2814set expgui(ExtractSettingsRadiobuttons) $expgui(lsFrame).f1.a.cc
2815lappend expgui(ExtractSettingsRadiobuttons) $expgui(lsFrame).f1.a.ca
2816#lappend expgui(ExtractSettingsRadiobuttons) $expgui(lsFrame).f1.a.cb
2817
2818grid [label $expgui(lsFrame).f1.a.t -text "Intensity Extraction Method" -anchor c] \
2819        -column 0 -columnspan 11 -row 0
2820grid [label $expgui(lsFrame).f1.a.t0 -text "Phase #" -anchor c] -column 0 -row 1
2821grid [label $expgui(lsFrame).f1.a.t1 -text "Rietveld" -anchor c] -column 0 -row 2
2822grid [label $expgui(lsFrame).f1.a.t2 -text "F(calc) Weighted" -anchor c] -column 0 -row 3
2823#grid [label $expgui(lsFrame).f1.a.t3 -text "Equally Weighted" -anchor c] -column 0 -row 4
2824grid [label $expgui(lsFrame).f1.a.t2a -text "(Model biased)" -anchor c] -column 10 -row 3
2825#grid [label $expgui(lsFrame).f1.a.t3a -text "(Le Bail method)" -anchor c] -column 10 -row 4
2826# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF LS PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2827#-------------------------------------------------------------------------
2828#-------------------------------------------------------------------------
2829#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv THE MENU BAR vvvvvvvvvvvvvvvvvvvvvv
2830
2831#---- file menu button
2832menubutton $expgui(fm).file -text File -underline 0 -menu $expgui(fm).file.menu
2833menu $expgui(fm).file.menu
2834if $expgui(debug) {
2835    $expgui(fm).file.menu add command -label "Reset" -underline 0 \
2836            -command "reset"
2837}
2838$expgui(fm).file.menu add command -label "expnam" -underline 0 \
2839        -command readnewexp
2840$expgui(fm).file.menu add command -label "Save" -underline 0 \
2841        -command savearchiveexp
2842$expgui(fm).file.menu add command -label "Save As" -underline 1 \
2843        -command "SaveAsFile"
2844$expgui(fm).file.menu add command -label "Reread .EXP file"  -underline 0 \
2845        -command {rereadexp $expgui(expfile)}
2846#$expgui(fm).file.menu add command -label "Close" -underline 0
2847
2848#---- help menu button
2849menubutton $expgui(fm).help -text Help -underline 0 -menu $expgui(fm).help.menu
2850menu $expgui(fm).help.menu
2851$expgui(fm).help.menu add command -command showhelp -label "Help on Command"
2852$expgui(fm).help.menu add command -label "About..." -underline 0 -command About
2853
2854#---- options menu button
2855menubutton $expgui(fm).option -text Options -underline 0 \
2856        -menu $expgui(fm).option.menu
2857menu $expgui(fm).option.menu
2858
2859$expgui(fm).option.menu add checkbutton  -label "Archive EXP" \
2860        -variable expgui(archive) -underline 0
2861
2862$expgui(fm).option.menu add cascade -menu  $expgui(fm).option.menu.asort \
2863        -label "Sort atoms by"
2864
2865set expgui(asorttype) number
2866menu $expgui(fm).option.menu.asort
2867$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2868        -label number -value number -variable expgui(asorttype)
2869$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2870        -label type -value type -variable expgui(asorttype)
2871$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2872        -label x -value x -variable expgui(asorttype)
2873$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2874        -label y -value y -variable expgui(asorttype)
2875$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2876        -label z -value z -variable expgui(asorttype)
2877
2878
2879$expgui(fm).option.menu add cascade -menu  $expgui(fm).option.menu.hsort \
2880        -label "Sort histograms by"
2881
2882set expgui(hsorttype) number
2883menu $expgui(fm).option.menu.hsort
2884$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
2885        -label number -value number -variable expgui(hsorttype)
2886$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
2887        -label "Histogram type" -value type -variable expgui(hsorttype)
2888$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
2889        -label "Bank #" -value bank -variable expgui(hsorttype)
2890$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
2891        -label "Angle/Wavelength" -value angle -variable expgui(hsorttype)
2892
2893#---- Global mode menu button
2894$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.editmode \
2895        -label "Multiple hist. selection"
2896menu $expgui(fm).option.menu.editmode
2897$expgui(fm).option.menu.editmode add radiobutton  -label "Off" \
2898        -variable expgui(globalmode) -underline 0 -value 0\
2899        -command sethistlist
2900$expgui(fm).option.menu.editmode add radiobutton  -label "All" \
2901        -variable expgui(globalmode) -underline 0 -value 6 \
2902        -command sethistlist
2903$expgui(fm).option.menu.editmode add radiobutton  -label "TOF" \
2904        -variable expgui(globalmode) -underline 0 -value 1 \
2905        -command sethistlist
2906$expgui(fm).option.menu.editmode add radiobutton  -label "CW Neutron" \
2907        -variable expgui(globalmode) -underline 0 -value 2  \
2908        -command sethistlist
2909$expgui(fm).option.menu.editmode add radiobutton  -label "Alpha12 Xray" \
2910        -variable expgui(globalmode) -underline 0 -value 3 \
2911        -command sethistlist
2912$expgui(fm).option.menu.editmode add radiobutton  -label "Monochromatic Xray" \
2913        -variable expgui(globalmode) -underline 0 -value 4 \
2914        -command sethistlist
2915$expgui(fm).option.menu.editmode add radiobutton  -label "Energy Disp Xray" \
2916        -variable expgui(globalmode) -underline 0 -value 5 \
2917        -command sethistlist
2918$expgui(fm).option.menu.editmode add separator
2919$expgui(fm).option.menu.editmode add checkbutton \
2920        -label "Group phases together" \
2921        -variable expgui(globalphasemode) \
2922        -command sethistlist
2923
2924set expgui(globalmode) 0
2925set expgui(globalphasemode) 1
2926
2927if {$tcl_platform(platform) != "windows"} {
2928    $expgui(fm).option.menu  add checkbutton -label "Override backspace" \
2929            -variable env(GSASBACKSPACE)
2930    $expgui(fm).option.menu  add checkbutton -label "Autoload EXP" \
2931            -variable expgui(autoexpload)
2932}
2933
2934$expgui(fm).option.menu add command -label "Save Options" -underline 1 \
2935        -command "SaveOptions"
2936
2937pack $expgui(fm).file $expgui(fm).option -side left  -in $expgui(fm)
2938
2939foreach menu $expgui(menunames) {
2940    set m [string tolower $menu]
2941    pack [menubutton $expgui(fm).$m -text $menu -underline 0 \
2942            -menu $expgui(fm).$m.menu] -side left
2943    menu $expgui(fm).$m.menu
2944}
2945pack $expgui(fm).help  -side right -in $expgui(fm)
2946
2947# add the commands in expgui_menulist
2948foreach menu [array names expgui_menulist ] {
2949    foreach cmd $expgui_menulist($menu) {
2950        set action {}
2951        catch {set action [lindex $expgui_cmdlist($cmd) 0]}
2952        if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
2953        if {$action != "" && $action != "-"} {
2954            eval $expgui(fm).$menu.menu add command \
2955                    -label $cmd -command [list [subst $action]]
2956        }
2957    }
2958}
2959# setup command help
2960foreach cmd [array names expgui_cmdlist] {
2961    set help {}
2962    catch {set help [lindex $expgui_cmdlist($cmd) 1]}
2963    if {$help == ""} {
2964        if {$expgui(debug)} {puts "no help for $cmd"}
2965    } else {
2966        # remove
2967        regsub -all \x09 $help " " help
2968        # preserve blank lines
2969        regsub -all \x0A\x0A $help "AAA1234567890AAA" help
2970        regsub -all \x0A $help " " help
2971        regsub -all "AAA1234567890AAA" $help \x0A\x0A help
2972        regsub -all " +" $help " " help
2973        set expgui_helplist($cmd) [string trim $help]
2974    }
2975}
2976# set up button bar
2977foreach cmd $expgui(buttonlist) {
2978    set action {}
2979    catch {set action [lindex $expgui_cmdlist($cmd) 0]}
2980    if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
2981    if {$action != ""} {
2982        pack [eval button .bar.$cmd -bg beige \
2983                -text $cmd -command [list [subst $action]]] -side left
2984    }
2985}
2986
2987$expgui(fm).file.menu add command -label "Exit"  -underline 1 -command catchQuit
2988#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF MENU DEFINITION ^^^^^^^^^^^^^^^^^^^
2989
2990
2991# handle indirect exits
2992wm protocol . WM_DELETE_WINDOW catchQuit
2993bind . <Control-c> catchQuit
2994
2995set expgui(curPhase) ""
2996set expgui(pagenow) ""
2997set expgui(curhist) {}
2998set expgui(selectedatomlist) {}
2999
3000loadexp $expgui(expfile)
3001
3002# select the 1st phase
3003SelectOnePhase [lindex $expmap(phaselist) 0]
3004# select the first histogram in the list by default (if there are any)
3005if {[llength $expmap(histlistboxcontents)] > 0} {
3006    set expgui(curhist) 0
3007} else {
3008    set expgui(curhist) {}
3009}
3010
3011# execute any local commands for final initialization
3012eval $expgui(initstring)
3013
3014# resize the notebook to fit all the tabs and the largest page
3015if {!$expgui(havetix)} {
3016    Notebook:resize .n
3017}
3018RaisePage lsFrame
3019if {[CountHistory] > 100} {
3020    DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
3021}
Note: See TracBrowser for help on using the repository browser.