source: trunk/expgui @ 74

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

# on 1999/03/30 16:18:11, toby did:
Set expnam on command line to upper case
move expgui to center of screen window, if we will put the file open
on top. This is because the open window can end up partly off screen otherwise.

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