source: trunk/instedit.tcl @ 868

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

# on 2006/02/22 00:29:58, toby did:
no significant changes -- allow KRATIO to be edited, but restore as the variable is not read from an instrument parameter file

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