source: branches/sandbox/profcons.tcl @ 1008

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

rcs:* properties removed

  • Property svn:keywords set to Author Date Revision Id
File size: 25.3 KB
Line 
1# Implement profile constraints
2# $Revision: 930 $ $Date: 2009-12-04 23:14:35 +0000 (Fri, 04 Dec 2009) $
3
4
5# make the profile constraints pane
6proc MakeProfileConstraintsPane {} {
7    global expgui expcons
8
9    grid [button $expcons(profilemaster).del -text "Delete" \
10            -command "DeleteProfileConstraints"] \
11            -column 1 -sticky se -row 1 -columnspan 2
12    grid [button $expcons(profilemaster).add -text "Add Constraint" \
13                    -command "NewProfileConstraint"] \
14                    -column 0 -row 1 -sticky sw
15    grid [canvas $expcons(profilemaster).canvas \
16            -scrollregion {0 0 5000 1000} -width 400 -height 250 \
17            -yscrollcommand "$expcons(profilemaster).scroll set"] \
18            -column 0 -row 0 -columnspan 2 -sticky nsew \
19           
20    grid columnconfigure $expcons(profilemaster) 0 -weight 0
21    grid rowconfigure $expcons(profilemaster) 0 -weight 1
22    grid rowconfigure $expcons(profilemaster) 1 -pad 5
23    grid [scrollbar $expcons(profilemaster).scroll \
24            -command "$expcons(profilemaster).canvas yview"] \
25            -row 0 -column 2 -sticky ns
26}
27
28# read and display the profile constraints
29proc DisplayProfileConstraints {} {
30    global expgui expcons expmap
31
32    pleasewait "Processing constraints" 
33    catch {destroy $expcons(profilemaster).canvas.fr}
34    set top [frame $expcons(profilemaster).canvas.fr]
35    $expcons(profilemaster).canvas create window 0 0 -anchor nw -window $top
36    set col -1
37    set row -1
38
39    # column headings
40    incr row
41    set col 0
42    grid [label $top.h$col -text profile\nterm] \
43            -column $col -row $row -columnspan 3
44    incr col 4
45    grid [label $top.h$col -text "#"] \
46            -column $col -row $row 
47    grid columnconfigure $top $col -pad 8
48    incr col 3
49    grid [label $top.h$col -text "  Phase"] -column $col -row $row
50    grid columnconfigure $top $col -pad 8
51    incr col
52    grid [label $top.h$col -text Histograms] -column $col -row $row
53    grid columnconfigure $top $col -pad 8
54    incr col
55    grid [label $top.h$col -text Multiplier] -column $col -row $row
56    grid columnconfigure $top $col -pad 8
57    incr col 2
58    grid [label $top.h$col -text delete\nflag] -column $col -row $row
59    grid columnconfigure $top $col -pad 8
60
61    incr row
62    # vertical spacers
63    foreach col {3 10} {
64        grid [frame $top.vs$col -bd 8 -bg white] \
65                -column $col -row $row -rowspan 999 -sticky nsew
66        grid columnconfig $top $col -minsize 2 -pad 2
67    }
68
69    # loop over used profile terms
70    set msg {}
71    for {set i 1} {$i <= 36} {incr i} {
72        set ncons [constrinfo profile$i get 0]
73        if {$ncons == 0} continue
74        # loop over constraints to look for duplicate phase/hist entries
75        catch {unset varlist}
76        for {set j 1} {$j <= $ncons} {incr j} {
77            # get the constraint list
78            set conslist [constrinfo profile$i get $j]
79            foreach item $conslist {
80                set phaselist [lindex $item 0]
81                set histlist [lindex $item 1]
82                if {$phaselist == "ALL"} {set phaselist $expmap(phaselist)}
83                if {$histlist == "ALL"} {set histlist $expmap(powderlist)}
84                # tabulate phase/parameters used
85                foreach p $phaselist {
86                    foreach h $histlist {
87                        lappend varlist(${h}_$p) $j
88                    }
89                }
90            }
91        }
92        # scan for repeated references to phase/histogram combinations
93        catch {unset errarr errarr1}
94        set errlist {}
95        foreach n [array names varlist] {
96            if {[llength $varlist($n)] > 1} {
97                regexp {(.*)_(.*)} $n dummy h p
98                if [catch {set errarr($p)}] {
99                    set errarr($p) {}
100                    set errarr1($p) {}
101                }
102                # tabulate histograms by phase
103                lappend errarr($p) $h
104                # make a list of constraints
105                foreach c $varlist($n) {
106                    if {[lsearch $errarr1($p) $c] == -1} {
107                        lappend errarr1($p) $c
108                    }
109                }
110                eval lappend errlist $varlist($n)
111            }
112        }
113        catch {
114            foreach p [array names errarr] {
115                if {[llength $errarr($p)] >0} {
116                    append msg " Term #$i: phase $p, histogram(s) [CompressList $errarr($p)]"
117                    append msg " in constraints [CompressList $errarr1($p)]\n"
118                }
119            }
120        }
121        incr row
122        # put a spacer between each term
123        grid [frame $top.spa$row -bd 8 -bg white] \
124                -columnspan 16 -column 0 -row $row -sticky nsew
125        grid rowconfig $top $row -minsize 2 -pad 2
126        incr row
127        set row1 $row
128        # loop over the defined constraints
129        for {set j 1} {$j <= $ncons} {incr j} {
130            set row0 $row
131            # get the constraint list
132            set conslist [constrinfo profile$i get $j]
133
134            # reformat the constraint info
135            set conslist [SortProfileConstraints $conslist]
136            # set the phase & histogram type from the first entry in the list
137            set item [lindex $conslist 0]
138            set h [lindex [lindex $item 1] 0]
139            # trap a bad histogram code -- don't know how this happens, though
140            if {$h == ""} continue
141            if {$h == "ALL"} {set h [lindex $expmap(powderlist) 0]}
142            set p [lindex [lindex $item 0] 0]
143            if {$p == "ALL"} {set p [lindex $expmap(phaselist_$h) 0]}
144            # profile type
145            set ptype [string trim [hapinfo $h $p proftype]]
146            # histogram type
147            set htype [string range $expmap(htype_$h) 2 2]   
148            # get the profile term labels
149            set lbl [lindex "dummy [GetProfileTerms $p $h $ptype]" $i]
150            if {$lbl == ""} {set lbl ?}
151
152            foreach item $conslist {
153                set col 6
154                incr row
155                grid [label $top.tn${row}-$col \
156                        -text [CompressList [lindex $item 0]]] \
157                        -column [incr col] -row $row
158                grid [label $top.tn${row}-$col \
159                        -text [CompressList [lindex $item 1]]] \
160                        -column [incr col] -row $row
161                grid [label $top.tn${row}-$col -text [lindex $item 2]] \
162                        -column [incr col] -row $row
163                incr col
164            }
165            incr row
166            grid [label $top.ts$row0 -text $j] -column 4 \
167                    -row $row0 -rowspan [expr $row - $row0]
168            if {[lsearch $errlist $j] != -1} {$top.ts$row0 config -fg red}
169            grid [label $top.tu$row0 -text "($lbl)"] -column 2 \
170                -row $row0 -rowspan [expr $row - $row0]
171            grid [button $top.edit$row0 -text edit \
172                    -command "EditProfileConstraint $i $j [list $conslist]" \
173                    ] -column 5 -row $row0 -rowspan [expr $row - $row0]
174            set expcons(delete${i}_$j) 0
175            grid [checkbutton $top.del$row0 \
176                    -variable expcons(delete${i}_$j)] -column 11 \
177                    -row $row0 -rowspan [expr $row - $row0]
178            if {$j < $ncons} {
179                # put a spacer between each term
180                grid [frame $top.spb$row -bd 1 -bg white] \
181                        -columnspan 11 -column 3 -row $row -sticky nsew
182                grid rowconfig $top $row -minsize 1 -pad 1
183                incr row
184            }
185        }
186        grid [label $top.tt$row -text "#$i  "] -column 0 \
187                -row $row1 -rowspan [expr $row - $row1]
188    }
189    # resize the canvas & scrollbar
190    update idletasks
191    set sizes [grid bbox $top]
192    $expcons(profilemaster).canvas config -scrollregion $sizes
193    set hgt [lindex $sizes 3]
194    # set the maximum height for the canvas from the frame
195    set maxheight [expr \
196            [winfo height [winfo parent $expgui(consFrame)]] - 130]
197
198    # use the scroll for BIG constraint lists
199    if {$hgt > $maxheight} {
200        grid $expcons(profilemaster).scroll -sticky ns -column 2 -row 0
201    } else {
202        grid forget $expcons(profilemaster).scroll
203    }
204    $expcons(profilemaster).canvas config \
205            -height $maxheight \
206            -width [lindex $sizes 2]
207    $expgui(consFrame).n compute_size
208    donewait
209    if {$msg != ""} {
210        set msg "Error: a phase/histogram profile can appear in only one constraint. Here is a list of parameters that are referenced in more than one constraint:\n\n$msg"
211        MyMessageBox -icon error -message $msg \
212                -helplink "expgui6.html ProfileConstraintErr" \
213                -parent [winfo toplevel $expgui(consFrame)] 
214    }
215}
216
217
218# summarize profile constraints:
219# group histograms that have the same phase & mult
220proc SortProfileConstraints {conslist} {
221    # grouped list
222    set glist {}
223    # previous phase
224    set pp 0
225    # phase list
226    set pplist {}
227    # sort list on phase (add a dummy element)
228    foreach item "[lsort -index 0 $conslist] {0 0 0}" {
229        set p [lindex $item 0]
230        if {$p != $pp} {
231            # ok have a list containing only 1 phase
232            if {$pp != 0} {
233                set mp 0
234                set hl {}
235                foreach item2 "[lsort -index 2 -decreasing -real $pplist] {0 0 0}" {
236                    set m [lindex $item2 2]
237                    if {$m != $mp} {
238                        # have a list containing 1 phase and the same multiplier
239                        if {$mp != 0} {
240                            # do we another entry with the same multiplier
241                            set hl [lsort $hl]
242                            set i 0
243                            foreach item3 $glist {
244                                if {[lindex $item3 1] == $hl && \
245                                        [lindex $item3 2] == $mp} {
246                                    # got one that matches
247                                    # add the phase & replace it
248                                    set pp "[lindex $item3 0] $pp"
249                                    set glist [lreplace \
250                                            $glist $i $i \
251                                            "[list $pp] [list $hl] $mp"]
252                                    break
253                                }
254                                incr i
255                            }
256                            # we have looped all the way through
257                            # not matched, so add it to the list
258                            if {$i == [llength $glist]} {
259                                lappend glist "$pp [list $hl] $mp"
260                            }
261                        }
262                        set mp $m
263                        set hl [lindex $item2 1]
264                    } else {
265                        lappend hl [lindex $item2 1]
266                    }
267                }
268            }
269            set pp $p
270            set pplist [list $item]
271        } else {
272            lappend pplist $item
273        }
274    }
275    return $glist
276}
277
278# called to edit a single profile constraint set
279proc EditProfileConstraint {term num conslist} {
280    global expcons expmap expgui
281
282    set top {.editcons}
283    catch {toplevel $top}
284    eval destroy [grid slaves $top]
285    bind $top <Key-F1> "MakeWWWHelp expgui6.html EditProfileConstraints"
286
287    if {$num != "add"} {
288        # set the phase & histogram type from the first entry in the list
289        set item [lindex $conslist 0]
290        set h [lindex [lindex $item 1] 0]
291        if {$h == "ALL"} {set h [lindex $expmap(powderlist) 0]}
292        set p [lindex [lindex $item 0] 0]
293        if {$p == "ALL"} {set p [lindex $expmap(phaselist_$h) 0]}
294        # profile type
295        set ptype [string trim [hapinfo $h $p proftype]]
296        # histogram type
297        set htype [string range $expmap(htype_$h) 2 2]   
298        set expcons(ProfileHistType) [string range $expmap(htype_$h) 2 2]   
299    } else {
300        set p $expcons(ProfilePhase)
301        set ptype $expcons(ProfileFunction)
302        set htype $expcons(ProfileHistType)
303    }
304    set lbls "dummy [GetProfileTerms $p $htype $ptype]"
305    # get the cached copy of the profile term labels, when possible
306    if {$num != "add"} {
307        wm title $top "Constraint #$num for term $term"
308        set lbl [lindex $lbls $term]
309        if {$lbl == ""} {set lbl ?}
310        set txt "Editing constraint #$num for term $term ($lbl)"
311    } else {
312        wm title $top "New constraint for term(s) [CompressList $term]"
313        set txt "Editing new constraint for term(s) "
314        set i 0
315        foreach t $term {
316            set lbl [lindex $lbls $t]
317            if {$lbl == ""} {set lbl ?}
318            if {$i == 3 || $i == 10 || $i == 16 || $i == 22} {
319                append txt ",\n"
320            } elseif {$i != 0} {
321                append txt ", "
322            }
323            append txt "$t ($lbl)"
324            incr i
325        }
326    }
327    grid [label $top.top -text $txt -anchor w] -column 0 -row 0 -columnspan 20
328
329    if {$expcons(ProfileHistType) == "T"} {
330        set type "TOF"
331    } elseif {$expcons(ProfileHistType) == "C"} {
332        set type "Constant Wavelength"
333    } elseif {$expcons(ProfileHistType) == "E"} {
334        set type "Energy Dispersive X-ray"
335    }
336    grid [label $top.typ -text "Histogram type: $type"] \
337            -column 0 -row 1 -columnspan 20
338    grid [canvas $top.canvas \
339            -scrollregion {0 0 5000 500} -width 100 -height 50 \
340            -xscrollcommand "$top.scroll set"] \
341            -column 0 -row 2 -columnspan 4 -sticky nsew
342    grid columnconfigure $top 3 -weight 1
343    grid rowconfigure $top 2 -weight 1
344    catch {destroy $top.scroll}
345    scrollbar $top.scroll -orient horizontal \
346            -command "$top.canvas xview"
347    #    grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
348    # create a scrollable frame inside the canvas
349    set cfr [frame $top.canvas.fr -class HistList]
350    $top.canvas create window 0 0 -anchor nw  -window $cfr
351
352    grid [button $top.add -text "New Column" \
353            -command "NewProfileConstraintColumn $top $cfr" \
354            ] -column 0 -row 4  -columnspan 2 -sticky ew
355    grid [button $top.done -text "Save" \
356            -command "SaveProfileConstraint $num [list $term] $top" \
357            ] -column 0 -row 5 -sticky ns
358    grid [button $top.quit -text "Cancel\nChanges" \
359            -command "CancelEditProfileConstraint $top $num" \
360            ]  -column 1 -row 5
361    grid [button $top.help -text Help -bg yellow \
362            -command "MakeWWWHelp expgui6.html EditProfileConstraints"] \
363            -column 2 -row 4 -columnspan 99 -rowspan 2 -sticky e
364
365    set col 0
366    set row 2
367    # row headings
368    grid rowconfigure $cfr 6 -weight 1
369    foreach lbl {Phase(s) Histogram(s) Multiplier} {
370        # row separator
371        grid [frame $cfr.spd$row -bd 8 -bg white] \
372                -columnspan 60 -column 0 -row [incr row] -sticky nsew
373        grid rowconfig $cfr $row -minsize 2 -pad 2
374        grid [label $cfr.t$row -text $lbl] -column $col -row [incr row]
375    }
376
377    # row separator
378    grid [frame $cfr.spe$row -bd 8 -bg white] \
379            -columnspan 60 -column 0 -row [incr row] -sticky nsew
380    grid rowconfig $cfr $row -minsize 2 -pad 2
381
382    set ic 0
383    set col 1
384    foreach constr $conslist {
385        incr ic
386        MakeProfileConstraintColumn $cfr $ic $col
387        FillProfileConstraintColumn $cfr $ic $col
388        incr col 3
389    }
390    if {$conslist == ""} {NewProfileConstraintColumn $top $cfr}
391    # resize the canvas & scrollbar
392    update idletasks
393    set sizes [grid bbox $cfr]
394    $top.canvas config -scrollregion $sizes
395    set width [lindex $sizes 2]
396    # use the scroll for BIG constraints
397    if {$width > 600} {
398        set width 600
399        grid $top.scroll -sticky ew -column 0 -row 3 -columnspan 4
400    }
401    $top.canvas config -height [lindex $sizes 3] -width $width
402    set ic 0
403    set col 1
404    foreach constr $conslist {
405        incr ic
406        SelectProfileConstraintColumn $cfr $ic $col $constr
407        incr col 3
408        set expcons(mult$ic) [lindex $constr 2]
409    }
410    # force the window to stay on top
411    putontop $top
412    tkwait window $top
413    afterputontop
414}
415
416# called when the "Cancel Changes" button is pressed
417proc CancelEditProfileConstraint {top num} {
418    global expcons
419    if {$num == "add"} {destroy $top; return}
420    set ans [MyMessageBox -type "{Abandon Changes} {Continue Edit}" \
421            -parent [winfo toplevel $top] -default "abandon changes" \
422            -helplink "expguierr.html AbandonEditConstraints" \
423            -icon warning -message  \
424            {Do you want to lose any changes made to this constraint?}]
425    if {$ans == "abandon changes"} {destroy $top}
426}
427
428# called to make each column in the atom parameter dialog
429proc MakeProfileConstraintColumn {cfr ic col} {
430    global expmap expcons expgui
431    set row 2
432    # make column separator
433    grid [frame $cfr.spc$col -bd 8 -bg white] \
434            -rowspan 7 -column $col -row $row -sticky nsew
435    grid columnconfig $cfr $col -minsize 2 -pad 2
436    set col1 [incr col]
437    set col2 [incr col]
438    # make the phase listbox
439    set expcons(phaselistbox$ic) $cfr.lbp$ic
440    grid [listbox $cfr.lbp$ic \
441            -height [llength $expmap(phaselist)] -width 12 \
442            -exportselection 0 -selectmode extended] \
443            -column $col1 -columnspan 2 -row [incr row 2] -sticky nsew
444    bind $expcons(phaselistbox$ic) <Button-3> \
445            "$expcons(phaselistbox$ic) selection set 0 end"
446    # make the histogram listbox
447    set expcons(histlistbox$ic) $cfr.lbh$ic
448    grid [listbox $cfr.lbh$ic -height 10 -width 12 \
449            -exportselection 0 -selectmode extended \
450            -yscrollcommand " $cfr.sbh$ic set"] \
451            -column $col1 -row [incr row 2] -sticky nse
452    bind $expcons(histlistbox$ic) <Button-3> \
453            "$expcons(histlistbox$ic) selection set 0 end"
454    grid [scrollbar $cfr.sbh$ic -command "$cfr.lbh$ic yview"] \
455            -column $col2 -row $row -sticky wns
456    # multiplier
457    grid [entry $cfr.c${col}$ic -width 10 \
458            -textvariable expcons(mult$ic)] \
459            -column $col1 -row [incr row 2] -columnspan 2
460}
461
462
463# called to fill the contents of each column in the atom parameter dialog
464proc FillProfileConstraintColumn {cfr ic col "constr {}"} {
465    global expmap expcons expgui
466    # now insert the phases into the list
467    set i 0
468    foreach phase $expmap(phaselist) {
469        $expcons(phaselistbox$ic) insert end "$phase  [phaseinfo $phase name]"
470        incr i
471    }
472    # if there is only 1 choice, select it
473    if {[llength $expmap(phaselist)] == 1} {
474        $expcons(phaselistbox$ic) selection set 0
475    }
476    # now insert the histograms into the list
477    set i 0
478    foreach h $expmap(powderlist) {
479        if {[string range $expmap(htype_$h) 2 2] == $expcons(ProfileHistType)} {
480            $expcons(histlistbox$ic) insert end [format "%2d %-67s" \
481                    $h [string range [histinfo $h title] 0 66]]
482            incr i
483        }
484    }
485    # if there is only 1 choice, select it
486    if {[llength $expmap(powderlist)] == 1} {
487        $expcons(histlistbox$ic) selection set 0
488    }
489}
490
491# called to select the default values for each column in the atom parameter dialog
492proc SelectProfileConstraintColumn {cfr ic col "constr {}"} {
493    global expmap expcons expgui
494    # now insert the phases into the list
495    set i 0
496    set selphase [lindex $constr 0]
497    foreach phase $expmap(phaselist) {
498        if {[lsearch $selphase $phase] != -1} {
499            $expcons(phaselistbox$ic) select set $i $i
500        }
501        incr i
502    }
503    if {[lsearch $selphase "ALL"] != -1} {
504        $expcons(phaselistbox$ic) select set 0 end
505    }
506    # now insert the histograms into the list
507    set i 0
508    set selhist [lindex $constr 1]
509    foreach h $expmap(powderlist) {
510        if {[string range $expmap(htype_$h) 2 2] == $expcons(ProfileHistType)} {
511            if {[lsearch $selhist $h] != -1} {
512                $expcons(histlistbox$ic) select set $i $i
513                $expcons(histlistbox$ic) see $i
514            }
515            incr i
516        }
517    }
518    if {[lsearch $selhist "ALL"] != -1} {
519        $expcons(histlistbox$ic) select set 0 end
520    }
521}
522
523# called when the "New column" button is pressed to add a new constraint
524proc NewProfileConstraintColumn {top cfr} {
525    global expcons
526    set col -2
527    set row 1
528    for {set ic 1} {$ic < 27} {incr ic} {
529        incr col 3
530        if [winfo exists $cfr.lbp$ic] continue
531        MakeProfileConstraintColumn $cfr $ic $col
532        FillProfileConstraintColumn $cfr $ic $col
533        # set the various variables to initial values
534        set expcons(mult$ic) 1.0
535        break
536    }
537    # resize the canvas & scrollbar
538    update idletasks
539    set sizes [grid bbox $cfr]
540    $top.canvas config -scrollregion $sizes
541    set width [lindex $sizes 2]
542    # use the scroll for BIG constraints
543    if {$width > 600} {
544        set width 600
545        grid $top.scroll -sticky ew -column 0 -row 3 -columnspan 4
546    }
547    $top.canvas config -height [lindex $sizes 3] -width $width
548}
549
550# called to delete profile constraints
551proc DeleteProfileConstraints {} {
552    global expgui expcons
553    # get the constraints to delete
554    set dellist {}
555    # loop over used profile terms
556    for {set i 1} {$i <= 36} {incr i} {
557        set ncons [constrinfo profile$i get 0]
558        # loop over the defined constraints
559        for {set j 1} {$j <= $ncons} {incr j} {
560            if {$expcons(delete${i}_$j)} {lappend dellist [list $i $j]}
561        }
562    }
563    # nothing to delete?
564    if {$dellist == ""} return
565    if {[MyMessageBox -message \
566            "Do you want to delete [llength $dellist] constraint(s)?" \
567            -parent [winfo toplevel $expcons(profilemaster)] \
568            -type {No Delete} -default no] == "no"} return
569    foreach item [lsort -decreasing -integer -index 1 $dellist] {
570        set i [lindex $item 0]
571        constrinfo profile$i delete [lindex $item 1]
572        RecordMacroEntry "constrinfo profile$i delete [lindex $item 1]" 0
573        RecordMacroEntry "incr expgui(changed)" 0
574        incr expgui(changed)
575    }
576    DisplayProfileConstraints
577}
578
579
580# take the info in the Edit Profile Constraint page and save it in
581# the .EXP array
582proc SaveProfileConstraint {num term top} {
583    global expcons expmap expgui
584    set conslist {}
585    for {set ic 1} {$ic < 27} {incr ic} {
586        set phases {}
587        set hists {}
588        if ![info exists expcons(phaselistbox$ic)] break
589        if ![info exists expcons(histlistbox$ic)] break
590        if ![winfo exists $expcons(phaselistbox$ic)] break
591        if ![winfo exists $expcons(histlistbox$ic)] break
592        set phases [$expcons(phaselistbox$ic) curselection]
593        set hists [$expcons(histlistbox$ic) curselection]
594        if {[llength $phases] == [llength $expmap(phaselist)]} {
595            set phases "ALL"
596        }
597        if {[llength $hists] == [llength $expmap(powderlist)]} {
598            set hists "ALL"
599        }
600        if {$hists == ""} {
601            MyMessageBox -icon warning -message \
602                    "Please select at least one histogram before trying to save" \
603                    -parent [winfo toplevel $expgui(consFrame)] 
604            return
605        }
606        if {$phases == ""} {
607            MyMessageBox -icon warning -message \
608                    "Please select at least one phase before trying to save" \
609                    -parent [winfo toplevel $expgui(consFrame)] 
610            return
611        }
612        foreach h $hists {
613            if {$h == "ALL"} {
614                set hist "ALL"
615            } else {
616                set hist [lindex [$expcons(histlistbox$ic) get $h] 0]
617            }
618            foreach p $phases {
619                if {$p == "ALL"} {
620                    set phase "ALL"
621                } else {
622                    set phase [lindex $expmap(phaselist) $p]
623                }
624                lappend conslist [list $phase $hist $expcons(mult$ic)]
625            }
626        }
627    }
628    if {[llength $conslist] > 27} {
629        MyMessageBox -icon warning \
630                -message "Note: you have entered [llength $conslist] terms, only 27 can be used" \
631                -helplink "expgui6.html ProfileConstraintsMax" \
632                -parent [winfo toplevel $expgui(consFrame)] 
633        return
634    }
635    foreach t $term {
636        if {$num != "add"} {
637            constrinfo profile$t set $num $conslist
638            RecordMacroEntry "constrinfo profile$t set $num [list $conslist]" 0
639        } else {
640            constrinfo profile$t add $num $conslist
641            RecordMacroEntry "constrinfo profile$t add $num [list $conslist]" 0
642        }
643        incr expgui(changed)
644    }
645    if {[llength $term] > 0} {RecordMacroEntry "incr expgui(changed)" 0}
646    destroy $top
647    DisplayProfileConstraints
648}
649
650# Called to create a new profile constraint. Works in two steps,
651# 1st the profile type and terms are selected and
652# 2nd the constraint is defined using EditProfileConstraint
653proc NewProfileConstraint {} {
654    global expcons expmap expgui
655
656    set top {.editcons}
657    catch {toplevel $top}
658    bind $top <Key-F1> "MakeWWWHelp expgui6.html NewProfileConstraints"
659    eval destroy [grid slaves $top]
660
661    wm title $top "New Profile Constraint"
662    grid [label $top.top -text "Editing new profile constraint"] \
663            -column 0 -row 0 -columnspan 4
664    grid [frame $top.fr1] -column 1 -row 1 -columnspan 3 -sticky w
665    grid [frame $top.fr2] -column 1 -row 2 -columnspan 3 -sticky w
666    grid [frame $top.fr3] -column 1 -row 3 -columnspan 3 -sticky w
667    grid [frame $top.fr4 -relief groove -bd 2] \
668            -column 0 -row 4 -columnspan 4 -sticky w
669    # need to get histogram type
670    grid [label $top.fr1a -text "Choose histogram type:"] \
671            -column 0 -row 1 
672    grid [radiobutton $top.fr1.b -value T -variable expcons(ProfileHistType) \
673            -command "ResetProfileHistogram $top.fr4"\
674            -text "TOF"] -column 1 -row 1
675    grid [radiobutton $top.fr1.c -value C -variable expcons(ProfileHistType) \
676            -command "ResetProfileHistogram $top.fr4"\
677            -text "Constant Wavelength"] -column 2 -row 1
678    grid [radiobutton $top.fr1.d -value E -variable expcons(ProfileHistType) \
679            -command "ResetProfileHistogram $top.fr4"\
680            -text "Energy Disp. X-ray"] -column 3 -row 1
681    #
682    # need to get histogram type
683    grid [label $top.fr2a -text "Choose profile function:"] \
684            -column 0 -row 2 
685    foreach i {1 2 3 4 5} {
686        grid [radiobutton $top.fr2.$i -value $i \
687                -variable expcons(ProfileFunction) \
688                -command "ResetProfileHistogram $top.fr4"\
689                -text $i] -column $i -row 2
690    }
691    # and need to get phase # (for type 4 profile)
692    grid [label $top.fr3a -text "Choose phase:"] \
693            -column 0 -row 3
694    foreach i $expmap(phaselist) {
695        grid [radiobutton $top.fr3.$i -value $i \
696                -variable expcons(ProfilePhase) \
697                -command "ResetProfileHistogram $top.fr4"\
698                -text $i] -column $i -row 3
699    }
700    grid [set expcons(ProfileCreateContinueButton) [button $top.b1 \
701            -text Continue -command "set expcons(createflag) 1"]] \
702            -column 0 -row 5
703    grid [button $top.b2 -text Cancel \
704            -command "set expcons(createflag) 0"] -sticky w -column 1 -row 5
705    grid [button $top.help -text Help -bg yellow \
706            -command "MakeWWWHelp expgui6.html NewProfileConstraints"] \
707            -column 2 -row 5 -columnspan 99 -sticky e
708
709    # default values by 1st histogram
710    set h [lindex $expmap(powderlist) 0]
711    # histogram type
712    set expcons(ProfileHistType) [string range $expmap(htype_$h) 2 2]
713    set p [lindex $expmap(phaselist_$h) 0]
714    set expcons(ProfilePhase) $p
715    # profile type
716    set expcons(ProfileFunction) [string trim [hapinfo $h $p proftype]]
717    ResetProfileHistogram $top.fr4
718
719    # wait for a response
720    putontop $top
721    tkwait variable expcons(createflag)
722    if $expcons(createflag) {
723        eval destroy [winfo children $top]
724    } else {
725        destroy $top
726        return
727    }
728    set p $expcons(ProfilePhase)
729    set ptype $expcons(ProfileFunction)
730    set htype $expcons(ProfileHistType)
731    set termlist {}
732    set i 0
733    foreach lbl [GetProfileTerms $p $htype $ptype] {
734        incr i
735        if {$expcons(newcons$i)} {lappend termlist $i}
736    }
737    EditProfileConstraint $termlist add {}
738    afterputontop
739}
740
741# setup a box with the defined profile constraint terms
742proc ResetProfileHistogram {top} {
743    global expcons
744    set p $expcons(ProfilePhase)
745    set ptype $expcons(ProfileFunction)
746    set htype $expcons(ProfileHistType)
747    eval destroy [winfo children $top]
748    grid [label $top.0 -text "Choose profile terms to constrain:"] \
749            -column 0 -columnspan 4 -row 0 -sticky w
750    # loop over profile term labels
751    set i 0
752    set row 0
753    set col 0
754    foreach lbl [GetProfileTerms $p $htype $ptype] {
755        incr i
756        incr row
757        if {$row > 10} {
758            set row 1
759            incr col
760        }
761        grid [checkbutton $top.$i -text "#$i ($lbl)" \
762                -variable expcons(newcons$i) -command DisableProfileContinue \
763                ] -column $col -row $row -sticky w
764    }
765    DisableProfileContinue
766}
767
768proc DisableProfileContinue {} {
769    global expcons
770    set p $expcons(ProfilePhase)
771    set ptype $expcons(ProfileFunction)
772    set htype $expcons(ProfileHistType)
773    set termlist {}
774    set i 0
775    foreach lbl [GetProfileTerms $p $htype $ptype] {
776        incr i
777        if {$expcons(newcons$i)} {lappend termlist $i}
778    }
779    if {$termlist == ""} {
780        $expcons(ProfileCreateContinueButton) config -state disabled
781    } else {
782        $expcons(ProfileCreateContinueButton) config -state normal
783    }
784}
Note: See TracBrowser for help on using the repository browser.