source: trunk/expgui @ 390

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

# on 2001/05/11 16:18:58, toby did:
change in location of PGPLOT font file in Windows (now same for all)
support gzip compressed archive files as input in Unix
fix bug on disable "add histogram" button (button is missing if no EXPTOOL)

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