source: trunk/instedit.tcl @ 991

Last change on this file since 991 was 991, checked in by toby, 10 years ago

IUP summer school bugs: change cell sym before phase import; blank instedit screen before selecting hist type

  • Property svn:keywords set to Author Date Revision Id
File size: 25.8 KB
Line 
1# $Id: instedit.tcl 991 2010-06-27 18:22:41Z toby $
2
3# stuff to do
4#   might want to show error location for error in instSaveAs
5#   (need to save rather than pass $box)
6
7source [file join $expgui(scriptdir) readinst.tcl]
8
9proc instMakeBankSel {box} {
10    global instdat instparms
11    eval destroy [winfo children [set topfr $box.a]]
12    pack [label $topfr.l1 -text "Select bank: "] -side left
13    pack [frame $topfr.fr] -side left
14    set col 0
15    set row 0
16    for {set i 1} {$i <= $instdat(lastbank)} {incr i} {
17        grid [radiobutton $topfr.fr.$i -text $i -value $i \
18                -command "instShowBank $box"\
19                -variable instparms(bank)] -row $row -column $col
20        if {[incr col] > 10} {set col 0; incr row}
21    }
22    pack [button $topfr.n -text "Add bank" -command "instNewBank $box"] -side left
23    pack [label $topfr.l2 -text "Data type: "] -side left   
24    set menu [tk_optionMenu $topfr.w instparms(banklabel) "     "]
25    set instparms(banklabel) {}
26    pack $topfr.w -side left
27    pack [button $topfr.quit -text "Close" \
28            -command instConfirmQuit] -side right
29    pack [button $topfr.sa -text "Save as" -command instSaveAs] -side right
30    pack [button $topfr.s -text "Save" -state disabled \
31            -command {instSaveAs $instparms(filename)}] -side right
32    set instparms(savebutton) $topfr.s
33    $menu delete 0 end
34    foreach lbl {TOF   "CW neutron" "CW X-ray" "ED X-ray"} \
35            val {PNTR  PNCR         PXCR       PXER} {
36        $menu add radiobutton -value $val -label $lbl \
37                -variable instdat(banktype) \
38                -command "instShowBank $box"
39    }
40}
41
42proc instLoadAllBanks {} {
43    global instdat instparms
44    set instdat(lastbank) [instinfo bank]
45    set instdat(banktype) [instinfo type]
46    # loop over banks
47    for {set i 1} {$i <= $instdat(lastbank)} {incr i} {
48        set instdat(rad$i) [instbankinfo rad $i]
49        if {$instdat(rad$i) == ""} {set instdat(rad$i) 0}
50        set instdat(head$i) [instbankinfo head $i]
51        set instdat(name$i) [instbankinfo name $i]
52        foreach var {difc difa zero pola ipola kratio} \
53                val [instbankinfo icons $i] {
54            if {$val == ""} {set val 0}
55            set instdat(${var}$i) $val
56        }
57        # loop over the profile terms
58        set j 1
59        while {[set proflist [instprofinfo $i $j]] != ""} {
60            set instdat(proftype${i}_$j) [lindex $proflist 0]
61            set instdat(profcut${i}_$j) [lindex $proflist 1]
62            set k 0
63            foreach v [lindex $proflist 2] {
64                incr k
65                set instdat(prof${i}_${j}_$k) $v
66            }
67            set instparms(profterms${i}_${j}) $k
68            set instparms(proftypes${i}) $j
69            incr j
70        }
71    }
72    set instparms(changes) 0
73}
74
75proc instSaveAs {"filename {}"} {
76    global instdat instparms
77    instinfo type set $instdat(banktype)
78    # loop over banks
79    set msg {}
80    for {set i 1} {$i <= $instdat(lastbank)} {incr i} {
81        instbankinfo rad $i set $instdat(rad$i) 
82        instbankinfo head $i set $instdat(head$i) 
83        if {[string trim $instdat(name$i)] == ""} {
84            append msg "\n  The instrument name may not be blank"
85        }
86        instbankinfo name $i set $instdat(name$i)
87        set l {}
88        foreach var {difc difa zero pola ipola kratio} {
89            lappend l $instdat(${var}$i)
90        }
91        if {[instbankinfo icons $i set $l] != 1} {
92            append msg "\n  There is an error in values for:\n    the wavelength, zero or polarization"
93        }
94        # loop over the profile terms
95
96        for {set j 1} {$j <= $instparms(proftypes${i})} {incr j} {
97            set l {}
98            for {set k 1} {$k <= $instparms(profterms${i}_$j)} {incr k} {
99                lappend l $instdat(prof${i}_${j}_$k)
100            }
101            if {[instprofinfo $i $j set [list \
102                    $instdat(proftype${i}_$j) $instdat(profcut${i}_$j) $l]\
103                    ] != 1} {
104                append msg "\n  There is an error in the values for profile set $j."
105            }
106        }
107        if {$msg != ""} {
108            MyMessageBox -parent . -title "No save" \
109                    -message "Error in input for bank $i:$msg" -icon warning \
110                    -type Sorry -default sorry
111            return
112        }
113    }
114    if {$filename == ""} {
115        set instparms(filename) [tk_getSaveFile \
116                -title "Enter a file name for the instrument parameter file" \
117                -parent . -defaultextension .ins \
118                -filetypes {{"Instrument parameters file" ".ins .inst .prm"} {All *.*}}]
119    }
120    if {$instparms(filename) == ""} return
121    instwrite $instparms(filename)
122    MyMessageBox -parent . -title "File written" \
123                -message "File $instparms(filename) written." -type OK -default ok
124    global instparms
125    set instparms(changes) 0
126    $instparms(savebutton) config -state disabled
127    wm title $instparms(top) "Editing instrument parameter file $instparms(filename)"
128}
129
130
131proc instNewBank {box} {
132    global instdat instparms
133    # don't allow this for TOF
134    set i [incr instdat(lastbank)]
135    instMakeBankSel $box
136    set instparms(bank) $i
137    # initialize the bank values
138    set instdat(rad$i) ""
139    set instdat(name$i) ""
140    foreach var {difc difa zero pola ipola kratio} {
141        set instdat(${var}$i) ""
142    }
143    instbankinfo itype $i set "0 0 180 1"
144    set instparms(proftypes$i) 0
145    instShowBank $box
146    AddInstProfile $box $i
147    instShowBank $box
148}
149
150proc instShowBank {box} {
151    global instdat instparms
152    set topfr $box.a
153    if {$instparms(bank) == 0} return
154    switch [string range $instdat(banktype) 0 2] {
155        PNT  {set instparms(banklabel) TOF}
156        PNC  {set instparms(banklabel) "CW neutron"}
157        PXC  {set instparms(banklabel) "CW X-ray"}
158        PXE  {set instparms(banklabel) "ED X-ray"}
159    }
160    if {$instparms(banklabel) == ""} {
161        puts starting
162        return
163    }
164    eval destroy [winfo children [set bnkfr $box.b]]
165    set b $instparms(bank)
166    grid [label $bnkfr.l1 -text "Bank #$b" -relief raised -bd 2 \
167            -anchor w -justify left] \
168            -column 0 -row 0 -columnspan 99 -sticky ew
169    grid [label $bnkfr.l2 -text "Title: "] -column 0 -row 1 -sticky e
170    grid [entry $bnkfr.e2 -textvariable instdat(head$b) -width 60] \
171            -column 1 -row 1 -sticky w -columnspan 99
172
173    grid [label $bnkfr.l3 -text "Instrument\nname: " -anchor e -justify r] \
174            -column 0 -row 2 -sticky e
175    grid [entry $bnkfr.e3 -textvariable instdat(name$b) -width 30] \
176            -column 1 -row 2 -sticky w -columnspan 3
177    grid [checkbutton $bnkfr.import -text "Import Diffractometer Constants"\
178              -variable instparms(ImportDiffConst)] \
179        -column 4 -row 2 -sticky e -columnspan 3
180
181    if {$instparms(banklabel) == "TOF"} {
182        $topfr.n config -state disabled
183        set col 0
184        grid [label $bnkfr.l4 -text "DIFC:"] \
185            -column [incr col] -row 4 -sticky e -rowspan 2
186        grid [entry $bnkfr.e4d -textvariable instdat(difc$b) -width 10] \
187            -column [incr col] -row 4 -sticky ew
188        grid [label $bnkfr.l5 -text "DIFA:"] \
189            -column [incr col] -row 4 -sticky e -rowspan 2
190        grid [entry $bnkfr.e4e -textvariable instdat(difa$b) -width 10] \
191            -column [incr col] -row 4 -sticky ew
192        grid [label $bnkfr.l6 -text "Zero\nCorrection:" \
193                  -anchor e -justify r] \
194            -column [incr col] -row 4 -sticky e
195        grid [entry $bnkfr.e6 -textvariable instdat(zero$b) -width 10] \
196            -column [incr col] -row 4 -sticky ew
197
198        grid [frame [set prfrm $bnkfr.prof] -bd 2 -relief groove] \
199            -column 0 -columnspan 99 -row 8
200        grid [label $prfrm.l1 -text "Select profile: "] -column 0 -row 0
201        grid [frame $prfrm.fr] -column 1 -columnspan 99 -row 0 -sticky w
202        grid [frame $prfrm.fr1] -column 0 -columnspan 99 -row 2
203        set instparms(profileframe) $prfrm.fr1
204        for {set j 1} {$j <= $instparms(proftypes${b})} {incr j} {
205            grid [radiobutton $prfrm.fr.$j -text $j -value $j \
206                -command "ShowInstProfile $b" \
207                -variable instparms(profilenum)] -row 1 -column $j
208        }
209        grid [button $prfrm.fr.a -text "Add profile" \
210            -command "AddInstProfile $box $b"] -row 1 -column 98
211        grid [button $prfrm.fr.n -text "Import profile" \
212            -command "ImportInstProfile $box $prfrm.fr1 $b"] -row 1 -column 99
213        set instparms(profilenum) 1
214        ShowInstProfile $b
215        return
216    }
217    if {$instparms(banklabel) == "ED X-ray"} {
218        $topfr.n config -state disabled
219        set col 0
220        grid [label $bnkfr.l4 -text "2Theta:"] \
221            -column [incr col] -row 4 -sticky e -rowspan 2
222        grid [entry $bnkfr.e4d -textvariable instdat(difc$b) -width 10] \
223            -column [incr col] -row 4 -sticky ew
224        grid [label $bnkfr.l5 -text "POLA:"] \
225            -column [incr col] -row 4 -sticky e -rowspan 2
226        grid [entry $bnkfr.e4e -textvariable instdat(pola$b) -width 10] \
227            -column [incr col] -row 4 -sticky ew
228
229        grid [frame [set prfrm $bnkfr.prof] -bd 2 -relief groove] \
230            -column 0 -columnspan 99 -row 8
231        grid [label $prfrm.l1 -text "Select profile: "] -column 0 -row 0
232        grid [frame $prfrm.fr] -column 1 -columnspan 99 -row 0 -sticky w
233        grid [frame $prfrm.fr1] -column 0 -columnspan 99 -row 2
234        set instparms(profileframe) $prfrm.fr1
235        for {set j 1} {$j <= $instparms(proftypes${b})} {incr j} {
236            grid [radiobutton $prfrm.fr.$j -text $j -value $j \
237                -command "ShowInstProfile $b" \
238                -variable instparms(profilenum)] -row 1 -column $j
239        }
240        grid [button $prfrm.fr.a -text "Add profile" \
241            -command "AddInstProfile $box $b"] -row 1 -column 98
242        #grid [button $prfrm.fr.n -text "Import profile" \
243        #    -command "ImportInstProfile $box $prfrm.fr1 $b"] -row 1 -column 99
244        set instparms(profilenum) 1
245        ShowInstProfile $b
246        return
247    }
248    $topfr.n config -state normal
249    set col 0
250    grid [label $bnkfr.l4a -text "Radiation\ntype:" -anchor e -justify r] \
251            -column $col -row 4 -sticky e -rowspan 2
252    set menu [tk_optionMenu $bnkfr.rad instparms(irad) "     "]
253    $bnkfr.rad config -width 6
254   
255    grid $bnkfr.rad -column [incr col] -row 4 -sticky w -rowspan 2
256    grid [radiobutton $bnkfr.c4a -text Monochromatic \
257            -command "disableWaveBoxes $bnkfr $b" \
258            -variable instparms(wavemode) -value 1] \
259            -column [incr col] -row 4 -sticky w
260    grid [radiobutton $bnkfr.c4b -text Dual \
261            -command "disableWaveBoxes $bnkfr $b" \
262            -variable instparms(wavemode) -value 2] \
263            -column $col -row 5 -sticky w
264
265           
266    grid [label $bnkfr.l4 -text "Wavelength: "] \
267            -column [incr col] -row 4 -sticky e -rowspan 2
268    grid [entry $bnkfr.e4d -textvariable instdat(difc$b) -width 10] \
269            -column [incr col] -row 5 -sticky ew
270    grid [label $bnkfr.l4d -text Primary] -column $col -row 4 -sticky ew
271    grid [entry $bnkfr.e4e -textvariable instdat(difa$b) -width 10] \
272            -column [incr col] -row 5 -sticky ew
273    grid [label $bnkfr.l4e -text Secondary] -column $col -row 4 -sticky ew
274    # at present, the ratio is not read from the INST file, so
275    # there is no point in allowing the use to change it.
276#    grid [entry $bnkfr.e4f -textvariable instdat(kratio$b) -width 10] \
277#           -column [incr col] -row 5 -sticky ew
278    grid [label $bnkfr.e4f -textvariable instdat(kratio$b) -width 10] \
279            -column [incr col] -row 5 -sticky ew
280    grid [label $bnkfr.l4f -text ratio] -column $col -row 4 -sticky ew
281
282    set col 0
283    grid [label $bnkfr.l6 -text "Zero\nCorrection:" \
284            -anchor e -justify r] \
285            -column $col -row 6 -sticky e
286    grid [entry $bnkfr.e6 -textvariable instdat(zero$b) -width 10] \
287            -column [incr col] -row 6 -sticky ew
288
289    set col 0
290    grid [label $bnkfr.l7 -text "Polarization\nCorrection:" \
291            -anchor e -justify r] \
292            -column $col -row 7 -sticky e
293    grid [radiobutton $bnkfr.c7a -text "Diffracted Beam" \
294            -variable instdat(ipola$b) -value 0] \
295            -column [incr col] -row 7 -sticky w
296    grid [radiobutton $bnkfr.c7b -text "Incident Beam" \
297            -variable instdat(ipola$b) -value 1] \
298            -column [incr col] -row 7 -sticky w
299    grid [radiobutton $bnkfr.c7c -text "None" \
300            -variable instdat(ipola$b) -value 2] \
301            -column [incr col] -row 7 -sticky w
302    grid [label $bnkfr.l7a -text "Polarization\nFraction:" \
303            -anchor e -justify r] \
304            -column [incr col] -row 7 -sticky e
305    grid [entry $bnkfr.e7 -textvariable instdat(pola$b) -width 10] \
306            -column [incr col] -row 7 -sticky ew
307
308    grid [frame [set prfrm $bnkfr.prof] -bd 2 -relief groove] \
309            -column 0 -columnspan 99 -row 8
310    grid [label $prfrm.l1 -text "Select profile: "] -column 0 -row 0
311    grid [frame $prfrm.fr] -column 1 -columnspan 99 -row 0 -sticky w
312    grid [frame $prfrm.fr1] -column 0 -columnspan 99 -row 2
313    set instparms(profileframe) $prfrm.fr1
314    for {set j 1} {$j <= $instparms(proftypes${b})} {incr j} {
315        grid [radiobutton $prfrm.fr.$j -text $j -value $j \
316                -command "ShowInstProfile $b" \
317                -variable instparms(profilenum)] -row 1 -column $j
318    }
319    grid [button $prfrm.fr.a -text "Add profile" \
320            -command "AddInstProfile $box $b"] -row 1 -column 98
321    grid [button $prfrm.fr.n -text "Import profile" \
322            -command "ImportInstProfile $box $prfrm.fr1 $b"] -row 1 -column 99
323    $menu delete 0 end
324    foreach lbl {Cr Fe Cu Mo Ag Other} \
325            val { 1  2  3  4  5     0} {
326        $menu add radiobutton -value $val -label $lbl \
327                -command "setRadLabel $b" \
328                -variable instdat(rad$b)
329    }
330    if {$instdat(difa$b) == 0.0} {
331        set instparms(wavemode) 1
332    } else {
333        set instparms(wavemode) 2
334    }
335    switch $instdat(rad$b) {
336        0 {set instparms(irad) Other}
337        1 {set instparms(irad) Cr}
338        2 {set instparms(irad) Fe}
339        3 {set instparms(irad) Cu}
340        4 {set instparms(irad) Mo}
341        5 {set instparms(irad) Ag}
342    }
343    setRadLabel $b
344    disableWaveBoxes $bnkfr $b
345    set instparms(profilenum) 1
346    ShowInstProfile $b
347}
348
349proc ImportInstProfile {box frame b} {
350    global instparms instdat
351    set j $instparms(profilenum)
352
353    set filename [tk_getOpenFile \
354            -title "Select GSAS Experiment file\nor press Cancel." \
355            -parent . -defaultextension EXP \
356            -filetypes {{"GSAS Experiment file" ".EXP"}}]
357    if {$filename == ""} {return}
358    global wishshell expgui
359    set result {}
360    catch {
361        set result [exec $wishshell \
362                [file join $expgui(scriptdir) dumpprof.tcl] $filename]
363    } errmsg
364    if {[set nhist [llength $result]] == 0} {
365        set msg "No profile information was read from file $filename"
366        MyMessageBox -parent . -title "No histograms read" \
367                -message $msg -icon warning -type Sorry -default sorry
368                #-helplink "expguierr.html Customizewarning"
369        return
370    }
371    set i -1
372    set hlist {}
373    set prlist {}
374    foreach histrec $result {
375        incr i
376        set h [lindex $histrec 0]
377        set type [string range [lindex $histrec 1] 0 3]
378        # instrument parameters
379        set instparms(hstcons$h) [string range [lindex $histrec 1] 4 end]
380        if {[string range $type 0 2] == \
381                [string range $instdat(banktype) 0 2]} {
382            lappend hlist $h
383            lappend prlist [lrange $histrec 2 end]
384        }
385    }
386    if {[llength $hlist] == 0} {
387        set msg "No histograms of type \"$instparms(banklabel)\" were found"
388        MyMessageBox -parent . -title "No matching histograms" \
389                -message $msg -icon warning -type Sorry -default sorry
390                #-helplink "expguierr.html Customizewarning"
391        return
392    }
393
394    catch {destroy $instparms(top).sel}
395    toplevel [set top $instparms(top).sel]
396    wm title $top "Select histogram and phase to select"
397    grid [label $top.l1 -text "Histogram: "] -column 1 -row 1
398    set menu [tk_optionMenu $top.w instparms(histimport) ""]
399    $menu delete 0 end
400    if {[llength $hlist] > 10} {
401        set h [lrange $hlist 0 9]
402        set pr [lrange $prlist 0 9]
403        set hlist [lrange $hlist 10 end]
404        set prlist [lrange $prlist 10 end]
405        set j 0
406        while {[llength $h] > 0} {
407            set label "[lindex $h 0]-[lindex $h end]"
408            $menu add cascade -label $label -menu $menu.$j
409            menu $menu.$j
410            foreach val $h pl $pr {
411                $menu.$j add radiobutton -value $val -label $val \
412                        -command "instSetPhaseList [list $pl]" \
413                        -variable instparms(histimport)
414            }
415            set h [lrange $hlist 0 9]
416            set pr [lrange $prlist 0 9]
417            set hlist [lrange $hlist 10 end]
418            set prlist [lrange $prlist 10 end]
419            incr j
420        }
421    } else {
422        foreach val $hlist ph $prlist {
423            $menu add radiobutton -value $val -label $val \
424                    -command "instSetPhaseList [list $ph]" \
425                    -variable instparms(histimport)
426        }
427    }
428    grid $top.w -column 2 -row 1 -columnspan 2 -sticky w
429    set instparms(histimport) [lindex $hlist 0]
430    grid [label $top.l2 -text "Phase: "] -column 1 -row 2
431    set col 1
432    foreach h {1 2 3 4 5 6 7 8 9} {
433        grid [radiobutton $top.r$h \
434                -variable instparms(phaseimport) -value $h -text $h \
435                ] -column [incr col] -row 2
436    }
437    grid [frame $top.prof] -column 0 -columnspan 99 -row 3
438    grid [button $top.b1 -text Import -command "" -state disabled] \
439            -column 0 -columnspan 2 -row 4
440    grid [button $top.b2 -text Cancel -command "destroy $top"] \
441            -column 2 -columnspan 2 -row 4
442
443    # there a single histogram, select it
444    if {[llength $hlist] == 1} {
445        set instparms(histimport) $hlist
446        instSetPhaseList [lindex $prlist 0]
447    } else {
448        set instparms(histimport) {}
449    }
450    putontop $top
451    tkwait window $top
452    afterputontop 
453}
454
455proc instSetPhaseList {proflist} {
456    global instparms
457    set top $instparms(top).sel
458    set instparms(phaseimport) {}
459    $top.b1 config -state disabled -command ""
460    foreach h {1 2 3 4 5 6 7 8 9} {
461        $top.r$h config -state disabled -command ""
462    }
463    foreach item $proflist {
464        set h [lindex $item 0]
465        $top.r$h config -state normal \
466                -command "instSelectPhase [list $item]"
467    }
468    eval destroy [winfo children [set frame $top.prof]]
469    if {[llength $proflist] == 1} {$top.r$h invoke}
470}
471
472proc instSelectPhase {proflist} {
473    global instparms instdat expgui
474    set top $instparms(top).sel
475    eval destroy [winfo children [set frame $top.prof]]
476    set row 0
477    set col 0
478    set num [lindex $proflist 1]
479    set T [string range $instdat(banktype) 2 2]
480    set lbllst ""
481    catch {set lbllst $expgui(prof-${T}-names)}
482    set lbl [lindex "{} $lbllst" $num]
483    grid [label $frame.${col}_$row -justify left -anchor w \
484            -text "Profile type $num: $lbl"] \
485            -column $col -row $row -columnspan 99 -sticky w
486    incr row
487    set col 0
488    grid [label $frame.${col}_$row -text "Peak cutoff"  -padx 4] \
489            -column $col -row $row -sticky e
490    incr col
491    grid [label $frame.${col}_$row -text "[lindex $proflist 2]" \
492            -relief groove -bd 2 -padx 2] \
493            -column $col -row $row -sticky ew
494    incr col
495    set N $num
496    set T [string range $instdat(banktype) 2 2]
497    set lbllist ""
498    global expgui
499    catch {set lbllist $expgui(prof-${T}-$N)}
500    set i 0
501    foreach lbl $lbllist val [lrange $proflist 3 end] {
502        incr i
503        if {$col > 6} {set col 0; incr row}
504        grid [label $frame.${col}_$row -text $lbl -padx 4] \
505                -column $col -row $row -sticky e
506        incr col
507        grid [label $frame.${col}_$row -text $val \
508                -bd 2 -padx 2 -relief groove] \
509                -column $col -row $row -sticky ew
510        incr col
511    }
512    $top.b1 config -state normal \
513            -command "instSetProfile [list $proflist]; destroy $top"
514}
515
516proc instSetProfile {proflist} {
517    global instparms instdat expgui
518    set b $instparms(bank)
519    set j $instparms(profilenum)
520    set N [set instdat(proftype${b}_$j) [lindex $proflist 1]]
521    set T [string range $instdat(banktype) 2 2]
522    set lbllist ""
523    catch {set lbllist $expgui(prof-${T}-$N)}
524    set instdat(profcut${b}_$j) [lindex $proflist 2]
525    set i 0
526    foreach lbl $lbllist val [lrange $proflist 3 end] {
527        incr i
528        if {$val == ""} {set val "0.0"}
529        set instdat(prof${b}_${j}_$i) $val
530    }
531    # grab Diffractometer constants
532    if {$instparms(ImportDiffConst)} {
533        set h $instparms(histimport)
534        set difcons [lindex $instparms(hstcons$h) 0]
535        if {[string range $instdat(banktype) 2 2] == "T"} {
536            # TOF grab Difc, difA & zero
537            set instdat(difc$b) [lindex $difcons 0]
538            set instdat(difa$b) [lindex $difcons 1]
539            set instdat(zero$b) [lindex $difcons 2]
540        } elseif {[string range $instdat(banktype) 2 2] == "E"} {
541            set instdat(difc$b) [lindex $difcons 0]
542            set instdat(pola$b) [lindex $difcons 4]
543        } else {
544            set instdat(difc$b) [lindex $difcons 0]
545            set instdat(difa$b) [lindex $difcons 1]
546            set instdat(zero$b) [lindex $difcons 2]
547            set instdat(ipola$b) [lindex $difcons 3]
548            set instdat(pola$b) [lindex $difcons 4]
549            set box $instparms(top).b1
550            set topfr $box.a
551            set bnkfr $box.b
552            if { [lindex $difcons 1] == 0.0} {
553                $bnkfr.c4a invoke
554            } else {
555                $bnkfr.c4b invoke
556            }
557        }
558    }
559    ShowInstProfile $b
560}
561
562proc AddInstProfile {box b} {
563    global instparms instdat
564    set frame $instparms(profileframe)
565    incr instparms(proftypes${b})
566    instShowBank $box
567    set instparms(profilenum) $instparms(proftypes${b})
568    set instdat(proftype${b}_$instparms(profilenum)) " "
569    ShowInstProfile $b
570}
571
572proc ShowInstProfile {b} {
573    global instparms instdat expgui
574    set frame $instparms(profileframe)
575    if {![winfo exists $frame]} return
576    set j $instparms(profilenum)
577    eval destroy [winfo children $frame]
578    set row 0
579    set col 0
580    grid [label $frame.${col}_$row -text "Profile\ntype"] \
581            -column $col -row $row
582    incr col
583    set menu [tk_optionMenu $frame.${col}_$row instdat(proftype${b}_$j) " "]
584    grid $frame.${col}_$row -column $col -row $row -sticky ew
585    $menu delete 0 end
586    set T [string range $instdat(banktype) 2 2]
587    set lbllst ""
588    catch {set lbllst $expgui(prof-${T}-names)}
589    set val 0
590    foreach lbl $lbllst {
591        incr val
592        $menu add radiobutton -value $val -label "$val) $lbl" \
593                -command "instInitProf; ShowInstProfile $b" \
594                -variable instdat(proftype${b}_$j)
595    }
596    if {$instdat(proftype${b}_$j) == " "} return
597
598    incr col
599    grid [label $frame.${col}_$row -text "Peak\ncutoff"] \
600            -column $col -row $row
601    incr col
602    if [catch {set instdat(profcut${b}_$j)}] {
603        set instdat(profcut${b}_$j) 0.01
604    }
605    grid [entry $frame.${col}_$row -width 10 \
606            -textvariable instdat(profcut${b}_$j)] \
607            -column $col -row $row
608    incr row
609    set col 0
610    set N $instdat(proftype${b}_$j)
611    set T [string range $instdat(banktype) 2 2]
612    set lbllist ""
613    global expgui
614    catch {set lbllist $expgui(prof-${T}-$N)}
615    set i 0
616    foreach lbl $lbllist {
617        incr i
618        if {$col > 6} {set col 0; incr row}
619        grid [label $frame.${col}_$row -text $lbl] \
620                -column $col -row $row
621        incr col
622        if [catch {set instdat(prof${b}_${j}_$i)}] {
623            set instdat(prof${b}_${j}_$i) 0.0
624        }
625        grid [entry $frame.${col}_$row -width 14 \
626                -textvariable instdat(prof${b}_${j}_$i)] \
627                -column $col -row $row
628        incr col
629    }
630    # reset the number of terms to match the # of labels
631    set instparms(profterms${b}_${j}) $i
632}
633
634proc instInitProf {} {
635    global instparms instdat
636    set b $instparms(bank)
637    set j $instparms(profilenum)
638    set N $instdat(proftype${b}_$j)
639    set T [string range $instdat(banktype) 2 2]
640    global expgui
641    set i 0
642    set lbllist ""
643    catch {set lblist $expgui(prof-${T}-$N)}
644    foreach lbl $lbllist {
645        incr i
646        set instdat(prof${b}_${j}_$i) 0.0
647    }
648    # reset the number of terms to match the # of labels
649    set instparms(profterms${b}_${j}) $i
650}
651
652proc disableWaveBoxes {frame b} {
653    global instparms instdat
654    if {$instparms(banklabel) == "CW neutron"} {
655        set instparms(wavemode) 1
656        set mode disabled
657        set color gray
658    } else {
659        set mode normal
660        set color black
661    }
662    $frame.rad config -state $mode
663    foreach v {c4b c7a c7b c7c e7} {
664        $frame.$v config -state $mode -fg $color
665    }
666    foreach v {l7 l7a} {
667        $frame.$v config -fg $color
668    }
669
670    if {$instparms(wavemode) == 1} {
671        set mode disabled
672        set color gray
673        if {$instdat(difa$b) != 0} {set instdat(difa$b) 0.0}
674    } else {
675        set mode normal
676        set color black
677    }
678    foreach w {e4e e4f l4e l4f} {
679        catch {$frame.$w config -state $mode}
680        catch {$frame.$w config -fg $color}
681    }
682    # for now leave kratio gray, since the value is not used
683    foreach w {e4f l4f} {
684        catch {$frame.$w config -state disabled}
685        catch {$frame.$w config -fg gray}
686    }
687}
688
689proc setRadLabel {b} {
690    global instparms instdat
691    switch $instdat(rad$b) {
692        0 {set instparms(irad) Other}
693        1 {
694            set instparms(irad) Cr
695            set instdat(difc$b) 2.28970
696            set instdat(difa$b) 2.29361
697        }
698        2 {
699            set instparms(irad) Fe
700            set instdat(difc$b) 1.93604
701            set instdat(difa$b) 1.93998
702        }
703        3 {
704            set instparms(irad) Cu
705            set instdat(difc$b) 1.54056
706            set instdat(difa$b) 1.54439
707        }
708        4 {
709            set instparms(irad) Mo
710            set instdat(difc$b) 0.70930
711            set instdat(difa$b) 0.71359
712        }
713        5 {
714            set instparms(irad) Ag
715            set instdat(difc$b) 0.55941
716            set instdat(difa$b) 0.56380
717        }
718    }
719    if {$instparms(wavemode) == 1} {
720        if {$instdat(difa$b) != 0} {set instdat(difa$b) 0.0}
721    } else {
722        if {$instdat(kratio$b) != 0.5} {set instdat(kratio$b) 0.5}
723    }
724}
725
726proc traceinstdat {args} {
727    global instparms
728    incr instparms(changes)
729    if {$instparms(filename) != ""} {
730        $instparms(savebutton) config -state normal
731    }
732}
733
734proc instConfirmQuit {} {
735    global instparms
736    if {$instparms(changes) == 0} {
737        destroy $instparms(top)
738        return
739    }
740    set ans [MyMessageBox -parent . -title "Unsaved Changes" \
741            -message "You have made changes. Are you sure you want to exit?" \
742            -icon question -type "Exit Cancel" -default cancel]
743    if {$ans == "exit"} {
744        destroy $instparms(top)
745        return
746    }
747}
748
749proc instMakeWindow {"filename {}"} {
750    global instparms instdat
751
752    set instparms(top) .instedit
753    catch {toplevel $instparms(top)}
754    eval destroy [winfo children $instparms(top)]
755
756    if {$filename == ""} {
757        set instparms(filename) [tk_getOpenFile \
758                -title "Select Instrument parameter file\nor press Cancel to create a new file." \
759                -parent $instparms(top) -defaultextension .ins \
760                -filetypes {{"Instrument parameters file" ".ins .inst .prm"} {All *.*}}]
761    } else {
762        set instparms(filename) $filename
763    }
764
765    grid [frame $instparms(top).b1 -bd 2 -relief groove] -column 1 -row 1
766    grid [frame $instparms(top).b1.a] -column 0 -row 0 -sticky ew
767    grid [frame $instparms(top).b1.b] -column 0 -row 1 -sticky ew
768
769    instInit
770    if {[file exists $instparms(filename)]} {
771        instload $instparms(filename)
772        instLoadAllBanks
773        instMakeBankSel $instparms(top).b1
774        set instparms(bank) 1
775        instShowBank $instparms(top).b1
776    } else {
777        set instdat(lastbank) 0
778        instMakeBankSel $instparms(top).b1
779        instNewBank $instparms(top).b1
780    }
781    set instparms(changes) 0
782    wm protocol $instparms(top) WM_DELETE_WINDOW instConfirmQuit
783    if {$instparms(filename) == ""} {
784        wm title $instparms(top) "Editing unnamed instrument parameter file"
785    } else {
786        wm title $instparms(top) "Editing instrument parameter file $instparms(filename)"
787    }
788    bind $instparms(top) <Control-KeyPress-c> instConfirmQuit
789    set instparms(changes) 0
790    # set up a trace
791    trace variable instdat w traceinstdat
792    putontop $instparms(top)
793    tkwait window $instparms(top)
794    afterputontop
795    # delete the trace
796    foreach v [trace vinfo instdat] {eval trace vdelete instdat $v}
797}
798
Note: See TracBrowser for help on using the repository browser.