source: trunk/expgui @ 20

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

# on 1999/01/06 04:15:12, toby did:
Many changes so that expgui incorporates tkgsas (gsas shell) capabilities

Allow expgui to create nearly empty .EXP files

Fix the various menus so that these blank files are treated properly

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