source: trunk/instedit.tcl

Last change on this file was 1251, checked in by toby, 7 years ago

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