source: trunk/expgui @ 359

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

# on 2000/12/22 19:44:07, toby did:
add autoiconify option
require winexec for Win-9x only (not -NT)
Check for use of network directories
Defer whenidle loop (.EXP modification checking) if expgui.lck exists
Remove various unneeded window restacking commands
Allow Autoload in Windows
Allow "Show EXPTOOL output" for all platforms

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