source: trunk/instedit.tcl @ 878

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

# on 2006/03/29 03:54:37, toby did:
support profile editing (& grab from .EXP) in instedit (IPNS request)
don't hard-code profile names here (grab from gsascmds.tcl)

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