source: trunk/instedit.tcl @ 790

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

# on 2004/05/04 17:18:41, toby did:
fix ipola buttons ("None" was broken)
disable KRATIO as it is currently unused

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