source: trunk/profcons.tcl @ 228

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

# on 2000/07/06 20:33:55, toby did:
alpha test version of the profile constraints routines

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/07/06 20:33:55
  • Property rcs:rev set to 1.1
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 22.6 KB
Line 
1# Implement profile constraints
2# $Revision: 228 $ $Date: 2009-12-04 23:02:32 +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            if {$h == "ALL"} {set h [lindex $expmap(powderlist) 0]}
140            set p [lindex [lindex $item 0] 0]
141            if {$p == "ALL"} {set p [lindex $expmap(phaselist_$h) 0]}
142            # profile type
143            set ptype [string trim [hapinfo $h $p proftype]]
144            # histogram type
145            set htype [string range $expmap(htype_$h) 2 2]   
146            # get the profile term labels
147            set lbl [lindex "dummy [GetProfileTerms $p $h $ptype]" $i]
148            if {$lbl == ""} {set lbl ?}
149
150            foreach item $conslist {
151                set col 6
152                incr row
153                grid [label $top.tn${row}-$col \
154                        -text [CompressList [lindex $item 0]]] \
155                        -column [incr col] -row $row
156                grid [label $top.tn${row}-$col \
157                        -text [CompressList [lindex $item 1]]] \
158                        -column [incr col] -row $row
159                grid [label $top.tn${row}-$col -text [lindex $item 2]] \
160                        -column [incr col] -row $row
161                incr col
162            }
163            incr row
164            grid [label $top.ts$row0 -text $j] -column 4 \
165                    -row $row0 -rowspan [expr $row - $row0]
166            if {[lsearch $errlist $j] != -1} {$top.ts$row0 config -fg red}
167            grid [label $top.tu$row0 -text "($lbl)"] -column 2 \
168                -row $row0 -rowspan [expr $row - $row0]
169            grid [button $top.edit$row0 -text edit \
170                    -command "EditProfileConstraint $i $j [list $conslist]" \
171                    ] -column 5 -row $row0 -rowspan [expr $row - $row0]
172            set expcons(delete${i}_$j) 0
173            grid [checkbutton $top.del$row0 \
174                    -variable expcons(delete${i}_$j)] -column 11 \
175                    -row $row0 -rowspan [expr $row - $row0]
176            if {$j < $ncons} {
177                # put a spacer between each term
178                grid [frame $top.spb$row -bd 1 -bg white] \
179                        -columnspan 11 -column 3 -row $row -sticky nsew
180                grid rowconfig $top $row -minsize 1 -pad 1
181                incr row
182            }
183        }
184        grid [label $top.tt$row -text "#$i  "] -column 0 \
185                -row $row1 -rowspan [expr $row - $row1]
186    }
187    # resize the canvas & scrollbar
188    update idletasks
189    set sizes [grid bbox $top]
190    $expcons(profilemaster).canvas config -scrollregion $sizes
191    set hgt [lindex $sizes 3]
192    # set the maximum height for the canvas from the frame
193    set maxheight [expr \
194            [winfo height [winfo parent $expgui(consFrame)]] - 130]
195
196    # use the scroll for BIG constraint lists
197    if {$hgt > $maxheight} {
198        grid $expcons(profilemaster).scroll -sticky ns -column 2 -row 0
199    } else {
200        grid forget $expcons(profilemaster).scroll
201    }
202    $expcons(profilemaster).canvas config \
203            -height $maxheight \
204            -width [lindex $sizes 2]
205    $expgui(consFrame).n compute_size
206    donewait
207    if {$msg != ""} {
208        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"
209        MyMessageBox -icon error -message $msg -parent [winfo toplevel $expgui(consFrame)] 
210    }
211}
212
213
214# summarize profile constraints:
215# group histograms that have the same phase & mult
216proc SortProfileConstraints {conslist} {
217    # grouped list
218    set glist {}
219    # previous phase
220    set pp 0
221    # phase list
222    set pplist {}
223    # sort list on phase (add a dummy element)
224    foreach item "[lsort -index 0 $conslist] {0 0 0}" {
225        set p [lindex $item 0]
226        if {$p != $pp} {
227            # ok have a list containing only 1 phase
228            if {$pp != 0} {
229                set mp 0
230                set hl {}
231                foreach item2 "[lsort -index 2 -decreasing -real $pplist] {0 0 0}" {
232                    set m [lindex $item2 2]
233                    if {$m != $mp} {
234                        # have a list containing 1 phase and the same multiplier
235                        if {$mp != 0} {
236                            # do we another entry with the same multiplier
237                            set hl [lsort $hl]
238                            set i 0
239                            foreach item3 $glist {
240                                if {[lindex $item3 1] == $hl && \
241                                        [lindex $item3 2] == $mp} {
242                                    # got one that matches
243                                    # add the phase & replace it
244                                    set pp "[lindex $item3 0] $pp"
245                                    set glist [lreplace \
246                                            $glist $i $i \
247                                            "[list $pp] [list $hl] $mp"]
248                                    break
249                                }
250                                incr i
251                            }
252                            # we have looped all the way through
253                            # not matched, so add it to the list
254                            if {$i == [llength $glist]} {
255                                lappend glist "$pp [list $hl] $mp"
256                            }
257                        }
258                        set mp $m
259                        set hl [lindex $item2 1]
260                    } else {
261                        lappend hl [lindex $item2 1]
262                    }
263                }
264            }
265            set pp $p
266            set pplist [list $item]
267        } else {
268            lappend pplist $item
269        }
270    }
271    return $glist
272}
273
274# called to edit a single profile constraint set
275proc EditProfileConstraint {term num conslist} {
276    global expcons expmap expgui
277
278    set top {.editcons}
279    catch {toplevel $top}
280    eval destroy [grid slaves $top]
281
282    if {$num != "add"} {
283        # set the phase & histogram type from the first entry in the list
284        set item [lindex $conslist 0]
285        set h [lindex [lindex $item 1] 0]
286        if {$h == "ALL"} {set h [lindex $expmap(powderlist) 0]}
287        set p [lindex [lindex $item 0] 0]
288        if {$p == "ALL"} {set p [lindex $expmap(phaselist_$h) 0]}
289        # profile type
290        set ptype [string trim [hapinfo $h $p proftype]]
291        # histogram type
292        set htype [string range $expmap(htype_$h) 2 2]   
293        set expcons(ProfileHistType) [string range $expmap(htype_$h) 2 2]   
294    } else {
295        set p $expcons(ProfilePhase)
296        set ptype $expcons(ProfileFunction)
297        set htype $expcons(ProfileHistType)
298    }
299    set lbls "dummy [GetProfileTerms $p $htype $ptype]"
300    # get the cached copy of the profile term labels, when possible
301    if {$num != "add"} {
302        wm title $top "Constraint #$num for term $term"
303        set lbl [lindex $lbls $term]
304        if {$lbl == ""} {set lbl ?}
305        set txt "Editing constraint #$num for term $term ($lbl)"
306    } else {
307        wm title $top "New constraint for term(s) [CompressList $term]"
308        set txt "Editing new constraint for term(s) "
309        set i 0
310        foreach t $term {
311            set lbl [lindex $lbls $t]
312            if {$lbl == ""} {set lbl ?}
313            if {$i == 3 || $i == 10 || $i == 16 || $i == 22} {
314                append txt ",\n"
315            } elseif {$i != 0} {
316                append txt ", "
317            }
318            append txt "$t ($lbl)"
319            incr i
320        }
321    }
322    grid [label $top.top -text $txt -anchor w] -column 0 -row 0 -columnspan 20
323
324    if {$expcons(ProfileHistType) == "T"} {
325        set type "TOF"
326    } elseif {$expcons(ProfileHistType) == "C"} {
327        set type "Constant Wavelength"
328    } elseif {$expcons(ProfileHistType) == "E"} {
329        set type "Energy Dispersive X-ray"
330    }
331    grid [label $top.typ -text "Histogram type: $type"] \
332            -column 0 -row 1 -columnspan 20
333    grid [canvas $top.canvas \
334            -scrollregion {0 0 5000 500} -width 100 -height 50 \
335            -xscrollcommand "$top.scroll set"] \
336            -column 0 -row 2 -columnspan 4 -sticky nsew
337    grid columnconfigure $top 3 -weight 1
338    grid rowconfigure $top 2 -weight 1
339    catch {destroy $top.scroll}
340    scrollbar $top.scroll -orient horizontal \
341            -command "$top.canvas xview"
342    #    grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
343    # create a scrollable frame inside the canvas
344    set cfr [frame $top.canvas.fr]
345    $top.canvas create window 0 0 -anchor nw  -window $cfr
346
347    grid [button $top.add -text "New Column" \
348            -command "NewProfileConstraintColumn $top $cfr" \
349            ] -column 0 -row 4  -columnspan 2
350    grid [button $top.done -text "Save" \
351            -command "SaveProfileConstraint $num [list $term] $top" \
352            ] -column 0 -row 5
353    grid [button $top.quit -text "Cancel Changes" \
354            -command "CancelEditConstraint $top" \
355            ]  -column 1 -row 5
356
357    set col 0
358    set row 2
359    # row headings
360    grid rowconfigure $cfr 6 -weight 1
361    foreach lbl {Phase(s) Histogram(s) Multiplier} {
362        # row separator
363        grid [frame $cfr.spd$row -bd 8 -bg white] \
364                -columnspan 60 -column 0 -row [incr row] -sticky nsew
365        grid rowconfig $cfr $row -minsize 2 -pad 2
366        grid [label $cfr.t$row -text $lbl] -column $col -row [incr row]
367    }
368
369    # row separator
370    grid [frame $cfr.spe$row -bd 8 -bg white] \
371            -columnspan 60 -column 0 -row [incr row] -sticky nsew
372    grid rowconfig $cfr $row -minsize 2 -pad 2
373
374    set ic 0
375    set col 1
376    foreach constr $conslist {
377        incr ic
378        MakeProfileConstraintColumn $cfr $ic $col
379        FillProfileConstraintColumn $cfr $ic $col
380        incr col 3
381    }
382    if {$conslist == ""} {NewProfileConstraintColumn $top $cfr}
383    # resize the canvas & scrollbar
384    update idletasks
385    set sizes [grid bbox $cfr]
386    $top.canvas config -scrollregion $sizes
387    set width [lindex $sizes 2]
388    # use the scroll for BIG constraints
389    if {$width > 600} {
390        set width 600
391        grid $top.scroll -sticky ew -column 0 -row 3 -columnspan 4
392    }
393    $top.canvas config -height [lindex $sizes 3] -width $width
394    set ic 0
395    set col 1
396    foreach constr $conslist {
397        incr ic
398        SelectProfileConstraintColumn $cfr $ic $col $constr
399        incr col 3
400        set expcons(mult$ic) [lindex $constr 2]
401    }
402    # force the window to stay on top
403    putontop $top
404    tkwait window $top
405    afterputontop
406}
407
408# called to make each column in the atom parameter dialog
409proc MakeProfileConstraintColumn {cfr ic col} {
410    global expmap expcons expgui
411    set row 2
412    # make column separator
413    grid [frame $cfr.spc$col -bd 8 -bg white] \
414            -rowspan 7 -column $col -row $row -sticky nsew
415    grid columnconfig $cfr $col -minsize 2 -pad 2
416    set col1 [incr col]
417    set col2 [incr col]
418    # make the phase listbox
419    set expcons(phaselistbox$ic) $cfr.lbp$ic
420    grid [listbox $cfr.lbp$ic \
421            -height [llength $expmap(phaselist)] -width 12 \
422            -font $expgui(coordfont) \
423            -exportselection 0 -selectmode extended] \
424            -column $col1 -columnspan 2 -row [incr row 2] -sticky nsew
425    bind $expcons(phaselistbox$ic) <Button-3> \
426            "$expcons(phaselistbox$ic) selection set 0 end"
427    # make the histogram listbox
428    set expcons(histlistbox$ic) $cfr.lbh$ic
429    grid [listbox $cfr.lbh$ic -height 10 -width 12 \
430            -font $expgui(coordfont) \
431            -exportselection 0 -selectmode extended \
432            -yscrollcommand " $cfr.sbh$ic set"] \
433            -column $col1 -row [incr row 2] -sticky nse
434    bind $expcons(histlistbox$ic) <Button-3> \
435            "$expcons(histlistbox$ic) selection set 0 end"
436    grid [scrollbar $cfr.sbh$ic -command "$cfr.lbh$ic yview"] \
437            -column $col2 -row $row -sticky wns
438    # multiplier
439    grid [entry $cfr.c${col}$ic -width 10 \
440            -textvariable expcons(mult$ic)] \
441            -column $col1 -row [incr row 2] -columnspan 2
442}
443
444
445# called to fill the contents of each column in the atom parameter dialog
446proc FillProfileConstraintColumn {cfr ic col "constr {}"} {
447    global expmap expcons expgui
448    # now insert the phases into the list
449    set i 0
450    foreach phase $expmap(phaselist) {
451        $expcons(phaselistbox$ic) insert end "$phase  [phaseinfo $phase name]"
452        incr i
453    }
454    # now insert the histograms into the list
455    set i 0
456    foreach h $expmap(powderlist) {
457        if {[string range $expmap(htype_$h) 2 2] == $expcons(ProfileHistType)} {
458            $expcons(histlistbox$ic) insert end [format "%2d %-67s" \
459                    $h [string range [histinfo $h title] 0 66]]
460            incr i
461        }
462    }
463}
464
465# called to select the default values for each column in the atom parameter dialog
466proc SelectProfileConstraintColumn {cfr ic col "constr {}"} {
467    global expmap expcons expgui
468    # now insert the phases into the list
469    set i 0
470    set selphase [lindex $constr 0]
471    foreach phase $expmap(phaselist) {
472        if {[lsearch $selphase $phase] != -1} {
473            $expcons(phaselistbox$ic) select set $i $i
474        }
475        incr i
476    }
477    if {[lsearch $selphase "ALL"] != -1} {
478        $expcons(phaselistbox$ic) select set 0 end
479    }
480    # now insert the histograms into the list
481    set i 0
482    set selhist [lindex $constr 1]
483    foreach h $expmap(powderlist) {
484        if {[string range $expmap(htype_$h) 2 2] == $expcons(ProfileHistType)} {
485            if {[lsearch $selhist $h] != -1} {
486                $expcons(histlistbox$ic) select set $i $i
487                $expcons(histlistbox$ic) see $i
488            }
489            incr i
490        }
491    }
492    if {[lsearch $selhist "ALL"] != -1} {
493        $expcons(histlistbox$ic) select set 0 end
494    }
495}
496
497# called when the "New column" button is pressed to add a new constraint
498proc NewProfileConstraintColumn {top cfr} {
499    global expcons
500    set col -2
501    set row 1
502    for {set ic 1} {$ic < 27} {incr ic} {
503        incr col 3
504        if [winfo exists $cfr.lbp$ic] continue
505        MakeProfileConstraintColumn $cfr $ic $col
506        FillProfileConstraintColumn $cfr $ic $col
507        # set the various variables to initial values
508        set expcons(mult$ic) 1.0
509        break
510    }
511    # resize the canvas & scrollbar
512    update idletasks
513    set sizes [grid bbox $cfr]
514    $top.canvas config -scrollregion $sizes
515    set width [lindex $sizes 2]
516    # use the scroll for BIG constraints
517    if {$width > 600} {
518        set width 600
519        grid $top.scroll -sticky ew -column 0 -row 3 -columnspan 4
520    }
521    $top.canvas config -height [lindex $sizes 3] -width $width
522}
523
524# called to delete profile constraints
525proc DeleteProfileConstraints {} {
526    global expgui expcons
527    # get the constraints to delete
528    set dellist {}
529    # loop over used profile terms
530    for {set i 1} {$i <= 36} {incr i} {
531        set ncons [constrinfo profile$i get 0]
532        # loop over the defined constraints
533        for {set j 1} {$j <= $ncons} {incr j} {
534            if {$expcons(delete${i}_$j)} {lappend dellist [list $i $j]}
535        }
536    }
537    # nothing to delete?
538    if {$dellist == ""} return
539    if {[MyMessageBox -message \
540            "Do you want to delete [llength $dellist] constraint(s)?" \
541            -parent [winfo toplevel $expcons(profilemaster)] \
542            -type {No Delete} -default no] == "no"} return
543    foreach item [lsort -decreasing -integer -index 1 $dellist] {
544        set i [lindex $item 0]
545        constrinfo profile$i delete [lindex $item 1]
546        incr expgui(changed)
547    }
548    DisplayProfileConstraints
549}
550
551
552# take the info in the Edit Profile Constraint page and save it in
553# the .EXP array
554proc SaveProfileConstraint {num term top} {
555    global expcons expmap expgui
556    set conslist {}
557    for {set ic 1} {$ic < 27} {incr ic} {
558        if ![info exists expcons(phaselistbox$ic)] break
559        if ![info exists expcons(histlistbox$ic)] break
560        if ![winfo exists $expcons(phaselistbox$ic)] break
561        if ![winfo exists $expcons(histlistbox$ic)] break
562        set phases [$expcons(phaselistbox$ic) curselection]
563        set hists [$expcons(histlistbox$ic) curselection]
564        if {[llength $phases] == [llength $expmap(phaselist)]} {
565            set phases "ALL"
566        }
567        if {[llength $hists] == [llength $expmap(powderlist)]} {
568            set hists "ALL"
569        }
570        foreach h $hists {
571            if {$h == "ALL"} {
572                set hist "ALL"
573            } else {
574                set hist [lindex [$expcons(histlistbox$ic) get $h] 0]
575            }
576            foreach p $phases {
577                if {$p == "ALL"} {
578                    set phase "ALL"
579                } else {
580                    set phase [lindex $expmap(phaselist) $p]
581                }
582                lappend conslist [list $phase $hist $expcons(mult$ic)]
583            }
584        }
585    }
586    if {[llength $conslist] > 27} {
587        MyMessageBox -icon warning \
588                -message "Note: you have entered [llength $conslist] terms, only 27 can be used" \
589                -parent [winfo toplevel $expgui(consFrame)] 
590        return
591    }
592    foreach t $term {
593        if {$num != "add"} {
594            constrinfo profile$t set $num $conslist
595        } else {
596            constrinfo profile$t add $num $conslist
597        }
598        incr expgui(changed)
599    }
600    destroy $top
601    DisplayProfileConstraints
602}
603
604# Called to create a new profile constraint. Works in two steps,
605# 1st the profile type and terms are selected and
606# 2nd the constraint is defined using EditProfileConstraint
607proc NewProfileConstraint {} {
608    global expcons expmap expgui
609
610    set top {.editcons}
611    catch {toplevel $top}
612    eval destroy [grid slaves $top]
613
614    wm title $top "New Profile Constraint"
615    grid [label $top.top -text "Editing new profile constraint"] \
616            -column 0 -row 0 -columnspan 4
617    grid [frame $top.fr1] -column 1 -row 1 -columnspan 3 -sticky w
618    grid [frame $top.fr2] -column 1 -row 2 -columnspan 3 -sticky w
619    grid [frame $top.fr3] -column 1 -row 3 -columnspan 3 -sticky w
620    grid [frame $top.fr4 -relief groove -bd 2] \
621            -column 0 -row 4 -columnspan 4 -sticky w
622    # need to get histogram type
623    grid [label $top.fr1a -text "Choose histogram type:"] \
624            -column 0 -row 1 
625    grid [radiobutton $top.fr1.b -value T -variable expcons(ProfileHistType) \
626            -command "ResetProfileHistogram $top.fr4"\
627            -text "TOF"] -column 1 -row 1
628    grid [radiobutton $top.fr1.c -value C -variable expcons(ProfileHistType) \
629            -command "ResetProfileHistogram $top.fr4"\
630            -text "Constant Wavelength"] -column 2 -row 1
631    grid [radiobutton $top.fr1.d -value E -variable expcons(ProfileHistType) \
632            -command "ResetProfileHistogram $top.fr4"\
633            -text "Energy Disp. X-ray"] -column 3 -row 1
634    #
635    # need to get histogram type
636    grid [label $top.fr2a -text "Choose profile function:"] \
637            -column 0 -row 2 
638    foreach i {1 2 3 4} {
639        grid [radiobutton $top.fr2.$i -value $i \
640                -variable expcons(ProfileFunction) \
641                -command "ResetProfileHistogram $top.fr4"\
642                -text $i] -column $i -row 2
643    }
644    # and need to get phase # (for type 4 profile)
645    grid [label $top.fr3a -text "Choose phase:"] \
646            -column 0 -row 3
647    foreach i $expmap(phaselist) {
648        grid [radiobutton $top.fr3.$i -value $i \
649                -variable expcons(ProfilePhase) \
650                -command "ResetProfileHistogram $top.fr4"\
651                -text $i] -column $i -row 3
652    }
653    grid [button $top.b1 -text Continue \
654            -command "set expcons(createflag) 1"] -column 0 -row 5
655    grid [button $top.b2 -text Cancel \
656            -command "set expcons(createflag) 0"] -sticky w -column 1 -row 5
657   
658    # default values by 1st histogram
659    set h [lindex $expmap(powderlist) 0]
660    # histogram type
661    set expcons(ProfileHistType) [string range $expmap(htype_$h) 2 2]
662    set p [lindex $expmap(phaselist_$h) 0]
663    set expcons(ProfilePhase) $p
664    # profile type
665    set expcons(ProfileFunction) [string trim [hapinfo $h $p proftype]]
666    ResetProfileHistogram $top.fr4
667
668    # wait for a response
669    putontop $top
670    tkwait variable expcons(createflag)
671    if $expcons(createflag) {
672        eval destroy [winfo children $top]
673    } else {
674        destroy $top
675        return
676    }
677    set p $expcons(ProfilePhase)
678    set ptype $expcons(ProfileFunction)
679    set htype $expcons(ProfileHistType)
680    set termlist {}
681    set i 0
682    foreach lbl [GetProfileTerms $p $htype $ptype] {
683        incr i
684        if {$expcons(newcons$i)} {lappend termlist $i}
685    }
686    EditProfileConstraint $termlist add {}
687    afterputontop
688}
689
690# setup a box with the defined profile constraint terms
691proc ResetProfileHistogram {top} {
692    global expcons
693    set p $expcons(ProfilePhase)
694    set ptype $expcons(ProfileFunction)
695    set htype $expcons(ProfileHistType)
696    eval destroy [winfo children $top]
697    grid [label $top.0 -text "Choose profile terms to constrain:"] \
698            -column 0 -columnspan 4 -row 0 -sticky w
699    # loop over profile term labels
700    set i 0
701    set row 0
702    set col 0
703    foreach lbl [GetProfileTerms $p $htype $ptype] {
704        incr i
705        incr row
706        if {$row > 10} {
707            set row 1
708            incr col
709        }
710        grid [checkbutton $top.$i -text "#$i ($lbl)" \
711                -variable expcons(newcons$i) \
712                ] -column $col -row $row -sticky w
713    }
714}
Note: See TracBrowser for help on using the repository browser.