source: trunk/expgui @ 117

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

# on 1999/11/16 15:45:40, toby did:
add timing option for debug
try deleting trace for speed up (no improvement in speed under wish 8.1)

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