source: trunk/instedit.tcl @ 930

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

rcs:* properties removed

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