| 1 | # implement next |
|---|
| 2 | |
|---|
| 3 | # platform-specific code |
|---|
| 4 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 5 | if [catch {package require winexec}] { |
|---|
| 6 | tk_dialog .err "WINEXEC Error" \ |
|---|
| 7 | "Error -- Unable to load the WINEXEC package. This is needed in Win95 machines" \ |
|---|
| 8 | error 0 Quit |
|---|
| 9 | destroy . |
|---|
| 10 | } |
|---|
| 11 | if {$tcl_platform(os) == "Windows 95" || $tcl_platform(os) == "Windows 98" } { |
|---|
| 12 | proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} { |
|---|
| 13 | global env expgui |
|---|
| 14 | # Windows environment variables |
|---|
| 15 | # -95 does not seem to be able to use these |
|---|
| 16 | set env(GSAS) [file nativename $expgui(gsasexe)] |
|---|
| 17 | # PGPLOT_FONT is needed by PGPLOT |
|---|
| 18 | set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]] |
|---|
| 19 | # this is the number of lines/page in the .LST (etc.) file |
|---|
| 20 | set env(LENPAGE) 60 |
|---|
| 21 | set pwd [file nativename [pwd]] |
|---|
| 22 | |
|---|
| 23 | # check the path -- can DOS use it? |
|---|
| 24 | if {[string first // [pwd]] != -1} { |
|---|
| 25 | tk_dialog .braindead "Invalid Path" \ |
|---|
| 26 | {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) \ |
|---|
| 27 | Win-95 can't directly access a network drive in DOS} error 0 OK |
|---|
| 28 | return |
|---|
| 29 | } |
|---|
| 30 | # all winexec commands are background commands |
|---|
| 31 | # if $background |
|---|
| 32 | |
|---|
| 33 | # pause is hard coded in the .BAT file |
|---|
| 34 | #if $wait { |
|---|
| 35 | # append command " pause" |
|---|
| 36 | #} |
|---|
| 37 | |
|---|
| 38 | # replace the forward slashes with backward |
|---|
| 39 | regsub -all / $command \\ command |
|---|
| 40 | # Win95 does not seem to inherit the environment from Tcl env vars |
|---|
| 41 | # so define it in the .BAT file |
|---|
| 42 | winexec -d [file nativename [pwd]] \ |
|---|
| 43 | [file join $expgui(scriptdir) gsastcl.bat] \ |
|---|
| 44 | "[file nativename $expgui(gsasdir)] $command" |
|---|
| 45 | } |
|---|
| 46 | } else { |
|---|
| 47 | # now for - brain-dead Windows-NT |
|---|
| 48 | proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} { |
|---|
| 49 | global env expgui |
|---|
| 50 | # Windows environment variables |
|---|
| 51 | # -95 does not seem to be able to use these |
|---|
| 52 | set env(GSAS) [file nativename $expgui(gsasexe)] |
|---|
| 53 | # PGPLOT_FONT is needed by PGPLOT |
|---|
| 54 | set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]] |
|---|
| 55 | # this is the number of lines/page in the .LST (etc.) file |
|---|
| 56 | set env(LENPAGE) 60 |
|---|
| 57 | # all winexec commands are background commands -- ignore background arg |
|---|
| 58 | |
|---|
| 59 | # can't get pause to work! -- ignore wait |
|---|
| 60 | |
|---|
| 61 | set prevcmd {} |
|---|
| 62 | foreach cmd $command { |
|---|
| 63 | if {$prevcmd != ""} { |
|---|
| 64 | tk_dialog .done_yet Confirm "Press OK to start command $cmd" "" 0 OK |
|---|
| 65 | } |
|---|
| 66 | # replace the forward slashes with backward |
|---|
| 67 | regsub -all / $cmd \\ cmd |
|---|
| 68 | # cmd.exe must be in the path -- lets hope that at least works! |
|---|
| 69 | winexec -d [file nativename [pwd]] cmd.exe "/c $cmd" |
|---|
| 70 | set prevcmd $cmd |
|---|
| 71 | } |
|---|
| 72 | } |
|---|
| 73 | } |
|---|
| 74 | } else { |
|---|
| 75 | if [catch {set env(GSASBACKSPACE)}] {set env(GSASBACKSPACE) 1} |
|---|
| 76 | |
|---|
| 77 | proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} { |
|---|
| 78 | global env expgui |
|---|
| 79 | # UNIX environment variables |
|---|
| 80 | set env(GSASEXE) $expgui(gsasexe) |
|---|
| 81 | set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat] |
|---|
| 82 | set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat] |
|---|
| 83 | # PGPLOT_DIR is needed by PGPLOT |
|---|
| 84 | set env(PGPLOT_DIR) [file join $expgui(gsasdir) pgl] |
|---|
| 85 | # this is the number of lines/page in the .LST (etc.) file |
|---|
| 86 | set env(LENPAGE) 60 |
|---|
| 87 | set termopts {} |
|---|
| 88 | if $env(GSASBACKSPACE) { |
|---|
| 89 | append termopts \ |
|---|
| 90 | {-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"} |
|---|
| 91 | } |
|---|
| 92 | if $scrollbar { |
|---|
| 93 | append termopts " -sb" |
|---|
| 94 | } else { |
|---|
| 95 | append termopts " +sb" |
|---|
| 96 | } |
|---|
| 97 | if $background { |
|---|
| 98 | set suffix {&} |
|---|
| 99 | } else { |
|---|
| 100 | set suffix {} |
|---|
| 101 | } |
|---|
| 102 | # |
|---|
| 103 | if $wait { |
|---|
| 104 | append command "\; echo -n Press Enter to continue \; read x" |
|---|
| 105 | } |
|---|
| 106 | if !$background {wm iconify .} |
|---|
| 107 | catch {eval exec xterm $termopts -title [list $title] \ |
|---|
| 108 | -e /bin/sh -c [list $command] $suffix} errmsg |
|---|
| 109 | if $expgui(debug) {puts "xterm result = $errmsg"} |
|---|
| 110 | if !$background {wm deiconify .} |
|---|
| 111 | } |
|---|
| 112 | } |
|---|
| 113 | |
|---|
| 114 | |
|---|
| 115 | proc newexp {} { |
|---|
| 116 | global infile outfile |
|---|
| 117 | set frm .file |
|---|
| 118 | catch {destroy $frm} |
|---|
| 119 | toplevel $frm |
|---|
| 120 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 121 | pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left |
|---|
| 122 | pack [button $frmC.b -text Create -command "valid_new_exp_file"] -side top |
|---|
| 123 | bind $frm <Return> "valid_new_exp_file" |
|---|
| 124 | pack [button $frmC.q -text Quit -command "set infile(done) 2"] -side top |
|---|
| 125 | |
|---|
| 126 | pack [label $frmA.0 -text "Enter an experiment file"] -side top -anchor center |
|---|
| 127 | expfilebox $frmA infile 2 |
|---|
| 128 | set infile(done) 0 |
|---|
| 129 | # force the window to stay on top |
|---|
| 130 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
|---|
| 131 | |
|---|
| 132 | wm withdraw $frm |
|---|
| 133 | update idletasks |
|---|
| 134 | # center the new window in the middle of the parent |
|---|
| 135 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
|---|
| 136 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
|---|
| 137 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
|---|
| 138 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
|---|
| 139 | wm geom $frm +$x+$y |
|---|
| 140 | wm deiconify $frm |
|---|
| 141 | |
|---|
| 142 | set oldFocus [focus] |
|---|
| 143 | set oldGrab [grab current $frm] |
|---|
| 144 | if {$oldGrab != ""} { |
|---|
| 145 | set grabStatus [grab status $oldGrab] |
|---|
| 146 | } |
|---|
| 147 | grab $frm |
|---|
| 148 | focus $frmC.b |
|---|
| 149 | tkwait variable infile(done) |
|---|
| 150 | destroy $frm |
|---|
| 151 | catch {focus $oldFocus} |
|---|
| 152 | if {$oldGrab != ""} { |
|---|
| 153 | if {$grabStatus == "global"} { |
|---|
| 154 | grab -global $oldGrab |
|---|
| 155 | } else { |
|---|
| 156 | grab $oldGrab |
|---|
| 157 | } |
|---|
| 158 | } |
|---|
| 159 | if {$infile(done) == 2} return |
|---|
| 160 | return [file join $infile(dir) $infile(name)] |
|---|
| 161 | } |
|---|
| 162 | |
|---|
| 163 | proc getstring {what "chars 40" "quit 1" "initvalue {}"} { |
|---|
| 164 | global expgui expmap |
|---|
| 165 | set w .global |
|---|
| 166 | catch {destroy $w} |
|---|
| 167 | toplevel $w -bg beige |
|---|
| 168 | wm title $w "Input $what" |
|---|
| 169 | set expgui(temp) {} |
|---|
| 170 | pack [frame $w.0 -bd 6 -relief groove -bg beige] \ |
|---|
| 171 | -side top -expand yes -fill both |
|---|
| 172 | grid [label $w.0.a -text "Input a value for the $what" \ |
|---|
| 173 | -bg beige] \ |
|---|
| 174 | -row 0 -column 0 -columnspan 10 |
|---|
| 175 | grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \ |
|---|
| 176 | -row 1 -column 0 |
|---|
| 177 | |
|---|
| 178 | set expgui(temp) $initvalue |
|---|
| 179 | pack [frame $w.b] -side top |
|---|
| 180 | pack [button $w.b.2 -text Set -command "destroy $w"] -side left |
|---|
| 181 | if $quit { |
|---|
| 182 | pack [button $w.b.3 -text Quit \ |
|---|
| 183 | -command "set expgui(temp) {}; destroy $w"] -side left |
|---|
| 184 | } |
|---|
| 185 | # force the window to stay on top |
|---|
| 186 | wm transient $w [winfo toplevel [winfo parent $w]] |
|---|
| 187 | |
|---|
| 188 | bind $w <Return> "destroy $w" |
|---|
| 189 | wm withdraw $w |
|---|
| 190 | update idletasks |
|---|
| 191 | # center the new window in the middle of the parent |
|---|
| 192 | set x [expr [winfo x [winfo parent $w]] + [winfo width .]/2 - \ |
|---|
| 193 | [winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]] |
|---|
| 194 | set y [expr [winfo y [winfo parent $w]] + [winfo height .]/2 - \ |
|---|
| 195 | [winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]] |
|---|
| 196 | wm geom $w +$x+$y |
|---|
| 197 | wm deiconify $w |
|---|
| 198 | |
|---|
| 199 | set oldFocus [focus] |
|---|
| 200 | set oldGrab [grab current $w] |
|---|
| 201 | if {$oldGrab != ""} { |
|---|
| 202 | set grabStatus [grab status $oldGrab] |
|---|
| 203 | } |
|---|
| 204 | grab $w |
|---|
| 205 | focus $w.b.2 |
|---|
| 206 | tkwait window $w |
|---|
| 207 | catch {focus $oldFocus} |
|---|
| 208 | if {$oldGrab != ""} { |
|---|
| 209 | if {$grabStatus == "global"} { |
|---|
| 210 | grab -global $oldGrab |
|---|
| 211 | } else { |
|---|
| 212 | grab $oldGrab |
|---|
| 213 | } |
|---|
| 214 | } |
|---|
| 215 | return $expgui(temp) |
|---|
| 216 | } |
|---|
| 217 | |
|---|
| 218 | |
|---|
| 219 | proc next {direction} { |
|---|
| 220 | global |
|---|
| 221 | set filelist [lsort [glob *.EXP]] |
|---|
| 222 | set ind [lsearch $filelist $expnam.EXP] |
|---|
| 223 | if {$ind == -1 && $expnam != ""} return |
|---|
| 224 | if $direction { # true positive |
|---|
| 225 | incr ind |
|---|
| 226 | } { |
|---|
| 227 | incr ind -1 |
|---|
| 228 | } |
|---|
| 229 | if {$ind < 0} {set ind [expr [llength $filelist]-1]} |
|---|
| 230 | if {$ind >= [llength $filelist] } {set ind 0} |
|---|
| 231 | set expnam [string toupper [file root [lindex $filelist $ind]]] |
|---|
| 232 | showexp |
|---|
| 233 | } |
|---|
| 234 | |
|---|
| 235 | proc runGSASprog {proglist} { |
|---|
| 236 | global expgui tcl_platform |
|---|
| 237 | set cmd {} |
|---|
| 238 | foreach prog $proglist { |
|---|
| 239 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 240 | append cmd " \"$expgui(gsasexe)/${prog}.exe \" " |
|---|
| 241 | } else { |
|---|
| 242 | if {$cmd != ""} {append cmd "\;"} |
|---|
| 243 | append cmd "[file join $expgui(gsasexe) $prog]" |
|---|
| 244 | } |
|---|
| 245 | } |
|---|
| 246 | forknewterm $prog $cmd 0 1 1 |
|---|
| 247 | } |
|---|
| 248 | |
|---|
| 249 | proc runGSASwEXP {proglist} { |
|---|
| 250 | global expgui tcl_platform |
|---|
| 251 | # Save the current exp file |
|---|
| 252 | savearchiveexp |
|---|
| 253 | set cmd {} |
|---|
| 254 | set expnam [file root [file tail $expgui(expfile)]] |
|---|
| 255 | foreach prog $proglist { |
|---|
| 256 | if {$prog == "expedt" && $expgui(archive)} archiveexp |
|---|
| 257 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 258 | append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" " |
|---|
| 259 | } else { |
|---|
| 260 | if {$cmd != ""} {append cmd "\;"} |
|---|
| 261 | append cmd "[file join $expgui(gsasexe) $prog] $expnam" |
|---|
| 262 | } |
|---|
| 263 | } |
|---|
| 264 | forknewterm "$prog -- $expnam" $cmd 0 1 1 |
|---|
| 265 | wm deiconify . |
|---|
| 266 | } |
|---|
| 267 | |
|---|
| 268 | proc liveplot {} { |
|---|
| 269 | global expgui liveplot wishshell |
|---|
| 270 | set expnam [file root [file tail $expgui(expfile)]] |
|---|
| 271 | exec $wishshell [file join $expgui(scriptdir) liveplot] \ |
|---|
| 272 | $expnam $expgui(gsasexe) $liveplot(hst) $liveplot(legend) & |
|---|
| 273 | } |
|---|
| 274 | |
|---|
| 275 | proc lstview {} { |
|---|
| 276 | global expgui wishshell |
|---|
| 277 | set expnam [file root [file tail $expgui(expfile)]] |
|---|
| 278 | exec $wishshell [file join $expgui(scriptdir) lstview] $expnam & |
|---|
| 279 | } |
|---|
| 280 | |
|---|
| 281 | proc widplt {} { |
|---|
| 282 | global expgui wishshell |
|---|
| 283 | set expnam [file root [file tail $expgui(expfile)]] |
|---|
| 284 | exec $wishshell [file join $expgui(scriptdir) widplt] $expgui(gsasexe) $expnam & |
|---|
| 285 | } |
|---|
| 286 | |
|---|
| 287 | |
|---|
| 288 | proc showhelp {} { |
|---|
| 289 | global expgui_helplist helpmsg |
|---|
| 290 | set helpmsg {} |
|---|
| 291 | set frm .help |
|---|
| 292 | catch {destroy $frm} |
|---|
| 293 | toplevel $frm |
|---|
| 294 | wm title $frm "Command Help" |
|---|
| 295 | pack [message $frm.0 -text \ |
|---|
| 296 | "Click on an entry below to see help on a GSAS command" ] \ |
|---|
| 297 | -side top |
|---|
| 298 | pack [frame $frm.a -width 20 -height 15] \ |
|---|
| 299 | -side top -expand yes -fill both |
|---|
| 300 | pack [message $frm.help -textvariable helpmsg -relief groove] \ |
|---|
| 301 | -side left -fill both -expand yes |
|---|
| 302 | set lst [array names expgui_helplist] |
|---|
| 303 | listbox $frm.a.cmds -relief raised -bd 2 -yscrollcommand \ |
|---|
| 304 | "$frm.a.scroll set" -height 15 -width 0 |
|---|
| 305 | scrollbar $frm.a.scroll -command "$frm.a.cmds yview" |
|---|
| 306 | foreach item [lsort $lst] { |
|---|
| 307 | $frm.a.cmds insert end $item |
|---|
| 308 | } |
|---|
| 309 | if {[$frm.a.cmds curselection] == ""} {$frm.a.cmds selection set 0} |
|---|
| 310 | button $frm.a.done -text Done -command "destroy $frm" |
|---|
| 311 | bind $frm.a.cmds <ButtonRelease-1> \ |
|---|
| 312 | "+set helpmsg \$expgui_helplist(\[$frm.a.cmds get \[$frm.a.cmds curselection\]\])" |
|---|
| 313 | pack $frm.a.scroll -side left -fill y |
|---|
| 314 | pack $frm.a.cmds -side left -expand yes -anchor w |
|---|
| 315 | pack $frm.a.done -side right -expand no |
|---|
| 316 | # get the size of the window and expand the message boxes to match |
|---|
| 317 | update |
|---|
| 318 | set width [lindex [split [wm geometry $frm] x+] 0] |
|---|
| 319 | $frm.0 config -width $width |
|---|
| 320 | $frm.help config -width $width |
|---|
| 321 | # waitdone $frm |
|---|
| 322 | } |
|---|
| 323 | |
|---|
| 324 | proc convfile {} { |
|---|
| 325 | global tcl_platform |
|---|
| 326 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 327 | convwin |
|---|
| 328 | } else { |
|---|
| 329 | convunix |
|---|
| 330 | } |
|---|
| 331 | } |
|---|
| 332 | |
|---|
| 333 | # file conversions for UNIX (convstod convdtos) |
|---|
| 334 | proc convunix {} { |
|---|
| 335 | global expgui infile outfile |
|---|
| 336 | set frm .file |
|---|
| 337 | catch {destroy $frm} |
|---|
| 338 | toplevel $frm |
|---|
| 339 | wm title $frm "Convert File" |
|---|
| 340 | pack [frame [set frm0 $frm.0] -bd 2 -relief groove] -padx 3 -pady 3 -side top |
|---|
| 341 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 342 | pack [frame [set frmB $frm.2] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 343 | pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left |
|---|
| 344 | pack [button $frmC.b -text Convert -command "valid_conv_file"] -side top |
|---|
| 345 | pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side top |
|---|
| 346 | |
|---|
| 347 | pack [label $frmA.0 -text "Select an input file"] -side top -anchor center |
|---|
| 348 | pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center |
|---|
| 349 | |
|---|
| 350 | pack [label $frm0.1 -text "Convert to:"] -side top -anchor w |
|---|
| 351 | pack [radiobutton $frm0.2 -text "direct access" -value convstod \ |
|---|
| 352 | -command setoutfile \ |
|---|
| 353 | -variable outfile(type)] -side top -anchor w |
|---|
| 354 | pack [radiobutton $frm0.3 -text "sequential" -value convdtos \ |
|---|
| 355 | -command setoutfile \ |
|---|
| 356 | -variable outfile(type)] -side top -anchor w |
|---|
| 357 | set outfile(type) "" |
|---|
| 358 | cnvfilebox $frmA infile 1 |
|---|
| 359 | cnvfilebox $frmB outfile 0 |
|---|
| 360 | set infile(done) 0 |
|---|
| 361 | # force the window to stay on top |
|---|
| 362 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
|---|
| 363 | |
|---|
| 364 | bind $frm <Return> "valid_conv_file" |
|---|
| 365 | wm withdraw $frm |
|---|
| 366 | update idletasks |
|---|
| 367 | # center the new window in the middle of the parent |
|---|
| 368 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
|---|
| 369 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
|---|
| 370 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
|---|
| 371 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
|---|
| 372 | wm geom $frm +$x+$y |
|---|
| 373 | wm deiconify $frm |
|---|
| 374 | |
|---|
| 375 | set oldFocus [focus] |
|---|
| 376 | set oldGrab [grab current $frm] |
|---|
| 377 | if {$oldGrab != ""} { |
|---|
| 378 | set grabStatus [grab status $oldGrab] |
|---|
| 379 | } |
|---|
| 380 | grab $frm |
|---|
| 381 | focus $frmC.q |
|---|
| 382 | update |
|---|
| 383 | tkwait variable infile(done) |
|---|
| 384 | catch {focus $oldFocus} |
|---|
| 385 | if {$oldGrab != ""} { |
|---|
| 386 | if {$grabStatus == "global"} { |
|---|
| 387 | grab -global $oldGrab |
|---|
| 388 | } else { |
|---|
| 389 | grab $oldGrab |
|---|
| 390 | } |
|---|
| 391 | } |
|---|
| 392 | destroy $frm |
|---|
| 393 | } |
|---|
| 394 | |
|---|
| 395 | # validate the files and make the conversion |
|---|
| 396 | proc valid_conv_file {} { |
|---|
| 397 | global infile outfile expgui |
|---|
| 398 | if {$outfile(type) == "convstod" || $outfile(type) == "convdtos"} { |
|---|
| 399 | set convtype $outfile(type) |
|---|
| 400 | } else { |
|---|
| 401 | return |
|---|
| 402 | } |
|---|
| 403 | if {$infile(name) == ""} return |
|---|
| 404 | if {$outfile(name) == ""} return |
|---|
| 405 | if {$infile(name) == $outfile(name)} { |
|---|
| 406 | tk_dialog .warn Notify "Sorry, filenames must differ" warning 0 OK |
|---|
| 407 | return |
|---|
| 408 | } |
|---|
| 409 | if ![file exists [file join $infile(dir) $infile(name)]] { |
|---|
| 410 | tk_dialog .warn Notify \ |
|---|
| 411 | "Sorry, file $infile(name) not found in $infile(dir)" warning 0 OK |
|---|
| 412 | return |
|---|
| 413 | } |
|---|
| 414 | if [file exists [file join $outfile(dir) $outfile(name)]] { |
|---|
| 415 | if [tk_dialog .warn Notify \ |
|---|
| 416 | "Warning: file $outfile(name) exists in $outfile(dir). OK to overwrite?" \ |
|---|
| 417 | warning 0 OK No] return |
|---|
| 418 | } |
|---|
| 419 | if [catch { |
|---|
| 420 | exec [file join $expgui(gsasexe) $convtype] < \ |
|---|
| 421 | [file join $infile(dir) $infile(name)] > \ |
|---|
| 422 | [file join $outfile(dir) $outfile(name)] |
|---|
| 423 | } errmsg] { |
|---|
| 424 | tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK |
|---|
| 425 | } else { |
|---|
| 426 | if [tk_dialog .converted Notify \ |
|---|
| 427 | "File converted. Convert more files?" \ |
|---|
| 428 | "" 0 Yes No] {set infile(done) 1} |
|---|
| 429 | } |
|---|
| 430 | } |
|---|
| 431 | |
|---|
| 432 | # file conversions for Windows |
|---|
| 433 | proc convwin {} { |
|---|
| 434 | global expgui infile outfile |
|---|
| 435 | set frm .file |
|---|
| 436 | catch {destroy $frm} |
|---|
| 437 | toplevel $frm |
|---|
| 438 | wm title $frm "Convert File" |
|---|
| 439 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 440 | pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left |
|---|
| 441 | pack [button $frmC.b -text Convert -command "valid_conv_win"] -side top |
|---|
| 442 | pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side top |
|---|
| 443 | pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center |
|---|
| 444 | cnvfilebox $frmA outfile 1 |
|---|
| 445 | set infile(done) 0 |
|---|
| 446 | # force the window to stay on top |
|---|
| 447 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
|---|
| 448 | |
|---|
| 449 | bind $frm <Return> "valid_conv_file" |
|---|
| 450 | wm withdraw $frm |
|---|
| 451 | update idletasks |
|---|
| 452 | # center the new window in the middle of the parent |
|---|
| 453 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
|---|
| 454 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
|---|
| 455 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
|---|
| 456 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
|---|
| 457 | wm geom $frm +$x+$y |
|---|
| 458 | wm deiconify $frm |
|---|
| 459 | |
|---|
| 460 | set oldFocus [focus] |
|---|
| 461 | set oldGrab [grab current $frm] |
|---|
| 462 | if {$oldGrab != ""} { |
|---|
| 463 | set grabStatus [grab status $oldGrab] |
|---|
| 464 | } |
|---|
| 465 | grab $frm |
|---|
| 466 | focus $frmC.q |
|---|
| 467 | update |
|---|
| 468 | tkwait variable infile(done) |
|---|
| 469 | if {$oldGrab != ""} { |
|---|
| 470 | if {$grabStatus == "global"} { |
|---|
| 471 | grab -global $oldGrab |
|---|
| 472 | } else { |
|---|
| 473 | grab $oldGrab |
|---|
| 474 | } |
|---|
| 475 | } |
|---|
| 476 | destroy $frm |
|---|
| 477 | } |
|---|
| 478 | |
|---|
| 479 | # validate the files and make the conversion |
|---|
| 480 | proc valid_conv_win {} { |
|---|
| 481 | global infile outfile expgui |
|---|
| 482 | if {$outfile(name) == ""} return |
|---|
| 483 | if ![file exists $outfile(dir)/$outfile(name)] { |
|---|
| 484 | tk_dialog .warn Notify \ |
|---|
| 485 | "Sorry, file $outfile(name) not found in $outfile(dir)" warning 0 OK |
|---|
| 486 | return |
|---|
| 487 | } |
|---|
| 488 | if [catch { |
|---|
| 489 | set newname "[file rootname $outfile(name)].tmp" |
|---|
| 490 | set oldname "[file rootname $outfile(name)].seq" |
|---|
| 491 | set in [open $outfile(dir)/$outfile(name) r] |
|---|
| 492 | set out [open $outfile(dir)/$newname w] |
|---|
| 493 | set len [gets $in line] |
|---|
| 494 | if {$len > 160} { |
|---|
| 495 | # this is a UNIX file. Hope there are no control characters |
|---|
| 496 | set i 0 |
|---|
| 497 | set j 79 |
|---|
| 498 | while {$j < $len} { |
|---|
| 499 | puts $out [string range $line $i $j] |
|---|
| 500 | incr i 80 |
|---|
| 501 | incr j 80 |
|---|
| 502 | } |
|---|
| 503 | } else { |
|---|
| 504 | while {$len >= 0} { |
|---|
| 505 | append line " " |
|---|
| 506 | append line " " |
|---|
| 507 | set line [string range $line 0 79] |
|---|
| 508 | puts $out $line |
|---|
| 509 | set len [gets $in line] |
|---|
| 510 | } |
|---|
| 511 | } |
|---|
| 512 | close $in |
|---|
| 513 | close $out |
|---|
| 514 | file rename $outfile(dir)/$outfile(name) $oldname |
|---|
| 515 | file rename $newname $outfile(dir)/$outfile(name) |
|---|
| 516 | } errmsg] { |
|---|
| 517 | tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK |
|---|
| 518 | } else { |
|---|
| 519 | if [tk_dialog .converted Notify \ |
|---|
| 520 | "File converted. Convert more files?" \ |
|---|
| 521 | "" 0 Yes No] {set infile(done) 1} |
|---|
| 522 | } |
|---|
| 523 | } |
|---|
| 524 | |
|---|
| 525 | # validate the files and make the conversion |
|---|
| 526 | proc valid_new_exp_file {} { |
|---|
| 527 | global infile |
|---|
| 528 | if {$infile(name) == ""} return |
|---|
| 529 | set infile(name) [file root [string toupper $infile(name)]].EXP |
|---|
| 530 | if [file exists [file join $infile(dir) $infile(name)]] { |
|---|
| 531 | tk_dialog .warn Notify \ |
|---|
| 532 | "Sorry, file $infile(name) found in $infile(dir)" warning 0 OK |
|---|
| 533 | return |
|---|
| 534 | } |
|---|
| 535 | set infile(done) 1 |
|---|
| 536 | } |
|---|
| 537 | |
|---|
| 538 | # create a file box |
|---|
| 539 | proc expfilebox {bx filvar diropt} { |
|---|
| 540 | global ${filvar} |
|---|
| 541 | pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top |
|---|
| 542 | set ${filvar}(dir) [pwd] |
|---|
| 543 | pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both |
|---|
| 544 | listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \ |
|---|
| 545 | -height 15 -width 0 |
|---|
| 546 | scrollbar $bx.a.scroll -command "$bx.a.files yview" |
|---|
| 547 | filchoose $bx $bx.a.files $filvar $diropt |
|---|
| 548 | bind $bx.a.files <ButtonRelease-1> \ |
|---|
| 549 | "filchoose $bx $bx.a.files $filvar $diropt" |
|---|
| 550 | pack $bx.a.scroll -side left -fill y |
|---|
| 551 | pack $bx.a.files -side left -fill both -expand yes |
|---|
| 552 | pack [entry $bx.c -textvariable ${filvar}(name)] -side top |
|---|
| 553 | } |
|---|
| 554 | |
|---|
| 555 | # create a file box for conversions |
|---|
| 556 | proc cnvfilebox {bx filvar diropt} { |
|---|
| 557 | global ${filvar} |
|---|
| 558 | pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top |
|---|
| 559 | set ${filvar}(dir) [pwd] |
|---|
| 560 | pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both |
|---|
| 561 | listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \ |
|---|
| 562 | -height 15 -width 0 |
|---|
| 563 | scrollbar $bx.a.scroll -command "$bx.a.files yview" |
|---|
| 564 | filchoose $bx $bx.a.files $filvar $diropt |
|---|
| 565 | if {$filvar == "infile"} { |
|---|
| 566 | bind $bx.a.files <ButtonRelease-1> \ |
|---|
| 567 | "filchoose $bx $bx.a.files $filvar $diropt; setoutfile" |
|---|
| 568 | } else { |
|---|
| 569 | bind $bx.a.files <ButtonRelease-1> \ |
|---|
| 570 | "filchoose $bx $bx.a.files $filvar $diropt" |
|---|
| 571 | } |
|---|
| 572 | pack $bx.a.scroll -side left -fill y |
|---|
| 573 | pack $bx.a.files -side left -fill both -expand yes |
|---|
| 574 | pack [entry $bx.c -textvariable ${filvar}(name)] -side top |
|---|
| 575 | } |
|---|
| 576 | |
|---|
| 577 | # select a file or directory, also called when box is created to fill it |
|---|
| 578 | proc filchoose {frm box filvar {dironly 1}} { |
|---|
| 579 | global expnam $filvar |
|---|
| 580 | set select [$box curselection] |
|---|
| 581 | if {$select == ""} { |
|---|
| 582 | set file . |
|---|
| 583 | } else { |
|---|
| 584 | set file [string trim [$box get $select]] |
|---|
| 585 | } |
|---|
| 586 | if [file isdirectory [file join [set ${filvar}(dir)] $file]] { |
|---|
| 587 | if {$file == ".."} { |
|---|
| 588 | set ${filvar}(dir) [file dirname [set ${filvar}(dir)] ] |
|---|
| 589 | } elseif {$file != "."} { |
|---|
| 590 | set ${filvar}(dir) [file join [set ${filvar}(dir)] $file] |
|---|
| 591 | } |
|---|
| 592 | set ${filvar}(name) {} |
|---|
| 593 | $box delete 0 end |
|---|
| 594 | $box insert end {.. } |
|---|
| 595 | foreach file [lsort [glob -nocomplain \ |
|---|
| 596 | [file join [set ${filvar}(dir)] *] ] ] { |
|---|
| 597 | if {[file isdirectory $file]} { |
|---|
| 598 | # is this / needed here? Does it cause a problem in MacGSAS? |
|---|
| 599 | $box insert end [file tail $file]/ |
|---|
| 600 | } elseif {$dironly == 1} { |
|---|
| 601 | $box insert end [file tail $file] |
|---|
| 602 | } elseif {$dironly == 2 && [file extension $file] == ".EXP"} { |
|---|
| 603 | $box insert end [file tail $file] |
|---|
| 604 | } |
|---|
| 605 | } |
|---|
| 606 | return |
|---|
| 607 | } |
|---|
| 608 | set ${filvar}(name) [file tail $file] |
|---|
| 609 | } |
|---|
| 610 | |
|---|
| 611 | # set new file name from old |
|---|
| 612 | proc setoutfile {} { |
|---|
| 613 | global infile outfile |
|---|
| 614 | if {$outfile(type) == "convstod"} { |
|---|
| 615 | set lfile [string toupper $infile(name)] |
|---|
| 616 | } elseif {$outfile(type) == "convdtos"} { |
|---|
| 617 | set lfile [string tolower $infile(name)] |
|---|
| 618 | } else { |
|---|
| 619 | set lfile "" |
|---|
| 620 | } |
|---|
| 621 | if {$infile(name) == $lfile} { |
|---|
| 622 | set outfile(name) {} |
|---|
| 623 | } else { |
|---|
| 624 | set outfile(name) $lfile |
|---|
| 625 | } |
|---|
| 626 | } |
|---|
| 627 | |
|---|
| 628 | proc liveplotopt {} { |
|---|
| 629 | global liveplot |
|---|
| 630 | set frm .file |
|---|
| 631 | catch {destroy $frm} |
|---|
| 632 | toplevel $frm |
|---|
| 633 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 634 | pack [scale $frmA.1 -label "Histogram number" -from 1 -to 9 \ |
|---|
| 635 | -length 150 -orient horizontal -variable liveplot(hst)] -side top |
|---|
| 636 | pack [checkbutton $frmA.2 -text {include plot legend}\ |
|---|
| 637 | -variable liveplot(legend)] -side top |
|---|
| 638 | pack [button $frm.2 -text OK \ |
|---|
| 639 | -command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \ |
|---|
| 640 | ] -side top |
|---|
| 641 | bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"} |
|---|
| 642 | # force the window to stay on top |
|---|
| 643 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
|---|
| 644 | wm withdraw $frm |
|---|
| 645 | update idletasks |
|---|
| 646 | # center the new window in the middle of the parent |
|---|
| 647 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
|---|
| 648 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
|---|
| 649 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
|---|
| 650 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
|---|
| 651 | wm geom $frm +$x+$y |
|---|
| 652 | wm deiconify $frm |
|---|
| 653 | |
|---|
| 654 | set oldFocus [focus] |
|---|
| 655 | set oldGrab [grab current $frm] |
|---|
| 656 | if {$oldGrab != ""} { |
|---|
| 657 | set grabStatus [grab status $oldGrab] |
|---|
| 658 | } |
|---|
| 659 | grab $frm |
|---|
| 660 | focus $frm.2 |
|---|
| 661 | tkwait window $frm |
|---|
| 662 | catch {focus $oldFocus} |
|---|
| 663 | if {$oldGrab != ""} { |
|---|
| 664 | if {$grabStatus == "global"} { |
|---|
| 665 | grab -global $oldGrab |
|---|
| 666 | } else { |
|---|
| 667 | grab $oldGrab |
|---|
| 668 | } |
|---|
| 669 | } |
|---|
| 670 | } |
|---|
