Changeset 1025
- Timestamp:
- 10/13/2010 02:27:15 PM (2 years ago)
- Location:
- trunk
- Files:
-
- 7 edited
- 4 copied
Legend:
- Unmodified
- Added
- Removed
-
trunk
-
Property
svn:mergeinfo
set to
/branches/sandbox merged eligible
-
Property
svn:mergeinfo
set to
-
trunk/addcmds.tcl
r992 r1025 392 392 393 393 proc MakeAddHistBox {} { 394 global expmap newhist 394 global expmap newhist expgui 395 395 396 396 # --> should check here if room for another histogram, but only texture … … 518 518 # fix grab... 519 519 afterputontop 520 # if no histogram is selected, select the last 521 if {$expgui(curhist) == "" && $expmap(powderlist) != ""} { 522 $expgui(histFrame).hs.lbox select set end 523 set expgui(curhist) [$expgui(histFrame).hs.lbox curselection] 524 DisplayHistogram 525 } 520 526 } 521 527 -
trunk/atomcons.tcl
r930 r1025 11 11 grid [NoteBook $expgui(consFrame).n -bd 2 -side bottom] -sticky news 12 12 source [file join $expgui(scriptdir) profcons.tcl] 13 source [file join $expgui(scriptdir) distrest.tcl] 13 14 } 14 15 … … 20 21 catch {$expgui(consFrame).n delete macro} 21 22 catch {$expgui(consFrame).n delete profile} 23 catch {$expgui(consFrame).n delete distrest} 22 24 set atom normal 23 25 set mm disabled … … 31 33 } 32 34 set expcons(atommaster) [\ 33 $expgui(consFrame).n insert end atomic -text Atomic\35 $expgui(consFrame).n insert end atomic -text "Atom Constraints" \ 34 36 -state $atom \ 35 37 -createcmd "MakeAtomsConstraintsPane" \ … … 42 44 # profile constraints page 43 45 set expcons(profilemaster) [\ 44 $expgui(consFrame).n insert end profile -text Profile\46 $expgui(consFrame).n insert end profile -text "Profile Constraints" \ 45 47 -createcmd "MakeProfileConstraintsPane" \ 46 48 -raisecmd "DisplayProfileConstraints"] 49 set expcons(distmaster) [\ 50 $expgui(consFrame).n insert end distrest -text "Distance Restraints" \ 51 -state $atom \ 52 -createcmd "" \ 53 -raisecmd "DisplayDistanceRestraints"] 54 47 55 set page [$expgui(consFrame).n raise] 48 56 # open the atom constraints page if no page is open -
trunk/expgui
r997 r1025 155 155 # setting data range/excluded regions 156 156 source [file join $expgui(scriptdir) exclinit.tcl] 157 # setup DISAGL viewer & editor 158 source [file join $expgui(scriptdir) disagledit.tcl] 159 source [file join $expgui(scriptdir) geo_viewer.tcl] 157 160 #--------------------------------------------------------------------------- 158 161 # override options with locally defined values … … 546 549 set newexpfile [getExpFileName new] 547 550 if {$newexpfile == ""} return 548 SetEXPfile $newexpfile 551 SetEXPfile $newexpfile 1 549 552 if {$expgui(expfile) == ""} { 550 553 set expgui(expfile) $prevexp … … 1699 1702 } 1700 1703 } 1701 # disable the unallowed pages in all mode 1702 if {$expgui(globalmode) == 6} { 1703 foreach pair $expgui(GlobalModeAllDisable) { 1704 if {$expgui(pagenow) == [lindex $pair 0]} { 1705 RaisePage lsFrame 1706 } 1707 eval [lindex $pair 1] -state disabled 1708 } 1709 } else { 1710 foreach pair $expgui(GlobalModeAllDisable) { 1711 eval [lindex $pair 1] -state normal 1712 } 1713 } 1704 StageTabUse 1705 # # disable the unallowed pages in all mode 1706 # if {$expgui(globalmode) == 6} { 1707 # foreach pair $expgui(GlobalModeAllDisable) { 1708 # if {$expgui(pagenow) == [lindex $pair 0]} { 1709 # RaisePage lsFrame 1710 # } 1711 # eval [lindex $pair 1] -state disabled 1712 # } 1713 # } else { 1714 # foreach pair $expgui(GlobalModeAllDisable) { 1715 # eval [lindex $pair 1] -state normal 1716 # } 1717 # } 1714 1718 set histlist {} 1715 1719 if {$expgui(hsorttype) == "type"} { … … 3348 3352 DisplayProfile \ 3349 3353 1 expgui5.html ""} 3350 {consFrame Constraints\3354 {consFrame "Re/Constraints" \ 3351 3355 "source [file join $expgui(scriptdir) atomcons.tcl]; MakeConstraintsPane" \ 3352 3356 DisplayConstraintsPane \ … … 3383 3387 } 3384 3388 } 3389 # procedure to disable tabs when phases or histograms are not defined 3390 proc StageTabUse {args} { 3391 global expgui 3392 # reset everything 3393 foreach item [lrange $::expgui(notebookpagelist) 0 end] { 3394 set frm [lindex $item 0] 3395 .n itemconfigure $frm -state normal 3396 } 3397 # disable the unallowed pages in all mode 3398 if {$expgui(globalmode) == 6} { 3399 foreach pair $expgui(GlobalModeAllDisable) { 3400 if {$expgui(pagenow) == [lindex $pair 0]} { 3401 RaisePage lsFrame 3402 } 3403 eval [lindex $pair 1] -state disabled 3404 } 3405 } else { 3406 foreach pair $expgui(GlobalModeAllDisable) { 3407 eval [lindex $pair 1] -state normal 3408 } 3409 } 3410 # no phases are present, one must add a phase 1st 3411 if {[llength $::expmap(phaselist)] == 0} { 3412 foreach item [lrange $::expgui(notebookpagelist) 2 end] { 3413 set frm [lindex $item 0] 3414 .n itemconfigure $frm -state disabled 3415 } 3416 return 3417 } 3418 # do any of the phases have atoms? 3419 set flag 1 3420 foreach phase $::expmap(phaselist) { 3421 if {[array names ::expmap atomlist_$phase] != ""} { 3422 if {[llength $::expmap(atomlist_$phase)] > 0} { 3423 set flag 0 3424 break 3425 } 3426 } 3427 } 3428 # no atoms are present, one must add at least one before continuing 3429 if $flag { 3430 foreach item [lrange $::expgui(notebookpagelist) 2 end] { 3431 set frm [lindex $item 0] 3432 .n itemconfigure $frm -state disabled 3433 } 3434 return 3435 } 3436 3437 # no data is present, one must add a histogram next 3438 if {[llength $::expmap(nhst)] == 0} { 3439 foreach item [lrange $::expgui(notebookpagelist) 4 end] { 3440 set frm [lindex $item 0] 3441 .n itemconfigure $frm -state disabled 3442 } 3443 return 3444 } 3445 } 3446 # expgui(mapstat) is set by mapexp when it is called 3447 # mapexp will be called when the .EXP file is changed (addition of phases, atoms or histograms) 3448 trace variable expgui(mapstat) w StageTabUse 3385 3449 3386 3450 # this is used to bring up the selected frame … … 4204 4268 -command {set expgui(debug) 1} 4205 4269 } 4206 # add update commands to buffer4207 if [CheckUpdateImplemented $expgui(gsasdir)]{4270 # add update commands to menu 4271 if {[file exists [file join $expgui(gsasdir) .svn]]} { 4208 4272 $expgui(fm).file.menu add command -command CheckAndDoUpdate -label "Update GSAS/EXPGUI" 4209 # $expgui(fm).file.menu add cascade -menu $expgui(fm).file.menu.track \4210 # -label "Select EXPGUI version"4211 # menu $expgui(fm).file.menu.track4212 # $expgui(fm).file.menu.track add radiobutton -command {SetSVNbranch trunk} -label Development -value trunk \4213 # -variable expgui(SVNversion)4214 # $expgui(fm).file.menu.track add radiobutton -command {SetSVNbranch stable} -label Standard -value stable \4215 # -variable expgui(SVNversion)4216 # get info about the current version on the server. Someday we might want to compare this4217 # say every month and notify when there is a new version to update4218 set repos [GetSVNrepository [file normalize $expgui(gsasdir)]]4219 # send a "p" to accept the server fingerprint in case needed on 1st access4220 set svninp [file normalize "~/svntmp.txt"]4221 set fp [open $svninp "w"]4222 puts $fp "p"4223 close $fp4224 if [catch {set out [exec svn info $repos < $svninp]} err] {4225 puts "svn info error = $err"4226 }4227 catch {file delete $svninp}4228 set expgui(SVNversion) [lindex [split $repos '/'] end]4229 # cleanup batch file from a previous update4230 if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {4231 catch {4232 file delete [file normalize ~/expgui_update.bat]4233 }4234 }4235 4273 } else { 4236 $expgui(fm).file.menu add command -label "Show update problem" -command { 4237 if {! [file exists [file join $expgui(gsasdir) .svn]]} { 4238 MyMessageBox -parent . -title "No .svn" \ 4239 -message "Unable to update because the gsas/.svn directory is not present." \ 4240 -icon warning 4241 } else { 4242 MyMessageBox -parent . -title "No .svn" \ 4243 -message "Unable to update because the subversion (svn) program is not in the path." \ 4244 -icon warning 4245 } 4246 } 4274 $expgui(fm).file.menu add command -state disabled -label "Self-updating not installed" 4247 4275 } 4248 4276 foreach c {h H} {bind . <Alt-$c> [list showhelp]} -
trunk/gsascmds.tcl
r996 r1025 1517 1517 proc rundisagl {} { 1518 1518 global expgui txtvw tcl_version tcl_platform 1519 # call up new DISAGL parm edit box 1520 if {[DA_Control_Panel 1]} {return} 1521 # Save the current exp file if needed 1522 savearchiveexp 1519 1523 if {$expgui(disaglSeparateBox)} { 1520 1524 set root [file root $expgui(expfile)] … … 1953 1957 # validate and store the EXP file name. Create a new .EXP file if it does not 1954 1958 # exist and set the wd to the location of the .EXP file. 1955 proc SetEXPfile {expfile } {1959 proc SetEXPfile {expfile "newOK 0"} { 1956 1960 global expgui tcl_platform 1957 1961 set expgui(expfile) {} … … 2066 2070 } 2067 2071 2068 if { ! [file exists $newexpfile]} {2072 if {(! $newOK) && (! [file exists $newexpfile])} { 2069 2073 update 2070 2074 set ans [ … … 2346 2350 $box.can create window 0 0 -anchor nw -window [frame $box.can.f -bd 2] 2347 2351 $box.side create window 0 0 -anchor nw -window [frame $box.side.f -bd 2] 2348 2349 2352 grid columnconfig $box 1 -weight 1 2350 2353 grid rowconfig $box 1 -weight 1 … … 2379 2382 grid $box.yscroll -sticky ns -column 2 -row 1 2380 2383 } else { 2381 grid forget $box.yscroll 2384 grid forget $box.yscroll 2382 2385 } 2383 2386 if {[lindex $sizes 2] > [winfo width $box.can]} { 2384 2387 grid $box.scroll -sticky ew -column 1 -row 2 2385 2388 } else { 2386 grid forget $box.scroll 2387 } 2388 } 2389 grid forget $box.scroll 2390 } 2391 } 2392 2393 proc MouseWheelScrollTable {box} { 2394 # causes mouse wheel to operate scroll for main canvas in ScrollTable 2395 # mousewheel can be operated anywhere in parent window 2396 bind [winfo toplevel $box] <MouseWheel> "$box.can yview scroll \[expr {-abs(%D)/%D}\] unit" 2397 } 2398 2389 2399 2390 2400 # this is used in cifselect -- not sure why anymore … … 3398 3408 # Subversion support routines 3399 3409 #------------------------------------------------------------------------------ 3400 # is there a subversion stub and can we find the svn program 3401 proc CheckUpdateImplemented {scriptdir} { 3402 #is there a svn directory in the source? 3403 if {! [file exists [file join $scriptdir .svn]]} {return 0} 3410 3411 proc GetSVNVersion {scriptdir} { 3412 if {[CheckSVNinstalled]} { 3413 set SVN [auto_execok svn] 3414 if {! [catch {set res [eval exec $SVN info [list $scriptdir]]} err]} { 3415 set infolist [split $res] 3416 set pos [lsearch $infolist "Revision:"] 3417 return "GSAS/EXPGUI SVN version [lindex $infolist [incr pos]]" 3418 } 3419 } 3420 return "EXPGUI version: [lindex $::expgui(Revision) 1] ([lindex $::expgui(Revision) 4])" 3421 } 3422 3423 # can we find the svn program? 3424 proc CheckSVNinstalled {} { 3404 3425 # can we find svn in the path? 3405 3426 if {[auto_execok svn] != ""} {return 1} 3406 # add a locally supplied svn version, if not in the path already 3407 set pathlist [list [file join $scriptdir svn bin]] 3408 lappend pathlist "/sw/bin/" 3409 lappend pathlist "/opt/local/bin/" 3410 catch {lappend pathlist $::expgui(pathlist)} 3411 foreach localsvn $pathlist { 3412 if {[file exists $localsvn]} { 3413 if {$::tcl_platform(platform) == "windows"} { 3414 set localsvn [file nativename $localsvn] 3415 set sep {;} 3416 } else { 3417 set sep {:} 3418 } 3419 if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} { 3420 append ::env(PATH) $sep $localsvn 3421 auto_reset 3422 if {[auto_execok svn] != ""} {return 1} 3423 } 3424 } 3425 } 3427 # add a locally supplied svn version and add to path 3428 if {$::tcl_platform(platform) == "windows"} { 3429 set s [file attributes $::expgui(gsasdir) -shortname] 3430 } else { 3431 set s $::expgui(gsasdir) 3432 } 3433 # look for svn 3434 set localsvn [file join $s svn bin] 3435 if {[file exists $localsvn]} { 3436 if {$::tcl_platform(platform) == "windows"} { 3437 set localsvn [file nativename $localsvn] 3438 set sep {;} 3439 } else { 3440 set sep {:} 3441 } 3442 if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} { 3443 append ::env(PATH) $sep $localsvn 3444 # note that auto_reset breaks the tkcon package in Windows -- not sure why 3445 auto_reset 3446 } 3447 } 3448 if {[auto_execok svn] != ""} {return 1} 3426 3449 return 0 3427 3450 } 3428 3451 3429 proc GetSVNVersion {scriptdir} { 3430 if {$::tcl_platform(platform) == "windows"} { 3431 set SVN [file attributes [lindex [auto_execok svn] 0] -shortname] 3432 } else { 3433 set SVN [auto_execok svn] 3434 } 3435 if {$SVN != ""} { 3436 if {! [catch {set res [exec $SVN info $scriptdir]} err]} { 3437 set infolist [split $res] 3438 set pos [lsearch $infolist "Revision:"] 3439 return "EXPGUI SVN version [lindex $infolist [incr pos]]" 3440 } 3441 } 3442 return "EXPGUI version: $::expgui(Revision)" 3443 } 3444 3445 proc GetSVNrepository {scriptdir} { 3446 if {$::tcl_platform(platform) == "windows"} { 3447 set SVN [file attributes [lindex [auto_execok svn] 0] -shortname] 3448 } else { 3449 set SVN [auto_execok svn] 3450 } 3451 if {$SVN != ""} { 3452 if {! [catch {set res [exec $SVN info $scriptdir]} err]} { 3453 set infolist [split $res] 3454 set pos [lsearch $infolist "URL:"] 3455 return [lindex $infolist [incr pos]] 3456 } 3457 } 3458 return {} 3459 } 3460 3461 proc SetSVNbranch {branch} { 3462 # reset the track label 3463 set ::command(SVNversion) [lindex [split [GetSVNrepository $::expgui(scriptdir)] '/'] end] 3464 if {$::tcl_platform(platform) == "windows"} { 3465 set SVN [file attributes [lindex [auto_execok svn] 0] -shortname] 3466 } else { 3467 set SVN [auto_execok svn] 3468 } 3469 if {$SVN == ""} { 3470 return 0 3471 } 3472 set curURL [GetSVNrepository $expgui(scriptdir)] 3473 set curbranch [lindex [split $curURL '/'] end] 3474 if {$curbranch == $branch} {return 0} 3475 if {$branch == "trunk"} { 3476 set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/trunk" 3477 set lbl development 3478 } elseif {$branch == "stable"} { 3479 set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/tags/stable" 3480 set lbl standard 3481 } else { 3482 MyMessageBox -parent . -title "Internal error" \ 3483 -message "No $branch track." -icon error 3484 return 0 3485 } 3486 set msg {Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} 3487 if {[MyMessageBox -parent . -title "Ready to switch" \ 3488 -message "Ready to update to the $lbl track.\n\n$msg" \ 3489 -type {Cancel "Update & Restart"} -default cancel -icon warning 3490 ] == "cancel"} {return} 3491 if {[confirmBeforeSave] == "Cancel"} return 3492 3493 # do a quiet cleanup. Sometimes needed after install, and never hurts 3494 if [catch {set res [exec $SVN cleanup $::expgui(scriptdir)]} err] { 3495 MyMessageBox -parent . -title "Error in cleanup" \ 3496 -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \ 3452 proc CheckAndDoUpdate { } { 3453 if {! [CheckSVNinstalled]} { 3454 MyMessageBox -parent . -title "SVN not found" \ 3455 -message "Unable to upgrade: Could not locate a copy of the subversion program. It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \ 3497 3456 -icon error 3498 } 3499 3500 # switch the source 3501 set cmd1 "$SVN switch $newURL $scriptdir" 3502 if [catch {set res1 [exec $SVN switch $newURL $::expgui(scriptdir)]} err] { 3503 MyMessageBox -parent . -title "Error updating" \ 3504 -message "Error performing update:\n$err" \ 3457 return 3458 } 3459 #is there a svn directory in the source? 3460 if {! [file exists [file join $::expgui(gsasdir) .svn]]} { 3461 MyMessageBox -parent . -title "No .svn directory" \ 3462 -message "Unable to upgrade: It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \ 3505 3463 -icon error 3506 return 03507 }3508 set msg "Results from update:\n$cmd1\n$res1"3509 # update done, now need to "reboot"3510 MyMessageBox -parent . -title "Updating done" -icon info \3511 -message "Update Complete\nPress OK to restart EXPGUI\n\n$msg"3512 exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &3513 exit3514 }3515 3516 proc CheckAndDoUpdate { } {3517 if {$::tcl_platform(platform) == "windows"} {3518 set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]3519 } else {3520 set SVN [auto_execok svn]3521 }3522 if {$SVN == ""} {3523 tk_dialog .msg "Error: no svn" \3524 "Error: SVN not found. Should not happen." \3525 error 0 OK3526 3464 return 3527 3465 } 3528 #set wish "[info nameofexecutable]"3529 3466 # check for updates 3530 if [catch { 3531 set res [exec $SVN status [file normalize $::expgui(gsasdir)] -u] 3532 } err] { 3467 set SVN [auto_execok svn] 3468 if [catch {set res [eval exec $SVN status [list $::expgui(gsasdir)] -u]} err] { 3533 3469 set ans [MyMessageBox -parent . -title "Error checking status" \ 3534 3470 -message "Error checking for updates: $err\n\nTry to update manually?" \ … … 3539 3475 } 3540 3476 return 3541 } else {3477 } else { 3542 3478 if {[string first "*" $res] == -1} { 3543 3479 MyMessageBox -parent . -title "No updates" \ 3544 -message "GSAS /EXPGUI appearsup-to-date" \3480 -message "GSAS & EXPGUI appear up-to-date" \ 3545 3481 -icon info 3546 3482 return 3547 3483 } 3548 3484 } 3485 3549 3486 if {[MyMessageBox -parent . -title "Ready to Update" \ 3550 3487 -message { 3551 Updates to GSAS/EXPGUI found .3488 Updates to GSAS/EXPGUI found on server. 3552 3489 3553 3490 Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} \ … … 3559 3496 # special upgrade for windows, where the wish exec blocks upgrade of the exe directory 3560 3497 if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} { 3498 if {![file exists [file join $::expgui(gsasdir) update.bat]]} { 3499 MyMessageBox -parent . -title "No update.bat" \ 3500 -message "File update.bat was not found. This should not happen. Will try to create it now." 3501 set fp [open [file join $::expgui(gsasdir) update.bat] w] 3502 puts $fp {@REM this script must be run from the GSAS installation directory 3503 @REM This is run to update the installation, the name of the EXP file is 3504 @REM expected as an argument 3505 @echo **************************** 3506 @echo Press return to start update 3507 @echo **************************** 3508 @pause 3509 .\svn\bin\svn cleanup . 3510 .\svn\bin\svn update . 3511 @if (%1)==() goto Install2 3512 @echo **************************************************** 3513 @echo Update has completed. Press return to restart EXPGUI 3514 @echo **************************************************** 3515 @pause 3516 %COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui %1" 3517 exit 3518 :Install2 3519 @echo **************************************************** 3520 @echo Update has completed. EXPGUI starting w/o .EXP file 3521 @echo **************************************************** 3522 @pause 3523 %COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui" 3524 exit 3525 } 3526 close $fp 3527 } 3561 3528 # split the directory and EXP file and get rid os spaces in the directory name 3562 3529 set exp [file normalize $::expgui(expfile)] … … 3569 3536 3570 3537 # do a quiet cleanup. Sometimes needed after install, and never hurts 3571 if [catch {set res [e xec $SVN cleanup $::expgui(gsasdir)]} err] {3538 if [catch {set res [eval exec $SVN cleanup [list $::expgui(gsasdir)]]} err] { 3572 3539 MyMessageBox -parent . -title "Error in cleanup" \ 3573 3540 -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \ -
trunk/gsasmenu.tcl
r930 r1025 82 82 bijcalc 83 83 disagl 84 disaglviewer 84 85 reflist 85 86 geometry … … 197 198 disagl {rundisagl { 198 199 Distance/angle calculations} 200 } 201 202 disaglviewer {Geo_Viewer { 203 Show distances and angles in a nice format} 199 204 } 200 205 -
trunk/readexp.tcl
r997 r1025 80 80 # 81 81 proc mapexp {} { 82 global exp map exparray82 global expgui expmap exparray 83 83 # clear out the old array 84 84 set expmap_Revision $expmap(Revision) … … 187 187 } 188 188 } 189 set expgui(mapstat) 1 189 190 } 190 191 … … 495 496 } 496 497 return {} 498 } 499 500 proc disagldat_get {phase} { 501 set key " DSGL CDAT$phase" 502 if {[existsexp $key] == 0} {return "{none} {none}"} 503 set line [readexp $key] 504 set i1 2 505 # read atom-atom distance parameter 506 set dist {} 507 set item [string range $line $i1 [expr {$i1+3}]] 508 if {$item == "DMAX"} { 509 set val [string range $line [expr {$i1+4}] [expr {$i1+11}]] 510 set dist [string trim $val] 511 incr i1 13 512 } else { 513 set dist "radii" 514 incr i1 5 515 } 516 # read atom-atom-atom angle parameter 517 set ang {} 518 set item [string range $line $i1 [expr {$i1+3}]] 519 if {$item == "DAGL"} { 520 set val [string range $line [expr {$i1+4}] [expr {$i1+11}]] 521 set ang [string trim $val] 522 incr i1 13 523 } else { 524 set ang "radii" 525 incr i1 5 526 } 527 # note there are two more parameters, NOFO/FORA & ONCR/DFLT, but they are not being processed yet 528 return "$dist $ang" 497 529 } 498 530 … … 519 551 # ODFcoefXXX -- the ODF coefficient for for ODF term XXX (*) 520 552 # ODFRefcoef -- refinement flag for ODF terms (*) 553 # DistCalc -- returns "radii", "none" or a number (*) 554 # none: no distance or angle computation for the phase 555 # radii: computation will be done by sums of radii 556 # (see AtmTypInfo and DefAtmTypInfo) 557 # other: a distance specifing the maximum distance 558 # AngCalc -- returns "radii", "none" or a number (*) 559 # none: no distance or angle computation for the phase 560 # radii: computation will be done by sums of radii 561 # (see AtmTypInfo and DefAtmTypInfo) 562 # other: a distance specifing the maximum distance 521 563 # action: get (default) or set 522 564 # value: used only with set … … 832 874 } 833 875 } 834 876 DistCalc-get { 877 set val [disagldat_get $phase] 878 return [lindex $val 0] 879 } 880 DistCalc-set { 881 set key " DSGL CDAT$phase" 882 # for none delete the record & thats all folks 883 if {$value == "none"} { 884 catch {unset ::exparray($key)} 885 return 886 } 887 if {[existsexp $key] == 0} { 888 makeexprec $key 889 } 890 set line [readexp $key] 891 if {[string trim $line] == ""} { 892 # blank set to defaults 893 set line [string replace $line 2 15 "DRAD ARAD NOFO"] 894 } 895 if {$value == "radii"} { 896 if {[string range $line 2 5] == "DMAX"} { 897 set line [string replace $line 2 13 "DRAD"] 898 } else { 899 set line [string replace $line 2 5 "DRAD"] 900 } 901 } else { 902 if ![validreal value 8 2] {return 0} 903 if {[string range $line 2 5] == "DMAX"} { 904 set line [string replace $line 6 13 $value] 905 } else { 906 set line [string replace $line 2 5 "DMAX"] 907 set line [string replace $line 6 6 "$value "] 908 } 909 } 910 setexp $key $line 0 68 911 } 912 AngCalc-get { 913 set val [disagldat_get $phase] 914 return [lindex $val 1] 915 } 916 AngCalc-set { 917 set key " DSGL CDAT$phase" 918 # for none delete the record & thats all folks 919 if {$value == "none"} { 920 catch {unset ::exparray($key)} 921 return 922 } 923 if {[existsexp $key] == 0} { 924 makeexprec $key 925 } 926 set line [readexp $key] 927 if {[string trim $line] == ""} { 928 # blank set to defaults 929 set line [string replace $line 2 15 "DRAD ARAD NOFO"] 930 } 931 if {[string range $line 2 5] == "DMAX"} { 932 set i2 8 933 } else { 934 set i2 0 935 } 936 if {$value == "radii"} { 937 if {[string range $line [expr {$i2+7}] [expr {$i2+10}]] == "DAGL"} { 938 set line [string replace $line [expr {$i2+7}] [expr {$i2+18}] "ARAD"] 939 } else { 940 set line [string replace $line [expr {$i2+7}] [expr {$i2+10}] "ARAD"] 941 } 942 } else { 943 if ![validreal value 8 2] {return 0} 944 if {[string range $line [expr {$i2+7}] [expr {$i2+10}]] == "DAGL"} { 945 set line [string replace $line [expr {$i2+11}] [expr {$i2+18}] $value] 946 } else { 947 set line [string replace $line [expr {$i2+7}] [expr {$i2+10}] "DAGL"] 948 set line [string replace $line [expr {$i2+11}] [expr {$i2+11}] "$value "] 949 } 950 } 951 setexp $key $line 0 68 952 } 835 953 default { 836 954 set msg "Unsupported phaseinfo access: parm=$parm action=$action" 837 tk_dialog .badexp "Error in readexp" $msg error 0 Exit 955 tk_dialog .badexp "Error in readexp" $msg error 0 Exit 838 956 } 839 957 } 840 958 return 1 841 959 } 960 842 961 843 962 … … 2648 2767 } 2649 2768 2769 # get list of defined atom types 2770 proc AtmTypList {} { 2771 set natypes [readexp " EXPR NATYP"] 2772 if {$natypes == ""} return 2773 set j 0 2774 set typelist {} 2775 for {set i 1} {$i <= $natypes} {incr i} { 2776 set key {this should never be matched} 2777 while {![existsexp $key]} { 2778 incr j 2779 if {$j > 99} { 2780 return $typelist 2781 } elseif {$j <10} { 2782 set key " EXPR ATYP $j" 2783 } else { 2784 set key " EXPR ATYP$j" 2785 } 2786 } 2787 lappend typelist [string trim [string range $::exparray($key) 2 9]] 2788 } 2789 return $typelist 2790 } 2791 2792 # read information about atom types 2793 # distrad atomic distance search radius (get/set) 2794 # angrad atomic angle search radius (get/set) 2795 proc AtmTypInfo {parm atmtype "action get" "value {}"} { 2796 # first, search through the records to find the record matching the type 2797 set natypes [readexp " EXPR NATYP"] 2798 if {$natypes == ""} return 2799 set j 0 2800 set typelist {} 2801 for {set i 1} {$i <= $natypes} {incr i} { 2802 set key {this should never be matched} 2803 while {![existsexp $key]} { 2804 incr j 2805 if {$j > 99} { 2806 return $typelist 2807 } elseif {$j <10} { 2808 set key " EXPR ATYP $j" 2809 } else { 2810 set key " EXPR ATYP$j" 2811 } 2812 } 2813 if {[string toupper $atmtype] == \ 2814 [string toupper [string trim [string range $::exparray($key) 2 9]]]} break 2815 set key {} 2816 } 2817 if {$key == ""} { 2818 # atom type not found 2819 return {} 2820 } 2821 switch -glob ${parm}-$action { 2822 distrad-get { 2823 return [string trim [string range [readexp $key] 15 24]] 2824 } 2825 distrad-set { 2826 if ![validreal value 10 2] {return 0} 2827 setexp $key $value 16 10 2828 } 2829 angrad-get { 2830 return [string trim [string range [readexp $key] 25 34]] 2831 } 2832 angrad-set { 2833 if ![validreal value 10 2] {return 0} 2834 setexp $key $value 26 10 2835 } 2836 default { 2837 set msg "Unsupported AtmTypInfo access: parm=$parm action=$action" 2838 tk_dialog .badexp "Error in readexp" $msg error 0 Exit 2839 } 2840 } 2841 } 2842 # read default information about atom types (records copied to the .EXP file 2843 # from the gsas/data/atomdata.dat file as AFAC ... 2844 # distrad returns a list of atom types (one or two letters) and 2845 # the corresponding distance 2846 # note that these values are read only (no set option) 2847 proc DefAtmTypInfo {parm} { 2848 set keys [array names ::exparray " AFAC *_SIZ"] 2849 set elmlist {} 2850 if {[llength $keys] <= 0} {return ""} 2851 foreach key $keys { 2852 lappend elmlist [string trim [string range $key 6 7]] 2853 } 2854 switch -glob ${parm} { 2855 distrad { 2856 set out {} 2857 foreach key $keys elm $elmlist { 2858 set val [string range $::exparray($key) 0 9] 2859 lappend out "$elm [string trim $val]" 2860 } 2861 return $out 2862 } 2863 angrad { 2864 set out {} 2865 foreach key $keys elm $elmlist { 2866 set val [string range $::exparray($key) 10 19] 2867 lappend out "$elm [string trim $val]" 2868 } 2869 return $out 2870 } 2871 default { 2872 set msg "Unsupported DefAtmTypInfo access: parm=$parm" 2873 tk_dialog .badexp "Error in readexp" $msg error 0 Exit 2874 } 2875 } 2876 } 2650 2877 # write the .EXP file 2651 2878 proc expwrite {expfile} { … … 2831 3058 } 2832 3059 2833 proc GetSoftConst {} { 2834 set HST {} 2835 # look for RSN record 2836 #set n 0 2837 for {set i 0} {$i < $::expmap(nhst)} {incr i} { 2838 set ihist [expr {$i + 1}] 2839 if {[expr {$i % 12}] == 0} { 2840 incr n 2841 set line [readexp " EXPR HTYP$n"] 2842 if {$line == ""} { 2843 set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file" 2844 tk_dialog .badexp "Error in readexp" $msg error 0 Exit 2845 } 2846 set j 0 2847 } else { 2848 incr j 2849 } 2850 if {[string range $line [expr 2+5*$j] [expr 5*($j+1)]] == "RSN "} { 2851 set HST $ihist 2852 } 2853 } 2854 if {$HST == ""} {return "" ""} 2855 if {$HST <=9} { 2856 set key "HST $HST" 2857 } else { 2858 set key "HST $HST" 2859 } 2860 set factr [string trim [string range [readexp "$key FACTR"] 0 14]] 2861 set ncons [string trim [string range [readexp "$key NBNDS"] 0 4]] 2862 set conslist {} 2863 for {set i 1} {$i <= $ncons} {incr i} { 2864 set fi [string toupper [format %.4x $i]] 2865 lappend conslist [string trim [readexp "${key}BD$fi"]] 2866 } 2867 return [list $factr $conslist] 2868 } 2869 2870 proc SetSoftCons {factr conslist} { 3060 # read/edit soft (distance) restraint info 3061 # parm: 3062 # weight -- histogram weight (factr) * 3063 # restraintlist -- list of restraints * 3064 # action: get (default) or set 3065 # value: used only with set 3066 # * => read+write supported 3067 proc SoftConst {parm "action get" "value {}"} { 2871 3068 set HST {} 2872 3069 # look for RSN record … … 2889 3086 } 2890 3087 } 2891 if {$HST == ""} { 3088 if {$HST == ""} {return "1"} 3089 if {$HST <=9} { 3090 set key "HST $HST" 3091 } else { 3092 set key "HST $HST" 3093 } 3094 if {$HST == "" && $action == "set"} { 2892 3095 # no RSN found need to add the soft constr. histogram 2893 3096 # increment number of histograms … … 2915 3118 makeexprec "$key NBNDS" 2916 3119 } 2917 # update histogram 2918 if {$HST <=9} { 2919 set key "HST $HST" 2920 } else { 2921 set key "HST $HST" 2922 } 2923 # update FACTR 2924 if ![validreal factr 15 6] {return 0} 2925 setexp "$key FACTR" $factr 1 15 2926 set num [llength $conslist] 2927 if ![validint num 5] {return 0} 2928 setexp "$key NBNDS" $num 1 5 2929 # delete all old records 2930 foreach i [array names ::exparray "${key}BD*"] {unset ::exparray($i)} 2931 set i 0 2932 foreach cons $conslist { 2933 incr i 2934 set fi [string toupper [format %.4x $i]] 2935 makeexprec "${key}BD$fi" 2936 set pos 1 2937 foreach num $cons len {3 5 5 3 3 3 3 3 -6 -6} { 2938 if {$len > 0} { 2939 validint num $len 2940 setexp "${key}BD$fi" $num $pos $len 2941 } else { 2942 set len [expr abs($len)] 2943 validreal num $len 3 2944 setexp "${key}BD$fi" $num $pos $len 2945 } 2946 incr pos $len 2947 } 2948 } 2949 } 3120 3121 switch -glob ${parm}-$action { 3122 weight-get { 3123 return [string trim [string range [readexp "$key FACTR"] 0 14]] 3124 } 3125 weight-set { 3126 # update FACTR 3127 if ![validreal value 15 6] {return 0} 3128 setexp "$key FACTR" $value 1 15 3129 } 3130 restraintlist-get { 3131 set ncons [string trim [string range [readexp "$key NBNDS"] 0 4]] 3132 set conslist {} 3133 for {set i 1} {$i <= $ncons} {incr i} { 3134 set fi [string toupper [format %.4x $i]] 3135 set line [readexp "${key}BD$fi"] 3136 set const {} 3137 foreach len {3 5 5 3 3 3 3 3 6 6} { 3138 set lenm1 [expr {$len - 1}] 3139 lappend const [string trim [string range $line 0 $lenm1]] 3140 set line [string range $line $len end] 3141 } 3142 lappend conslist $const 3143 } 3144 return $conslist 3145 } 3146 restraintlist-set { 3147 set num [llength $value] 3148 if ![validint num 5] {return 0} 3149 setexp "$key NBNDS" $num 1 5 3150 # delete all old records 3151 foreach i [array names ::exparray "${key}BD*"] {unset ::exparray($i)} 3152 set i 0 3153 foreach cons $value { 3154 incr i 3155 set fi [string toupper [format %.4x $i]] 3156 makeexprec "${key}BD$fi" 3157 set pos 1 3158 foreach num $cons len {3 5 5 3 3 3 3 3 -6 -6} { 3159 if {$len > 0} { 3160 validint num $len 3161 setexp "${key}BD$fi" $num $pos $len 3162 } else { 3163 set len [expr abs($len)] 3164 validreal num $len 3 3165 setexp "${key}BD$fi" $num $pos $len 3166 } 3167 incr pos $len 3168 } 3169 } 3170 } 3171 default { 3172 set msg "Unsupported phaseinfo access: parm=$parm action=$action" 3173 tk_dialog .badexp "Error in readexp" $msg error 0 Exit 3174 } 3175 return 1 3176 } 3177 } 3178 2950 3179 #====================================================================== 2951 3180 # conversion routines
Note: See TracChangeset
for help on using the changeset viewer.