Changeset 1209 for branches/sandbox/export_drawxtl.tcl
- Timestamp:
- Aug 15, 2012 2:27:31 PM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/sandbox/export_drawxtl.tcl
r930 r1209 5 5 set label "export to DRAWXTL (.str) file" 6 6 set action export_drawxtl 7 set DXTLcolorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White" 7 8 proc export_drawxtl {} { 8 9 global expmap expgui … … 20 21 # "MakeWWWHelp expgui.html export" 21 22 22 # force the window to stay on top23 putontop .export24 23 # trigger a quit on window delete 25 24 wm protocol .export WM_DELETE_WINDOW {set expgui(export_phase) 0; destroy .export } … … 47 46 -row $row -column 1 -columnspan 5 -sticky w 48 47 incr row 49 set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"50 48 set DXTL(arrowcolorbox) $bx.4a 51 49 set DXTL(arrowcolorbox_row) $row … … 54 52 grid [label $bx.4a.h -text "Arrow colors: "] -column 0 -row 1 -sticky w 55 53 grid [label $bx.4a.bll -text " generated by Black operator "] -column 0 -row 2 56 eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $ colorlist54 eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $::DXTLcolorlist 57 55 grid $bx.4a.bl -column 2 -row 2 58 56 grid [label $bx.4a.redl -text " generated by Red operator "] -column 0 -row 3 59 eval tk_optionMenu $bx.4a.red DXTL(redarrow) $ colorlist57 eval tk_optionMenu $bx.4a.red DXTL(redarrow) $::DXTLcolorlist 60 58 grid $bx.4a.red -column 2 -row 3 61 59 incr row … … 131 129 grid [scrollbar $bx.b.scroll \ 132 130 -command "$bx.b.canvas yview"] -sticky ns -row $row -column 1 133 134 trace variable expgui(export_phase) w SetDXTLatoms 131 # Fourier Box 132 incr row 133 grid [frame $bx.f -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky nsew 134 grid [label $bx.f.0 -text "Fourier display" \ 135 -anchor w] -row 0 -column 0 -sticky w 136 grid [frame $bx.f.1] -column 0 -row 1 -sticky news 137 grid [frame $bx.f.2] -column 0 -row 2 -sticky news 138 grid [canvas $bx.f.canvas -relief sunk -bd 2 \ 139 -scrollregion {0 0 5000 500} -width 250 -height 70 \ 140 -yscrollcommand "$bx.f.scroll set" ] \ 141 -column 0 -row 3 -sticky nsew 142 grid columnconfig $bx.f 0 -weight 1 143 frame [set DXTL(fb) $bx.f.canvas.fr] 144 $bx.f.canvas create window 0 0 -anchor nw -window $DXTL(fb) 145 grid [scrollbar $bx.f.scroll \ 146 -command "$bx.f.canvas yview"] -sticky ns -row 3 -column 1 147 grid [button $bx.f.1.1 -text "Setup\nFourier" \ 148 -command EditFourier] -column 0 -row 0 149 grid [button [set DXTL(FourCompute) $bx.f.1.2] -text "Compute\nFourier" \ 150 -command {DXTLwritegrd $expgui(export_phase)}] -column 1 -row 0 151 grid [label $bx.f.1.3 -text "Select\nMap"] -column 3 -row 0 152 set DXTL(fmenu) [tk_optionMenu $bx.f.1.4 DXTL(mtype) test] 153 grid $bx.f.1.4 -column 4 -row 0 154 grid [button [set DXTL(AddContour) $bx.f.1.5] -text "Add\nContour" \ 155 -command AddContour] -column 5 -row 0 156 SetupFourierButtons 157 return 158 # force the window to stay on top 159 putontop .export 160 trace variable expgui(export_phase) w "SetDXTLatoms;SetupFourierButtons" 135 161 SetDXTLatoms 136 162 # this appears to be needed by OSX … … 212 238 DXTLwriteArrows $fp $phase 213 239 } 240 DXTLwriteFourierCommands 214 241 puts $fp "END" 215 242 close $fp … … 246 273 proc SetDXTLatoms {args} { 247 274 global DXTL expgui expmap 248 set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"249 275 eval destroy [winfo children $DXTL(lb)] 250 276 eval destroy [winfo children $DXTL(Blst)] … … 290 316 grid [entry $DXTL(lb).e$row -textvariable DXTL(radius_$type) \ 291 317 -width 5] -column 2 -row $row 292 eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $ colorlist318 eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $::DXTLcolorlist 293 319 grid $DXTL(lb).c$row -column 3 -row $row 294 320 set DXTL(display_$type) sphere 295 321 set DXTL(radius_$type) 0.2 296 set DXTL(color_$type) [lindex $ colorlist $row]322 set DXTL(color_$type) [lindex $::DXTLcolorlist $row] 297 323 } 298 324 # Resize the list … … 310 336 proc DXTLaddBond {} { 311 337 global DXTL 312 set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"313 314 338 if {$DXTL(bonds) == 0} { 315 339 # insert header … … 339 363 grid [entry $DXTL(Blst).mx$row -textvariable DXTL(bmax_$row) \ 340 364 -width 5] -column 5 -row $row 341 eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $ colorlist365 eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $::DXTLcolorlist 342 366 grid $DXTL(Blst).c$row -column 6 -row $row 343 367 set DXTL(bw_$row) 0.02 344 368 set DXTL(bmin_$row) 1.0 345 369 set DXTL(bmax_$row) 2.0 346 set DXTL(bc_$row) [lindex $ colorlist $row]370 set DXTL(bc_$row) [lindex $::DXTLcolorlist $row] 347 371 # Resize the list 348 372 update … … 412 436 puts $out "mag_trans 1. 0 0 0 1. 0 0 0 1." 413 437 } 438 439 # Computes a Fourier map(s) and converts the maps from binary to ascii 440 # returns a list of Fourier map types 441 proc DXTLwritegrd {phase} { 442 global expgui expmap DXTL 443 set lst [listFourier] 444 if {$lst < 1} { 445 MyMessageBox -parent . -title "No Fourier" \ 446 -message "You have not set up to compute a Fourier map." \ 447 -icon warning 448 return 449 } 450 set typelist {} 451 foreach l $lst { 452 lappend typelist [Fourierinfo $l type] 453 } 454 set hists [FourierHists $phase] 455 # make sure we have default limits 456 getFourierLimits $phase 457 if {[llength $hists] < 1} { 458 MyMessageBox -parent . -title "No Fourier" \ 459 -message "You have not set up to compute a Fourier map for phase $phase." \ 460 -icon warning 461 return 462 } 463 if {$::tcl_platform(platform) == "windows"} { 464 set map [file join $expgui(gsasexe) gsas2map.exe] 465 set fourier [file join $expgui(gsasexe) fourier.exe] 466 } else { 467 set map [file join $expgui(gsasexe) gsas2map] 468 set fourier [file join $expgui(gsasexe) fourier] 469 } 470 if {![file exists $map]} { 471 MyMessageBox -parent . -title "No Map Converter prog" \ 472 -message "Error Fourier map converter program ($map) not found." \ 473 -icon warning 474 return 475 } 476 if {![file exists $fourier]} { 477 MyMessageBox -parent . -title "No Fourier prog" \ 478 -message "Error Fourier program ($fourier) not found." \ 479 -icon warning 480 return 481 } 482 set fp [open f.in w] 483 if {[llength $typelist] > 1} { 484 puts $fp [lindex $typelist 0] 485 } 486 puts $fp "E" 487 foreach t [lrange $typelist 1 end] { 488 puts $fp "F $t" 489 puts $fp "E" 490 } 491 puts $fp "q" 492 close $fp 493 # delete any old grd files 494 foreach f [glob -nocomplain "[file root $expgui(expfile)]*.grd"] { 495 catch {file delete -force $f} 496 } 497 set deleteerror 0 498 if {[llength [glob -nocomplain "[file root $expgui(expfile)]*.grd"]] >0} { 499 MyMessageBox -parent . -title "Old grd files?" \ 500 -message "Warning: Could not delete old .grd files; it will probably not be possible to overwrite them either. Be aware that map results may be out of date." \ 501 -icon warning 502 set deleteerror 1 503 } 504 catch { 505 exec $fourier [file root $expgui(expfile)] >& f.out 506 exec $map [file root $expgui(expfile)] < f.in >>& f.out 507 } 508 if {[llength [glob -nocomplain "[file root $expgui(expfile)]*.grd"]] == 0} { 509 set fp [open f.out r] 510 set lines {} 511 while {[gets $fp line] >= 0} { 512 append lines $line "\n" 513 } 514 close $fp 515 MyMessageBox -parent . -title "No grd files" \ 516 -message "Error: no .grd files were created. See log file below\n\n$lines" \ 517 -icon error 518 return {} 519 } else { 520 catch {close $fp} 521 catch {file delete -force f.in f.out} 522 return $typelist 523 } 524 } 525 526 proc SetupFourierButtons {} { 527 set phase $::expgui(export_phase) 528 $::DXTL(FourCompute) config -state disabled 529 $::DXTL(AddContour) config -state disabled 530 $::DXTL(fmenu) delete 0 end 531 set ::DXTL(mtype) "" 532 set ::DXTL(mfil) "" 533 # if the Fourier is not set up; return here 534 if {[listFourier] < 1} return 535 if {[llength [FourierHists $phase]] < 1} return 536 # make sure we have default limits 537 getFourierLimits $phase 538 $::DXTL(FourCompute) config -state normal 539 # if there are no maps, return here 540 set maps [glob -nocomplain "[file root $::expgui(expfile)]*.grd"] 541 if {[llength $maps] < 1} return 542 set types {} 543 foreach fil $maps { 544 lappend types [lindex [split [file root [file tail $fil]] "_"] end] 545 } 546 $::DXTL(AddContour) config -state normal 547 set i 0 548 foreach fil $maps lbl $types { 549 if {$i == 1} {$::DXTL(fmenu) invoke 0} 550 incr i 551 $::DXTL(fmenu) add command -label $lbl \ 552 -command "set DXTL(mtype) $lbl; set DXTL(mfil) $fil" 553 } 554 } 555 556 proc EditFourier {} { 557 error 558 } 559 560 proc AddContour {} { 561 error 562 } 563 564 proc DXTLwriteFourierCommands {} { 565 error 566 #mapread grd 10CO_DELF.grd 4 567 #mapcontour 2.000 mesh Green 568 #mapcontour 2.500 solid Blue 569 }
Note: See TracChangeset
for help on using the changeset viewer.