source: trunk/instedit.tcl @ 691

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

# on 2003/05/22 21:34:13, toby did:
Instrument parameter file editor

  • Property rcs:author set to toby
  • Property rcs:date set to 2003/05/22 21:34:13
  • Property rcs:rev set to 1.1
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 21.1 KB
Line 
1# $Id: instedit.tcl 691 2009-12-04 23:10:24Z 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 -col $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 . "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    set instparms(proftypes$i) 0
143    instShowBank $box
144    AddInstProfile $box $i
145    instShowBank $box
146}
147
148proc instShowBank {box} {
149    global instdat instparms
150    if {$instparms(bank) == 0} return
151    switch [string range $instdat(banktype) 0 2] {
152        PNT  {set instparms(banklabel) TOF}
153        PNC  {set instparms(banklabel) "CW neutron"}
154        PXC  {set instparms(banklabel) "CW X-ray"}
155        PXE  {set instparms(banklabel) "ED X-ray"}
156    }
157    eval destroy [winfo children [set bnkfr $box.b]]
158    set b $instparms(bank)
159    grid [label $bnkfr.l1 -text "Bank #$b" -relief raised -bd 2 \
160            -anchor w -justify left] \
161            -col 0 -row 0 -columnspan 99 -sticky ew
162    grid [label $bnkfr.l2 -text "Title: "] -col 0 -row 1 -sticky e
163    grid [entry $bnkfr.e2 -textvariable instdat(head$b) -width 60] \
164            -col 1 -row 1 -sticky w -columnspan 99
165
166    grid [label $bnkfr.l3 -text "Instrument\nname: " -anchor e -justify r] \
167            -col 0 -row 2 -sticky e
168    grid [entry $bnkfr.e3 -textvariable instdat(name$b) -width 30] \
169            -col 1 -row 2 -sticky w -columnspan 99
170
171    if {$instparms(banklabel) == "TOF"} return
172    if {$instparms(banklabel) == "ED X-ray"} return
173
174    set col 0
175    grid [label $bnkfr.l4a -text "Radiation\ntype:" -anchor e -justify r] \
176            -col $col -row 4 -sticky e -rowspan 2
177    set menu [tk_optionMenu $bnkfr.rad instparms(irad) "     "]
178    $bnkfr.rad config -width 6
179   
180    grid $bnkfr.rad -col [incr col] -row 4 -sticky w -rowspan 2
181    grid [radiobutton $bnkfr.c4a -text Monochromatic \
182            -command "disableWaveBoxes $bnkfr $b" \
183            -variable instparms(wavemode) -value 1] \
184            -col [incr col] -row 4 -sticky w
185    grid [radiobutton $bnkfr.c4b -text Dual \
186            -command "disableWaveBoxes $bnkfr $b" \
187            -variable instparms(wavemode) -value 2] \
188            -col $col -row 5 -sticky w
189
190           
191    grid [label $bnkfr.l4 -text "Wavelength: "] \
192            -col [incr col] -row 4 -sticky e -rowspan 2
193    grid [entry $bnkfr.e4d -textvariable instdat(difc$b) -width 10] \
194            -col [incr col] -row 5 -sticky ew
195    grid [label $bnkfr.l4d -text Primary] -col $col -row 4 -sticky ew
196    grid [entry $bnkfr.e4e -textvariable instdat(difa$b) -width 10] \
197            -col [incr col] -row 5 -sticky ew
198    grid [label $bnkfr.l4e -text Secondary] -col $col -row 4 -sticky ew
199    grid [entry $bnkfr.e4f -textvariable instdat(kratio$b) -width 10] \
200            -col [incr col] -row 5 -sticky ew
201    grid [label $bnkfr.l4f -text ratio] -col $col -row 4 -sticky ew
202
203    set col 0
204    grid [label $bnkfr.l6 -text "Zero\nCorrection:" \
205            -anchor e -justify r] \
206            -col $col -row 6 -sticky e
207    grid [entry $bnkfr.e6 -textvariable instdat(zero$b) -width 10] \
208            -col [incr col] -row 6 -sticky ew
209
210    set col 0
211    grid [label $bnkfr.l7 -text "Polarization\nCorrection:" \
212            -anchor e -justify r] \
213            -col $col -row 7 -sticky e
214    grid [radiobutton $bnkfr.c7a -text "Diffracted Beam" \
215            -variable instdat(ipola$b) -value 0] \
216            -col [incr col] -row 7 -sticky w
217    grid [radiobutton $bnkfr.c7b -text "Incident Beam" \
218            -variable instdat(ipola$b) -value 1] \
219            -col [incr col] -row 7 -sticky w
220    grid [radiobutton $bnkfr.c7c -text "None" \
221            -variable instdatr(ipola$b) -value 2] \
222            -col [incr col] -row 7 -sticky w
223    grid [label $bnkfr.l7a -text "Polarization\nFraction:" \
224            -anchor e -justify r] \
225            -col [incr col] -row 7 -sticky e
226    grid [entry $bnkfr.e7 -textvariable instdat(pola$b) -width 10] \
227            -col [incr col] -row 7 -sticky ew
228
229    grid [frame [set prfrm $bnkfr.prof] -bd 2 -relief groove] \
230            -col 0 -columnspan 99 -row 8
231    grid [label $prfrm.l1 -text "Select profile: "] -col 0 -row 0
232    grid [frame $prfrm.fr] -col 1 -columnspan 99 -row 0 -sticky w
233    grid [frame $prfrm.fr1] -col 0 -columnspan 99 -row 2
234    set instparms(profileframe) $prfrm.fr1
235    for {set j 1} {$j <= $instparms(proftypes${b})} {incr j} {
236        grid [radiobutton $prfrm.fr.$j -text $j -value $j \
237                -command "ShowInstProfile $b" \
238                -variable instparms(profilenum)] -row 1 -col $j
239    }
240    grid [button $prfrm.fr.a -text "Add profile" \
241            -command "AddInstProfile $box $b"] -row 1 -col 98
242    grid [button $prfrm.fr.n -text "Import profile" \
243            -command "ImportInstProfile $box $prfrm.fr1 $b"] -row 1 -col 99
244    $menu delete 0 end
245    foreach lbl {Cr Fe Cu Mo Ag Other} \
246            val { 1  2  3  4  5     0} {
247        $menu add radiobutton -value $val -label $lbl \
248                -command "setRadLabel $b" \
249                -variable instdat(rad$b)
250    }
251    if {$instdat(difa$b) == 0.0} {
252        set instparms(wavemode) 1
253    } else {
254        set instparms(wavemode) 2
255    }
256    switch $instdat(rad$b) {
257        0 {set instparms(irad) Other}
258        1 {set instparms(irad) Cr}
259        2 {set instparms(irad) Fe}
260        3 {set instparms(irad) Cu}
261        4 {set instparms(irad) Mo}
262        5 {set instparms(irad) Ag}
263    }
264    setRadLabel $b
265    disableWaveBoxes $bnkfr $b
266    set instparms(profilenum) 1
267    ShowInstProfile $b
268}
269
270proc ImportInstProfile {box frame b} {
271    global instparms instdat
272    set j $instparms(profilenum)
273
274    set filename [tk_getOpenFile \
275            -title "Select GSAS Experiment file\nor press Cancel." \
276            -parent . -defaultextension EXP \
277            -filetypes {{"GSAS Experiment file" ".EXP"}}]
278    if {$filename == ""} {return}
279    global wishshell expgui
280    set result {}
281    catch {
282        set result [exec $wishshell \
283                [file join $expgui(scriptdir) dumpprof.tcl] $filename]
284    }
285    if {[set nhist [llength $result]] == 0} {
286        set msg "No profile information was read from file $filename"
287        MyMessageBox -parent . -title "No histograms read" \
288                -message $msg -icon warning -type Sorry -default sorry
289                #-helplink "expguierr.html Customizewarning"
290        return
291    }
292    set i -1
293    set hlist {}
294    set prlist {}
295    foreach histrec $result {
296        incr i
297        set h [lindex $histrec 0]
298        set type [lindex $histrec 1]
299        if {[string range $type 0 2] == \
300                [string range $instdat(banktype) 0 2]} {
301            lappend hlist $h
302            lappend prlist [lrange $histrec 2 end]
303        }
304    }
305    if {[llength $hlist] == 0} {
306        set msg "No histograms of type \"$instparms(banklabel)\" were found"
307        MyMessageBox -parent . -title "No matching histograms" \
308                -message $msg -icon warning -type Sorry -default sorry
309                #-helplink "expguierr.html Customizewarning"
310        return
311    }
312
313    catch {destroy $instparms(top).sel}
314    toplevel [set top $instparms(top).sel]
315    wm title $top "Select histogram and phase to select"
316    grid [label $top.l1 -text "Histogram: "] -col 1 -row 1
317    set menu [tk_optionMenu $top.w instparms(histimport) ""]
318    $menu delete 0 end
319    if {[llength $hlist] > 10} {
320        set h [lrange $hlist 0 9]
321        set pr [lrange $prlist 0 9]
322        set hlist [lrange $hlist 10 end]
323        set prlist [lrange $prlist 10 end]
324        set j 0
325        while {[llength $h] > 0} {
326            set label "[lindex $h 0]-[lindex $h end]"
327            $menu add cascade -label $label -menu $menu.$j
328            menu $menu.$j
329            foreach val $h pl $pr {
330                $menu.$j add radiobutton -value $val -label $val \
331                        -command "instSetPhaseList [list $pl]" \
332                        -variable instparms(histimport)
333            }
334            set h [lrange $hlist 0 9]
335            set pr [lrange $prlist 0 9]
336            set hlist [lrange $hlist 10 end]
337            set prlist [lrange $prlist 10 end]
338            incr j
339        }
340    } else {
341        foreach val $hlist ph $prlist {
342            $menu add radiobutton -value $val -label $val \
343                    -command "instSetPhaseList [list $ph]" \
344                    -variable instparms(histimport)
345        }
346    }
347    grid $top.w -col 2 -row 1 -columnspan 2 -sticky w
348    set instparms(histimport) [lindex $hlist 0]
349    grid [label $top.l2 -text "Phase: "] -col 1 -row 2
350    set col 1
351    foreach h {1 2 3 4 5 6 7 8 9} {
352        grid [radiobutton $top.r$h \
353                -variable instparms(phaseimport) -value $h -text $h \
354                ] -col [incr col] -row 2
355    }
356    grid [frame $top.prof] -col 0 -columnspan 99 -row 3
357    grid [button $top.b1 -text Import -command "" -state disabled] \
358            -col 0 -columnspan 2 -row 4
359    grid [button $top.b2 -text Cancel -command "destroy $top"] \
360            -col 2 -columnspan 2 -row 4
361
362    # there a single histogram, select it
363    if {[llength $hlist] == 1} {
364        set instparms(histimport) $hlist
365        instSetPhaseList [lindex $prlist 0]
366    } else {
367        set instparms(histimport) {}
368    }
369    putontop $top
370    tkwait window $top
371    afterputontop 
372}
373
374proc instSetPhaseList {proflist} {
375    global instparms
376    set top $instparms(top).sel
377    set instparms(phaseimport) {}
378    $top.b1 config -state disabled -command ""
379    foreach h {1 2 3 4 5 6 7 8 9} {
380        $top.r$h config -state disabled -command ""
381    }
382    foreach item $proflist {
383puts "item = $item"
384        set h [lindex $item 0]
385puts "top = $top.r$h"
386        $top.r$h config -state normal \
387                -command "instSelectPhase [list $item]"
388    }
389    eval destroy [winfo children [set frame $top.prof]]
390    if {[llength $proflist] == 1} {$top.r$h invoke}
391}
392
393proc instSelectPhase {proflist} {
394    global instparms instdat
395    set top $instparms(top).sel
396    eval destroy [winfo children [set frame $top.prof]]
397    set row 0
398    set col 0
399    set num [lindex $proflist 1]
400    set lbl [lindex \
401            {"" "1: Gaussian only" "2: Pseudo-Voigt" \
402            "3: Pseudo-Voigt/FCJ Asym" "4: P-V/FCJ/Stephens Aniso Brdg"} $num]
403    grid [label $frame.${col}_$row -justify left -anchor w \
404            -text "Profile type $lbl"] \
405            -col $col -row $row -columnspan 99 -sticky w
406    incr row
407    set col 0
408    grid [label $frame.${col}_$row -text "Peak cutoff"  -padx 4] \
409            -col $col -row $row -sticky e
410    incr col
411    grid [label $frame.${col}_$row -text "[lindex $proflist 2]" \
412            -relief groove -bd 2 -padx 2] \
413            -col $col -row $row -sticky ew
414    incr col
415    set N $num
416    set T [string range $instdat(banktype) 2 2]
417    set lbllist ""
418    global expgui
419    catch {set lbllist $expgui(prof-${T}-$N)}
420    set i 0
421    foreach lbl $lbllist val [lrange $proflist 3 end] {
422        incr i
423        if {$col > 6} {set col 0; incr row}
424        grid [label $frame.${col}_$row -text $lbl -padx 4] \
425                -col $col -row $row -sticky e
426        incr col
427        grid [label $frame.${col}_$row -text $val \
428                -bd 2 -padx 2 -relief groove] \
429                -col $col -row $row -sticky ew
430        incr col
431    }
432    $top.b1 config -state normal \
433            -command "instSetProfile [list $proflist]; destroy $top"
434}
435
436proc instSetProfile {proflist} {
437    puts "set profile $proflist"
438    global instparms instdat expgui
439    set b $instparms(bank)
440    set j $instparms(profilenum)
441    set N [set instdat(proftype${b}_$j) [lindex $proflist 1]]
442    set T [string range $instdat(banktype) 2 2]
443    set lbllist ""
444    catch {set lbllist $expgui(prof-${T}-$N)}
445    set instdat(profcut${b}_$j) [lindex $proflist 2]
446    set i 0
447    foreach lbl $lbllist val [lrange $proflist 3 end] {
448        incr i
449        if {$val == ""} {set val "0.0"}
450        set instdat(prof${b}_${j}_$i) $val
451    }
452    ShowInstProfile $b
453}
454
455proc AddInstProfile {box b} {
456    global instparms instdat
457    set frame $instparms(profileframe)
458    incr instparms(proftypes${b})
459    instShowBank $box
460    set instparms(profilenum) $instparms(proftypes${b})
461    set instdat(proftype${b}_$instparms(profilenum)) " "
462    ShowInstProfile $b
463}
464
465proc ShowInstProfile {b} {
466    global instparms instdat
467    set frame $instparms(profileframe)
468    set j $instparms(profilenum)
469    eval destroy [winfo children $frame]
470    set row 0
471    set col 0
472    grid [label $frame.${col}_$row -text "Profile\ntype"] \
473            -col $col -row $row
474    incr col
475    set menu [tk_optionMenu $frame.${col}_$row instdat(proftype${b}_$j) " "]
476    grid $frame.${col}_$row -col $col -row $row -sticky ew
477    $menu delete 0 end
478    foreach val { 1  2  3  4} \
479            lbl {"1) Gaussian only" "2) Pseudo-Voigt" \
480            "3) Pseudo-Voigt/FCJ Asym" "4) P-V/FCJ/Stephens Aniso Brdg"} {
481        $menu add radiobutton -value $val -label $lbl \
482                -command "instInitProf; ShowInstProfile $b" \
483                -variable instdat(proftype${b}_$j)
484    }
485    if {$instdat(proftype${b}_$j) == " "} return
486
487    incr col
488    grid [label $frame.${col}_$row -text "Peak\ncutoff"] \
489            -col $col -row $row
490    incr col
491    if [catch {set instdat(profcut${b}_$j)}] {
492        set instdat(profcut${b}_$j) 0.01
493    }
494    grid [entry $frame.${col}_$row -width 10 \
495            -textvariable instdat(profcut${b}_$j)] \
496            -col $col -row $row
497    incr row
498    set col 0
499    set N $instdat(proftype${b}_$j)
500    set T [string range $instdat(banktype) 2 2]
501    set lbllist ""
502    global expgui
503    catch {set lbllist $expgui(prof-${T}-$N)}
504    set i 0
505    foreach lbl $lbllist {
506        incr i
507        if {$col > 6} {set col 0; incr row}
508        grid [label $frame.${col}_$row -text $lbl] \
509                -col $col -row $row
510        incr col
511        if [catch {set instdat(prof${b}_${j}_$i)}] {
512            set instdat(prof${b}_${j}_$i) 0.0
513        }
514        grid [entry $frame.${col}_$row -width 14 \
515                -textvariable instdat(prof${b}_${j}_$i)] \
516                -col $col -row $row
517        incr col
518    }
519    # reset the number of terms to match the # of labels
520    set instparms(profterms${b}_${j}) $i
521}
522
523proc instInitProf {} {
524    global instparms instdat
525    set b $instparms(bank)
526    set j $instparms(profilenum)
527    set N $instdat(proftype${b}_$j)
528    set T [string range $instdat(banktype) 2 2]
529    global expgui
530    set i 0
531    set lbllist ""
532    catch {set lblist $expgui(prof-${T}-$N)}
533    foreach lbl $lbllist {
534        incr i
535        set instdat(prof${b}_${j}_$i) 0.0
536    }
537    # reset the number of terms to match the # of labels
538    set instparms(profterms${b}_${j}) $i
539}
540
541proc disableWaveBoxes {frame b} {
542    global instparms instdat
543    if {$instparms(banklabel) == "CW neutron"} {
544        set instparms(wavemode) 1
545        set mode disabled
546        set color gray
547    } else {
548        set mode normal
549        set color black
550    }
551    $frame.rad config -state $mode
552    foreach v {c4b c7a c7b c7c e7} {
553        $frame.$v config -state $mode -fg $color
554    }
555    foreach v {l7 l7a} {
556        $frame.$v config -fg $color
557    }
558
559    if {$instparms(wavemode) == 1} {
560        set mode disabled
561        set color gray
562        if {$instdat(difa$b) != 0} {set instdat(difa$b) 0.0}
563    } else {
564        set mode normal
565        set color black
566    }
567    foreach w {e4e e4f} {
568        $frame.$w config -state $mode -fg $color
569    }
570    foreach w {l4e l4f} {
571        $frame.$w config -fg $color
572    }
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] -col 1 -row 1
652    grid [frame $instparms(top).b1.a] -col 0 -row 0 -sticky ew
653    grid [frame $instparms(top).b1.b] -col 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.